Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Newer
Older
100644 336 lines (306 sloc) 9.708 kB
7e32c33 @sorear [v6] Translate NAMBackend
authored
1 # 7ab22da574d860f10011a6dc4c99d2b4de3f0809
2
3 class NAMOutput;
4
5 use JSYNC;
6 use Metamodel;
7 use Sig;
8 use MONKEY_TYPING;
9
10 sub infix:<+|>($x, $y) { Q:CgOp { (rawscall Builtins,Kernel.NumOr {$x} {$y}) } }
11 sub infix:<+&>($x, $y) { Q:CgOp { (rawscall Builtins,Kernel.NumAnd {$x} {$y}) } }
12 method run($*unit) {
13 my @*subsnam;
14 $*unit.visit_local_subs_postorder(&nam_sub);
15 to-json($*unit.to_nam);
16 }
17
18 sub nam_sub($s) {
7742322 @sorear Trap succeed in blocks that signature-bind $_
authored
19 my $code = $s.code;
20 if $s.topicalizer {
21 $code = ::Op::TopicalHook.new(inner => $code);
22 }
8db375f @sorear Implement label definitions
authored
23 my $lx = $s.lexicals;
24 my @labels = grep { $lx{$_}.^isa(::Metamodel::Lexical::Label) }, $lx.keys;
25 if @labels {
26 $code = ::Op::LabelHook.new(labels => @labels, inner => $code);
27 }
7742322 @sorear Trap succeed in blocks that signature-bind $_
authored
28 @*subsnam[$s.xref[1]] = $code.cgop($s);
7e32c33 @sorear [v6] Translate NAMBackend
authored
29 if $s.parametric_role_hack {
a21bc67 @sorear [v6] More random fixes - first 674 tests pass
authored
30 for @( $*unit.deref($s.parametric_role_hack).methods ) -> $me {
31 if $me.name ~~ ::GLOBAL::Op {
32 $me.name = $me.name.cgop($s);
7e32c33 @sorear [v6] Translate NAMBackend
authored
33 }
34 }
35 }
36 }
37
38 method load($text) {
39 unit_from_nam(from-json($text));
40 }
41
42 augment class Metamodel::Unit { #OK exist
43 method to_nam() {
44 [
45 $.mainline.xref,
46 $.name,
47 $.ns.log,
48 $.setting,
49 $.bottom_ref,
50 $.filename,
51 $.modtime,
52 [ map { $_ && $_.to_nam }, @$.xref ],
53 [ map { [$_, @( $.tdeps{$_} )] }, sort keys $.tdeps ],
54 stash_tonam($.ns.root),
55 ]
56 }
57 }
58
59 sub stash_tonam($hr) {
60 my @out;
61 for sort keys $hr -> $key {
62 my $value = [ $key, @( $hr{$key} ) ];
63 if $value[1] eq 'var' && $value[3] {
64 $value[3] = stash_tonam($value[3]);
65 }
66 push @out, $value;
67 }
68 $( @out );
69 }
70
71 sub stash_fromnam(@block) {
72 my %out;
73 for @block -> $row {
2227cd8 @sorear [v6] Second batch of fixes
authored
74 my ($key, @rest) = @$row;
75 if @rest[0] eq 'var' && @rest[2] {
76 @rest[2] = stash_fromnam(@rest[2]);
7e32c33 @sorear [v6] Translate NAMBackend
authored
77 }
2227cd8 @sorear [v6] Second batch of fixes
authored
78 %out{$key} = @rest;
7e32c33 @sorear [v6] Translate NAMBackend
authored
79 }
80 $( %out );
81 }
82
83 sub unit_from_nam(@block) {
84 my ($mlref, $name, $log, $setting, $bottom, $filename, $modtime, $xr,
85 $td, $root) = @block;
86 my $*uname = $name;
87 my $*unit = ::Metamodel::Unit.CREATE(
88 name => $name,
89 ns => ::Metamodel::Namespace.new(log => $log,
90 root => stash_fromnam($root)),
91 setting => $setting,
92 bottom_ref => $bottom,
93 filename => $filename,
94 modtime => $modtime,
95 tdeps => _hash_constructor(map { (shift($_) => $_) }, @$td));
96 my $*xref = $*unit.xref;
97 my $*xid = 0;
98 while $*xid < @$xr {
99 my $xv = $xr[$*xid];
2227cd8 @sorear [v6] Second batch of fixes
authored
100 push $*xref, $xv && ($xv[0] eq 'sub' ?? &sub_from_nam !! &packagely)($xv);
7e32c33 @sorear [v6] Translate NAMBackend
authored
101 $*xid++;
102 }
103 # XXX suboptimality
104 $*xid = 0;
105 while $*xid < @$xr {
106 if ($xr[$*xid] && $xr[$*xid][0] eq 'sub') {
107 for @( $xr[$*xid][16] ) -> $row {
108 my ($k,$v) = lex_from_nam($row);
109 $*xref[$*xid].lexicals{$k} = $v;
110 }
111 for @( $xr[$*xid][4] ) -> $z {
112 push $*xref[$*xid].zyg, $*xref[$z];
113 }
114 }
115 $*xid++;
116 }
117 $*unit.mainline = $*unit.xref[$mlref[1]];
118
119 $*unit;
120 }
121
122 augment class Metamodel::StaticSub { #OK exist
123 method to_nam() {
124 my $flags = 0;
125 $flags +|= 1 if $.run_once;
126 $flags +|= 2 if $.spad_exists;
127 $flags +|= 4 if $.gather_hack;
128 $flags +|= 8 if $.strong_used;
129 $flags +|= 16 if $.returnable;
130 $flags +|= 32 if $.augmenting;
8840f61 @sorear Eliminate the lexical/let punning horror
authored
131 $flags +|= 64 if $.transparent;
7e32c33 @sorear [v6] Translate NAMBackend
authored
132 [
133 'sub',
134 $.name,
135 $.outerx,
136 $flags,
137 [ map { $_.xref[1] }, @$.zyg ],
138 $.parametric_role_hack,
139 $.augment_hack,
140 $.hint_hack,
141 $.is_phaser,
142 $.body_of,
143 $.in_class,
144 $.cur_pkg,
145 $.class,
146 $.ltm,
147 $.exports,
148 ($.signature && [ map { $_.to_nam }, @( $.signature.params ) ]),
149 [ map { [ $_, @( $.lexicals{$_}.to_nam ) ] },
150 sort keys $.lexicals ],
151 @*subsnam[$.xref[1]],
152 ]
153 }
154 }
155
156 sub sub_from_nam(@block) {
157 my ($kind, $name, $outer, $flags, $zyg, $prh, $ah, $hh, $isp, $body, #OK
158 $inc, $crp, $cls, $ltm, $exp, $sig, $rlx, $nam) = @block; #OK
159 # Most of these are used only by code-gen. Lexicals are injected later.
160
161 ::Metamodel::StaticSub.CREATE(
162 unit => $*unit,
163 name => $name,
164 xref => [ $*uname, $*xid, $name ],
2227cd8 @sorear [v6] Second batch of fixes
authored
165 outerx => $outer,
7e32c33 @sorear [v6] Translate NAMBackend
authored
166 run_once => ?($flags +& 1),
167 spad_exists => ?($flags +& 2),
8840f61 @sorear Eliminate the lexical/let punning horror
authored
168 transparent => ?($flags +& 64),
7e32c33 @sorear [v6] Translate NAMBackend
authored
169 lexicals => {},
170 zyg => [],
171 class => $cls,
172 ltm => $ltm,
173 )
174 }
175
176 my %pkgtypes = (
177 package => ::Metamodel::Package,
178 module => ::Metamodel::Module,
179 class => ::Metamodel::Class,
180 grammar => ::Metamodel::Grammar,
181 role => ::Metamodel::Role,
182 parametricrole => ::Metamodel::ParametricRole,
183 );
184
185 my %typecodes = map { ($_.value.typename => $_.key) }, %pkgtypes;
186
187 augment class Metamodel::Package { #OK exist
188 method to_nam(*@more) {
189 [
190 %typecodes{self.typename},
191 $.name,
192 $.exports,
193 @more
194 ]
195 }
196 }
197
198 sub packagely(@block) {
199 my ($type, $name, $exports, $attr, $meth, $sup, $mro) = @block;
200 # this relies on .new ignoring unrecognized keys
201 %pkgtypes{$type}.CREATE(
202 xref => [ $*uname, $*xid, $name ],
203 name => $name,
204 exports => $exports,
205 attributes => $attr && [ map &attr_from_nam, @$attr ],
206 methods => $meth && [ map &method_from_nam, @$meth ],
207 superclasses => $sup,
208 linearized_mro => $mro
209 )
210 }
211
212 augment class Metamodel::Class { #OK exist
213 method to_nam() {
214 nextwith(self,
215 [ map { $_.to_nam }, @$.attributes ],
216 [ map { $_.to_nam }, @$.methods ],
217 $.superclasses,
218 $.linearized_mro);
219 }
220 }
221
222 augment class Metamodel::Role { #OK exist
223 method to_nam() {
224 nextwith(self,
225 [ map { $_.to_nam }, @$.attributes ],
226 [ map { $_.to_nam }, @$.methods ],
227 $.superclasses);
228 }
229 }
230
231 augment class Metamodel::ParametricRole { #OK exist
232 method to_nam() {
233 nextwith(self,
234 [ map { $_.to_nam }, @$.attributes ],
235 [ map { $_.to_nam }, @$.methods ],
236 $.superclasses);
237 }
238 }
239
240 augment class Metamodel::Method { #OK exist
241 method to_nam() {
242 [ $.name, $.kind, $.var, $.body ]
243 }
244 }
245
246 augment class Metamodel::Attribute { #OK exist
247 method to_nam() {
248 [ $.name, $.public, $.ivar, $.ibody ]
249 }
250 }
251
252 sub method_from_nam(@block) {
253 my ($name, $kind, $var, $body) = @block;
254 ::Metamodel::Method.new(:$name, :$kind, :$var, :$body);
255 }
256
257 sub attr_from_nam(@block) {
258 my ($name, $public, $ivar, $ibody) = @block;
259 ::Metamodel::Attribute.new(:$name, :$public, :$ivar, :$ibody);
260 }
261
262 augment class Sig::Parameter { #OK exist
263 method to_nam() {
264 my $flags = 0;
265 $flags = $flags +| 1 if $.slurpy;
266 $flags = $flags +| 2 if $.slurpycap;
267 $flags = $flags +| 4 if $.rwtrans;
268 $flags = $flags +| 8 if $.full_parcel;
269 $flags = $flags +| 16 if $.optional;
270 $flags = $flags +| 32 if $.positional;
271 $flags = $flags +| 64 if $.readonly;
272 $flags = $flags +| 128 if $.list;
273 $flags = $flags +| 256 if $.hash;
274
275 [
276 $.name,
277 $flags,
278 $.slot,
279 $.names,
280 $.mdefault
281 ]
282 }
283 }
284
285 sub parm_from_nam(@block) {
286 my ($name, $flags, $slot, $names, $mdefault) = @block; #OK
287 ::Sig::Parameter.new(
288 slurpy => ?($flags +& 1), slurpycap => ?($flags +& 2),
289 rwtrans => ?($flags +& 4), full_parcel => ?($flags +& 8),
290 optional => ?($flags +& 16), positional => ?($flags +& 32),
291 readonly => ?($flags +& 64), list => ?($flags +& 128),
292 hash => ?($flags +& 256),
293 name => $name, slot => $slot, names => $names);
294 }
295
296 augment class Metamodel::Lexical::Simple { #OK exist
297 method to_nam() { ['simple', 4 * $.noinit + 2 * $.list + 1 * $.hash] }
298 }
299 augment class Metamodel::Lexical::Common { #OK exist
300 method to_nam() { ['common', @$.path, $.name ] }
301 }
302 augment class Metamodel::Lexical::Alias { #OK exist
303 method to_nam() { ['alias', $.to] }
304 }
305 augment class Metamodel::Lexical::Hint { #OK exist
306 method to_nam() { ['hint'] }
307 }
8db375f @sorear Implement label definitions
authored
308 augment class Metamodel::Lexical::Label { #OK exist
309 method to_nam() { ['label'] }
310 }
7e32c33 @sorear [v6] Translate NAMBackend
authored
311 augment class Metamodel::Lexical::SubDef { #OK exist
312 method to_nam() { ['sub', @( $.body.xref ) ] }
313 }
314 augment class Metamodel::Lexical::Stash { #OK exist
315 method to_nam() { ['stash', @$.path ] }
316 }
317
318 sub lex_from_nam(@block) {
319 my ($name, $type, @xtra) = @block;
2227cd8 @sorear [v6] Second batch of fixes
authored
320 return ($name, ::Metamodel::Lexical::Simple.new)
7e32c33 @sorear [v6] Translate NAMBackend
authored
321 if $type eq 'simple';
2227cd8 @sorear [v6] Second batch of fixes
authored
322 return ($name, ::Metamodel::Lexical::Common.new(name => pop(@xtra),
323 path => @xtra)) if $type eq 'common';
324 return ($name, ::Metamodel::Lexical::Alias.new(to => @xtra[0]))
7e32c33 @sorear [v6] Translate NAMBackend
authored
325 if $type eq 'alias';
2227cd8 @sorear [v6] Second batch of fixes
authored
326 return ($name, ::Metamodel::Lexical::Hint.new)
7e32c33 @sorear [v6] Translate NAMBackend
authored
327 if $type eq 'hint';
8db375f @sorear Implement label definitions
authored
328 return ($name, ::Metamodel::Lexical::Label.new)
329 if $type eq 'label';
2227cd8 @sorear [v6] Second batch of fixes
authored
330 return ($name, ::Metamodel::Lexical::SubDef.new(body => $*xref[@xtra[1]]))
7e32c33 @sorear [v6] Translate NAMBackend
authored
331 if $type eq 'sub';
2227cd8 @sorear [v6] Second batch of fixes
authored
332 return ($name, ::Metamodel::Lexical::Stash.new(path => @xtra))
7e32c33 @sorear [v6] Translate NAMBackend
authored
333 if $type eq 'stash';
334 die "weird lex type $type";
335 }
Something went wrong with that request. Please try again.