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