Centralized a bunch of PMC methods in COMMON.
[kakapo:kakapo.git] / src / Global.nqp
1 # Copyright (C) 2009-2010, Austin Hastings. See accompanying LICENSE file, or 
2 # http://www.opensource.org/licenses/artistic-license-2.0.php for license.
3
4 =begin
5
6 =NAME Global - provides global symbol manipulation functions.
7
8 =DESCRIPTION
9
10 This module exports (to the root namespace) a set of functions for perl-like management 
11 of global symbols. 
12
13 B<NOTE:> This module is the I< very first > module initialized in the Kakapo library. Because of 
14 this, it must call no external functions that depend on being initialized. (In general, only calls to
15 Opcode:: should be made.)
16
17 =SYNOPSIS
18
19 =begin code
20
21         use( 'Any::Module' );
22         use( 'Some::Other::Module', :tags('A', 'B'));
23
24         export('foo', 'bar', 'baz', :tags('SPECIAL', 'DEFAULT'));
25
26 =end code
27
28 =end
29
30 module Global;
31
32 our sub _pre_initload() {
33 # Special sub called when the Kakapo library is loaded or initialized. This is to guarantee this 
34 # module is available during :init and :load processing for other modules.
35
36         my $nqp_root := 'parrot';
37         my @parts := $nqp_root.split('::');
38         my $root_nsp := Opcode::get_root_namespace(@parts);
39         
40         inject_symbol(Global::use, :namespace($root_nsp));
41         inject_symbol(Global::export, :namespace($root_nsp));
42 }
43
44 our sub export($symbol, *@symbols, :$as?, :$namespace?, :@tags?) {
45 # =signature    export($symbol [...], [ :namespace(_), ] [ :tags( [ string [...] ] ) ] )
46 # =signature    export($symbol, :as(<name>), [:namespace(_), ] [ :tags( [ string [...]] ) ] )
47
48 # Adds a list of symbols - either String names or Subs - to one or more export groups. If a String is passed 
49 # to identify the symbol, then the String will be the export name of the symbol.
50
51 # If desired, a C< :namespace(_) > may be provided, either a String or a NameSpace object, that specifies
52 # the namespace of the symbol(s) being exported. This can be used to add a different namespace's symbols
53 # to the current module's export set.
54
55 # If no C< :tags > are given, the tag 'DEFAULT' is used. (This is the same tag used by C<import> when no 
56 # other tags are specified.) The symbol is added to all of the export groups named in C< :tags >. This allows
57 # definition of partially overlapping tag sets, by adding the common symbols to multiple tags:
58
59     # Global::export('c1', 'c2', 'c3', :tags('A', 'B'));
60     # Global::export('a1', 'a2', :tags('A'));   # A include a1, a2, c1, c2, c3
61     # Global::export('b1', :tags('B'));         # B includes b1, c1, c2, c3
62
63 # The option C<:as($name)> can only be used with a single symbol. In this case, the symbol - which in this 
64 # case may be an object, or the String name of an object - is added to the specified export tags under the 
65 # C<$name> given. (This can be used to export dynamically created objects, or to export some other module's 
66 # sub under a different name.)
67
68 # Note finally that there are two I< reserved > tag names: C< ALL > and C< DEFAULT >. The C< DEFAULT >
69 # tag, as mentioned above, is used if no C< :tags > are specified. Similarly, calls to L<C< use >> that do 
70 # not specify any tags will import the C< DEFAULT > tag. The C< ALL > tag is automatically attached to 
71 # every exported symbol. This is more to support L<C< use >>-ing a particular symbol than anything else,
72 # but it is a valid import tag.
73
74         unless @symbols { @symbols := Array::empty(); }
75         @symbols.unshift($symbol);
76         if ! Opcode::isa(@tags, 'ResizablePMCArray') { @tags := Array::new(@tags); }
77         elsif +@tags == 0 { @tags.push('DEFAULT'); }
78
79         my $source_nsp := Opcode::defined($namespace)
80                 ?? $namespace
81                 !! Parrot::caller_namespace(2);
82         
83         if Opcode::isa($source_nsp, 'String') {
84                 $source_nsp := Opcode::get_namespace($source_nsp);
85         }
86
87         my $export_nsp := $source_nsp.make_namespace('EXPORT');
88         
89         @tags.push('ALL');
90         
91         for @tags {
92                 my $tag_nsp := $export_nsp.make_namespace(~ $_);
93                 
94                 if Opcode::defined($as) {
95                         my $export_sym := $symbol;
96                         if Opcode::isa($export_sym, 'String') {
97                                 $export_sym := $source_nsp.get_sym($export_sym);
98                         }
99
100                         inject_symbol($export_sym, :as($as), :namespace($tag_nsp));
101                 }
102                 else {
103                         $source_nsp.export_to($tag_nsp, @symbols);
104                 }
105         }
106 }
107
108 our sub inject_symbol($object, :$namespace, :$as?, :$force?) {
109 # Injects a PMC C< $object > into a C< $namespace >, optionally C< $as > a certain name. For C< Sub > and 
110 # C< MultiSub > PMCs, the name is not a requirement since they know their own names. For other PMC types,
111 # including injecting variable rather than functions, the C< $as > name must be provided by the caller. If 
112 # C< $force > is specified, any pre-existing symbol is overwritten. Otherwise, if a name collision occurs
113 # FIXME: an exception should be thrown, but currently isn't.
114
115         # Subs carry their name, so try stringifying it
116         unless Opcode::defined($as) { $as := ~ $object; }       
117         
118         if ! Opcode::isa($namespace, 'NameSpace') {
119                 $namespace := Opcode::get_hll_namespace($namespace);
120         }
121
122         # NB: find_var searches for *anything*, while find_sub requires isa(sub). In this case,
123         # any collision is bad.
124         if ! $force && Opcode::defined($namespace.find_var($as)) {
125                 return 0;
126         }
127         
128         $namespace.add_var($as, $object);
129 }
130
131 our sub register_global($name, $object, :$namespace?) {
132 # Registers a symbol C< $name > in the C< Global:: > namespace, bound to C< $object >.
133
134 # This function is used to create global symbols. The C< :namespace() > option may be specified to use 
135 # a different namespace than Global. The intended usage pattern is that the Global namespace serves 
136 # as a I< Registry > for locating shared objects and services.
137
138         unless $namespace { $namespace := 'Global'; }
139         if Opcode::isa($namespace, 'String') {
140                 $namespace := $namespace.split('::');
141         }
142         
143         my $nsp := Opcode::get_hll_namespace();
144         $nsp := $nsp.make_namespace($namespace);
145         
146         $nsp{$name} := $object; 
147         export($name, :namespace($nsp));
148 }
149
150 our sub use($module?, :@except?, :@tags?, :@symbols?) {
151 # Imports global symbols into the caller's namespace. If neither C<:tags> nor
152 # C<:symbols> are specified, C<:tags('DEFAULT')> is assumed.
153
154 # The strings given to C<:tags > are tag names. The C<DEFAULT> tag is one 
155 # of two special tag names known to the system. Otherwise, each module may 
156 # define its own tagging scheme. (The other predefined tag is C<ALL>.)
157
158 # If C<:symbols> are specified, specific symbol names may be imported. The 
159 # symbols must be in the target module's C<ALL> export group, as this is where
160 # they are looked up. (This will normally be true, unless the same name has been
161 # used for different exports in different TAGS. In which case, don't do that.)
162
163 # If no source C< $module > is specified, the default is the Global:: module itself. 
164 # This is a shortcut for defining global variables, in conjunction with the
165 # C<register_global> function. (q.v.)
166
167 # Any symbols listed in C< @except > will I< not > be imported, regardless of how the
168 # symbol list is generated. This allows the caller to block certain symbols, perhaps 
169 # in order to rename or override them.
170
171         if ! Opcode::defined($module)   { $module       := Parrot::caller_namespace(1); }
172         if Opcode::isa(@tags, 'String') { @tags := Array::new(@tags); }
173         if Opcode::isa(@symbols, 'String')      { @symbols      := Array::new(@symbols); }
174         
175         if Opcode::isa($module, 'P6object')     { $module       := Opcode::typeof($module); }
176         if Opcode::isa($module, 'String')       { $module       := Parrot::get_hll_namespace($module); }
177
178         if +@tags == 0 && +@symbols == 0 {
179                 @tags.push('DEFAULT');
180         }       
181
182         my $export_nsp := $module.make_namespace('EXPORT');
183         my $target_nsp := Parrot::caller_namespace(2);
184
185         my %except;
186         
187         for @except {
188                 %except{$_} := 1;
189         }
190         
191         for @tags {
192                 my $source_nsp := $export_nsp.make_namespace(~ $_);
193                 my @tag_symbols;
194                 
195                 for $source_nsp.keys {
196                         unless %except{$_} {
197                                 @tag_symbols.push(~ $_);
198                         }
199                 }
200                         
201                 if +@tag_symbols {
202                         $source_nsp.export_to($target_nsp, @tag_symbols);
203                 }
204         }
205         
206         if +@symbols {
207                 $export_nsp{'ALL'}.export_to($target_nsp, @symbols);
208         }
209 }