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