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