Skip to content
This repository
tag: v5
Fetching contributors…

Octocat-spinner-32-eaf2f5

Cannot retrieve contributors at this time

file 789 lines (681 sloc) 24.919 kb
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383 384 385 386 387 388 389 390 391 392 393 394 395 396 397 398 399 400 401 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458 459 460 461 462 463 464 465 466 467 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 525 526 527 528 529 530 531 532 533 534 535 536 537 538 539 540 541 542 543 544 545 546 547 548 549 550 551 552 553 554 555 556 557 558 559 560 561 562 563 564 565 566 567 568 569 570 571 572 573 574 575 576 577 578 579 580 581 582 583 584 585 586 587 588 589 590 591 592 593 594 595 596 597 598 599 600 601 602 603 604 605 606 607 608 609 610 611 612 613 614 615 616 617 618 619 620 621 622 623 624 625 626 627 628 629 630 631 632 633 634 635 636 637 638 639 640 641 642 643 644 645 646 647 648 649 650 651 652 653 654 655 656 657 658 659 660 661 662 663 664 665 666 667 668 669 670 671 672 673 674 675 676 677 678 679 680 681 682 683 684 685 686 687 688 689 690 691 692 693 694 695 696 697 698 699 700 701 702 703 704 705 706 707 708 709 710 711 712 713 714 715 716 717 718 719 720 721 722 723 724 725 726 727 728 729 730 731 732 733 734 735 736 737 738 739 740 741 742 743 744 745 746 747 748 749 750 751 752 753 754 755 756 757 758 759 760 761 762 763 764 765 766 767 768 769 770 771 772 773 774 775 776 777 778 779 780 781 782 783 784 785 786 787 788
# first half of the file - begin augments are in Begin.pm6

module Metamodel;

use NAME;
use Stash;

### NIECZA COMPILER METAMODEL
# The metamodel exists to create a timeline inside the compiler. Previously,
# the compiler operated as a pure tree transformer with no conception of how
# PRE-INIT code would play out, thus precluding a lot of important
# optimizations (based on precomputing immutable objects and optimizing
# references to them, mostly).
#
# The metamodel has two main life stages. First, it is built; an incremental
# process logically called BEGIN. Then, it is processed to perform closed-
# world optimizations and generate code; this is (UNIT)CHECK.
#
# Kinds of objects which exist in the metamodel
# - Static subs
# - Packages (incl. classes, modules, grammars)
# - Stashes (Foo::)
#
# This graph is a lot more random than the old trees were...

# While manipulating metamodel bits, these contextuals are needed:
# @*opensubs: stack of non-transparent subs, new lexicals go in [*-1]
# $*unit: current unit for new objects to attach to
# %*units: maps unit names to unit objects

# A stash is an object like Foo::. Foo and Foo:: are closely related, but
# generally must be accessed separately due to constants (which have Foo but
# not Foo::) and stub packages (vice versa).
#
# 'my' stashes are really 'our' stashes with gensym mergable names. Because
# stashes have no identity beyond their contents and set of names, they don't
# mind being copied around a lot.
#
# Stashes are not referencable objects in precompilation mode. You need to
# keep the paths around, instead.
#
# This object holds the stash universe for a unit.
class Namespace {
    # root points to a graph of hashes each representing one package.
    # Each such hash has keys for each member; the values are arrayrefs:
    # ["graft", [@path]]: A graft
    # ["var", $meta, $sub]: A common variable and/or subpackage; either
    # field may be undef.
    #
    # Paths do not start from GLOBAL; they start from an unnamed package
    # which contains GLOBAL, and also lexical namespaces (MAIN 15 etc).
    has $.root = {}; # is rw

    # Records *local* operations, so they may be stored and used to
    # set up the runtime stashes. Read-only log access is part of the
    # public API.
    has $.log = [];

    method !lookup_common($used, @path_) {
        my $cursor = $.root;
        my @path = @path_;
        while @path > 1 {
            my $k = shift @path;
            if ($cursor{$k} && $cursor{$k}[0] eq 'graft') {
                ($cursor, $used) = self!lookup_common([], [ @($cursor{$k}[1]), '' ]);
                next;
            }

            $cursor{$k} //= ['var',Any,Any];
            if !defined $cursor{$k}[2] {
                $.log.push(['pkg',[@$used, $k]]);
                $cursor{$k}[2] = {};
            }
            $cursor = $cursor{$k}[2];
            push @$used, $k;
        }
        @($cursor, $used, @path);
    }

    method stash_cname(@path) {
        self!lookup_common([], @path)[1,2];
    }

    method stash_canon(@path) {
        my ($npath, $nhead) = self.stash_cname(@path);
        @$npath, $nhead;
    }

    method visit_stashes($cb) {
        sub visitor($node, @path) {
            $cb([@path]);
            for sort keys $node -> $k {
                if $node{$k}[0] eq 'var' && defined $node{$k}[2] {
                    visitor($node{$k}[2], [ @path, $k ]);
                }
            }
        }
        visitor($.root, []);
    }

    # Add a new unit set to the from-set and checks mergability
    method add_from($from) {
        $!root = _merge($!root, %*units{$from}.ns.root, []);
    }

    sub _dclone($tree) {
        return $tree unless defined $tree;
        my $rinto = { };
        for keys $tree -> $k {
            my $i = $tree{$k};
            if $i[0] eq 'var' {
                $i = ['var', $i[1], _dclone($i[2])];
            }
            $rinto{$k} = $i;
        }
        $rinto;
    }

    sub _merge($rinto_, $rfrom, @path) {
        my $rinto = _hash_constructor( %$rinto_ );
        for sort keys $rfrom -> $k {
            if !$rinto{$k} {
                $rinto{$k} = $rfrom{$k};
                if $rinto{$k}[0] eq 'var' {
                    $rinto{$k} = ['var', $rinto{$k}[1], _dclone($rinto{$k}[2]) ];
                }
                next;
            }
            my $i1 = $rinto{$k};
            my $i2 = $rfrom{$k};
            if $i1[0] ne $i2[0] {
                die "Merge type conflict " ~ join(" ", $i1[0], $i2[0], @path, $k);
            }
            if $i1[0] eq 'graft' {
                die "Grafts cannot be merged " ~ join(" ", @path, $k)
                    unless join("\0", @($i1[1])) eq join("\0", @($i2[1]));
            }
            if $i1[0] eq 'var' {
                my $nn1 = $i1[1] && $i1[1][0];
                my $nn2 = $i2[1] && $i2[1][0];
                die "Non-stub packages cannot be merged " ~ join(" ", @path, $k)
                    if $nn1 && $nn2 && ($i1[1][0] ne $i2[1][0] ||
                        $i1[1][1] != $i2[1][1]);
                $rinto{$k} = ['var',
                    ($nn1 ?? $i1[1] !! $nn2 ?? $i2[1] !! ($i1[1] // $i2[1])),
                    ((defined($i1[2]) && defined($i2[2])) ??
                        _merge($i1[2], $i2[2], [@path, $k]) !!
                    _dclone($i1[2] // $i2[2]))];
            }
        }
        return $rinto;
    }

    # Create or reuse a (stub) package for a given path
    method create_stash(@path) {
        self!lookup_common([], [@path, '']);
    }

    # Create or reuse a variable for a given path
    method create_var(@path) {
        my ($c,$u,$n) = self!lookup_common([], @path);
        my $i = $c{$n} //= ['var',Any,Any];
        if $i[0] ne 'var' {
            die "Collision with non-variable on @path";
        }
        if !$i[1] {
            $.log.push([ 'var', [ @$u,$n ] ]);
            $i[1] = ['',0];
        }
    }

    # Lookup by name; returns undef if not found
    method get_item(@path) {
        my ($c,$u,$n) = self!lookup_common([], @path); #OK not used
        my $i = $c{$n} or return Any;
        if $i[0] eq 'graft' {
            self.get_item($i[1]);
        } elsif $i[0] eq 'var' {
            $i[1];
        }
    }

    # Bind an unmergable thing (non-stub package) into a stash.
    method bind_item($path, $item) {
        my ($c,$u,$n) = self!lookup_common([], $path); #OK not used
        my $i = $c{$n} //= ['var',Any,Any];
        if $i[0] ne 'var' || $i[1] && $i[1][0] {
            die "Collision installing pkg $path";
        }
        $i[1] = $item;
    }

    # Bind a graft into a stash
    method bind_graft($path1, $path2) {
        my ($c,$u,$n) = self!lookup_common([], $path1);
        if $c{$n} {
            die "Collision installing graft $path1 -> $path2";
        }
        push $.log, [ 'graft', [ @$u, $n ], $path2 ];
        $c{$n} = ['graft', $path2];
    }

    # List objects in a stash for use by the importer; returns tuples
    # of [name, var] etc
    method list_stash(@path) {
        my $c = self!lookup_common([], [@path, ''])[0];
        map { [ $_, @( $c{$_} ) ] }, sort keys $c;
    }
}

class RefTarget {
    has $.xref; # is rw
    has $.name = 'ANON';

    # TODO BUILD
    method new(*%_) {
        my $n = self.CREATE(|%_);
        $n.xref = [ $*unit.name, +$*unit.xref, $n.name ];
        push $*unit.xref, $n;
        $n
    }
}

class Package is RefTarget {
    has $.exports; # is rw

    method add_attribute($name, $public, $ivar, $ibody, $tc) { #OK not used
        die "attribute $name defined in a lowly package";
    }

    method add_method($multi, $kind, $name, $var, $body) { #OK not used
        die "method $name defined in a lowly package";
    }

    method add_super($super) {
        die "superclass $*unit.deref($super).name() defined in a lowly package";
    }

    method close() { }
}

class Module is Package {
}

class Method {
    # normally a Str, but may be Op for param roles
    has $.name = die "Method.name is required";
    # normal, private, meta, sub
    has $.kind = die "Method.kind is required"; # Str
    has $.multi = die "Method.multi is required"; # Str
    has $.var; # Str
    has $.body; # Xref
}

class Attribute {
    has $.name; # Str, required
    has $.public; # Bool
    has $.ivar; # Str
    has $.ibody; # Xref
    has $.typeconstraint; # Xref
}

class Class is Module {
    has $.attributes = [];
    has $.methods = [];
    has $.superclasses = [];
    has $.linearized_mro; # is rw
    has $!closing;

    method add_attribute($name, $public, $ivar, $ibody, $typeconstraint) {
        push $.attributes, Metamodel::Attribute.new(:$name,
            :$public, :$ivar, :$ibody, :$typeconstraint);
    }

    method add_method($multi, $kind, $name, $var, $body) { #OK not used
        push $.methods, Metamodel::Method.new(:$name, :$body, :$kind, :$multi);
    }

    method add_super($targ) {
        die "bad attempt to add null super" unless $targ;
        push $.superclasses, $targ;
    }

    sub c3clear($item, @lists) {
        for @lists -> $l {
            my $i = 1;
            while $i < $l {
                return False if $*unit.deref($l[$i]) === $*unit.deref($item);
                $i++;
            }
        }

        for @lists -> $l {
            $l.shift if $l && $*unit.deref($l[0]) === $*unit.deref($item);
        }

        True;
    }

    sub c3merge(@onto, @lists) {
        my $ix = 0;
        while $ix < @lists {
            my $l = @lists[$ix];
            if !$l || !c3clear((my $item = $l[0]), @lists) {
                $ix++;
                next;
            }
            push @onto, $item;
            $ix = 0;
        }

        my $bad = False;
        for @lists -> $l { $bad ||= $l }
        if $bad {
            my @hrl = @lists.grep(*.Bool).map(
                { $^l.map({ $*unit.deref($^i).name }).join(" <- ") });
            die "C3-MRO wedged! @hrl.join(" | ")";
        }
    }

    method close() {
        return Nil if $.linearized_mro;
        if ($!closing) {
            die "Class hierarchy circularty detected at $.name\n";
        }
        $!closing = True;

        if (($.name ne 'Mu' || !$*unit.is_true_setting)
                && !$.superclasses) {
            self.add_super($*unit.get_item(
                    @*opensubs[*-1].true_setting.find_pkg(self._defsuper)));
        }

        my @merge;
        push @merge, [ $.xref, @( $.superclasses ) ];
        for @$.superclasses -> $x {
            my $d = $*unit.deref($x);
            $d.close unless $d.linearized_mro;
            push @merge, [ @( $d.linearized_mro ) ];
        }
        my @mro;
        c3merge(@mro, @merge);
        $.linearized_mro = @mro;
    }

    method _defsuper() { 'Any' }
}

# roles come in two types; Role objects are used for simple roles, while roles
# with parameters get ParametricRole. Instantiations of parametric roles
# would get ConcreteRole, but that won't be implemented in Niecza A since it
# requires evaluating role parameters, unless we restrict it to typenames or
# something.
class Role is Module {
    has $.attributes = [];
    has $.methods = [];
    has $.superclasses = [];

    method add_attribute($name, $public, $ivar, $ibody, $typeconstraint) {
        push $.attributes, Metamodel::Attribute.new(:$name,
            :$public, :$ivar, :$ibody, :$typeconstraint);
    }

    method add_method($multi, $kind, $name, $var, $body) { #OK not used
        if $name !~~ Str {
            die "Computed names are legal only in parametric roles";
        }
        push $.methods, Metamodel::Method.new(:$name, :$body, :$kind,
            :$multi);
    }

    method add_super($targ) {
        die "bad attempt to add null super" unless $targ;
        push $.superclasses, $targ;
    }
}

class ParametricRole is Module {
    has $.attributes = [];
    has $.methods = [];
    has $.superclasses = [];

    method add_attribute($name, $public, $ivar, $ibody, $typeconstraint) {
        push $.attributes, Metamodel::Attribute.new(:$name,
            :$public, :$ivar, :$ibody, :$typeconstraint);
    }

    method add_method($multi, $kind, $name, $var, $body) { #OK not used
        push $.methods, ::Metamodel::Method.new(:$name, :$body, :$var, :$kind, :$multi);
    }

    method add_super($targ) {
        die "bad attempt to add null super" unless $targ;
        push $.superclasses, $targ;
    }
}

class Grammar is Class {
    method _defsuper() { 'Grammar' }
}

#####

# This is a static lexical; they exist in finite number per unit. They may
# occupy specific slots in pads, or globals, or something else entirely.
class Lexical {
    # my $foo, @foo, %foo, &foo
    class Simple is Lexical {
        has $.list = False; # Bool
        has $.hash = False; # Bool
        has $.noinit = False; # Bool
        has $.typeconstraint; # Xref
    }

    # These are used for $?foo et al, and should be inaccessible until assigned,
    # although the current code won't enforce that well.
    class Hint is Lexical {
    }

    # These store destinations for lexotic control transfers, and clone like
    # subs to handle recursion properly.
    class Label is Lexical {
    }

    class Dispatch is Lexical {
    }

    # our...
    class Common is Lexical {
        has $.path = die "M:L:Common.path required"; # Array of Str
        has $.name = die "M:L:Common.name required"; # Str
    }

    # mostly for state
    class Alias is Lexical {
        has $.to = die "M:L:Alias.to required"; # Str

        method new($to) { self.CREATE(:$to) }
    }

    # sub foo { ... }
    class SubDef is Lexical {
        has $.body; # Metamodel::StaticSub
    }

    # my class Foo { } or our class Foo { }; either case, the true stash lives in
    # stashland
    class Stash is Lexical {
        has $.path; # Array of Str
    }
}

# The life cycle of a static sub has three phases.
# 1. Open - the end of the sub hasn't been seen, so the full code is absent.
# 2. Closing - all attributes are available but no references exist. The
# perfect time for most optimizations, especially ones that look like
# escape analyses.
# 3. Closed - references exist, possibly even from BEGIN-run code. The sub
# must be treated as semantically immutable. The code can probably still
# be changed to reflect new information, though.

# figure out how post-declared lexicals should interact with codegen
# std accepts: sub foo() { bar }; BEGIN { foo }; sub bar() { }
# DONE: TimToady says bar can be compiled to a runtime search
class StaticSub is RefTarget {
    has $.unit; # Metamodel::Unit
    has $.outerx; # Xref
    has $.run_once = False; # Bool
    has $.spad_exists = False; # Bool
    has $.transparent = False; # Bool; ignored by OUTER::
    has $.lexicals = {};
    has $.code; # Op, is rw
    has $.signature; # Sig, is rw
    has $.zyg = []; # Array of Metamodel::StaticSub

    # inject a take EMPTY
    has $.gather_hack = False; # Bool
    # inject a role constructor
    has $.parametric_role_hack; # Xref, is rw
    # some tuples for method definitions; munged into a phaser
    has $.augment_hack; # Array, is rw
    # emit code to assign to a hint; [ $subref, $name ]
    has $.hint_hack; # Array, is rw

    has $.is_phaser; # Int, is rw
    has $.strong_used = False; # Bool, is rw; prevents elision
    has $.body_of; # Xref of Package
    has $.in_class; # Xref of Package
    has $.cur_pkg; # Array of Str
    has $.returnable = False; # Bool; catches &return
    has $.augmenting = False; # Bool; traps add_attribute
    has $.unsafe = False; # Bool; disallowed in safe mode
    has $.class = 'Sub'; # Str
    has $.ltm; # is rw
    has $.exports; # is rw

    method outer() { $!outerx ?? $*unit.deref($!outerx) !! StaticSub }

    method true_setting() {
        my $cursor = self;
        while $cursor && !$cursor.unit.is_true_setting {
            $cursor = $cursor.outer;
        }
        $cursor;
    }

    method add_child($z) { push $.zyg, $z }
    method children() { @$.zyg }

    method clear_optree() {
        $.code = Any;
        $.ltm = Any;
    }

    method create_static_pad() {
        return Nil if $.spad_exists;
        $.spad_exists = True;
        $.outer.create_static_pad if $.outer;
    }

    method topicalizer() {
        $.signature && ?( grep { .slot && .slot eq '$_' }, @( $.signature.params ) )
    }

    method find_lex_pkg($name) {
        my $toplex = self.find_lex($name) // return Array;
        if !$toplex.^isa(Metamodel::Lexical::Stash) {
            die "$name is declared as a non-package";
        }
        $toplex.path;
    }

    method find_pkg($names) {
        my @names = $names ~~ Str ?? ('MY', $names) !! @$names;
        for @names { $_ = substr($_, 0, chars($_)-2) if chars($_) >= 2 && substr($_, chars($_)-2, 2) eq '::' } # XXX
        my @tp;
        if @names[0] eq 'OUR' {
            @tp = @$.cur_pkg;
            shift @names;
        } elsif @names[0] eq 'PROCESS' or @names[0] eq 'GLOBAL' {
            @tp = shift @names;
        } elsif @names[0] eq 'MY' {
            @tp = @( self.find_lex_pkg(@names[1]) // die "{@names} doesn't seem to exist" );
            shift @names;
            shift @names;
        } elsif my $p = self.find_lex_pkg(@names[0]) {
            @tp = @$p;
            shift @names;
        } else {
            @tp = 'GLOBAL';
        }

        [ @tp, @names ];
    }

    method find_lex($name) {
        my $l = $.lexicals{$name};
        if $l {
            return $l.^isa(Metamodel::Lexical::Alias) ??
                self.find_lex($l.to) !! $l;
        }
        return ($.outer ?? $.outer.find_lex($name) !! Metamodel::Lexical);
    }

    method delete_lex($name) {
        my $l = $.lexicals{$name};
        if $l {
            if $l.^isa(Metamodel::Lexical::Alias) { self.delete_lex($l.to) }
            else { $.lexicals{$name}:delete }
        } else {
            $.outer && $.outer.delete_lex($name);
        }
    }

    method add_my_name($slot, *%param) {
        $.lexicals{$slot} = Metamodel::Lexical::Simple.new(|%param);
    }

    method add_hint($slot) {
        $.lexicals{$slot} = Metamodel::Lexical::Hint.new;
    }

    method add_label($slot) {
        $.lexicals{$slot} = Metamodel::Lexical::Label.new;
    }

    method add_dispatcher($slot) {
        $.lexicals{$slot} = Metamodel::Lexical::Dispatch.new;
    }

    method add_common_name($slot, $path, $name) {
        $*unit.create_stash($path);
        $*unit.create_var([ @$path, $name ]);
        $.lexicals{$slot} = Metamodel::Lexical::Common.new(:$path, :$name);
    }

    method add_state_name($slot, $back, *%param) {
        # outermost sub isn't cloned so a fallback to my is safe
        my $up = $.outer // self;
        $up.lexicals{$back} = Metamodel::Lexical::Simple.new(|%param);
        $.lexicals{$slot} = Metamodel::Lexical::Alias.new($back)
            if defined($slot);
    }

    method add_my_stash($slot, $path) {
        $.lexicals{$slot} = Metamodel::Lexical::Stash.new(:$path);
    }

    method add_my_sub($slot, $body) {
        self.add_child($body);
        $.lexicals{$slot} = Metamodel::Lexical::SubDef.new(:$body);
    }

    method add_pkg_exports($unit, $name, $path2, $tags) {
        for @$tags -> $tag {
            $unit.bind_graft([@$.cur_pkg, 'EXPORT', $tag, $name], $path2);
        }
        +$tags;
    }

    # NOTE: This only marks the variables as used. The code generator
    # still has to spit out assignments for these!
    method add_exports($unit, $name, $tags) {
        for @$tags -> $tag {
            $unit.create_var([ @$.cur_pkg, 'EXPORT', $tag, $name ]);
        }
        +$tags;
    }

    method close() { }
}

class Unit {
    has $.mainline; # Metamodel::StaticSub, is rw
    has $.name; # Str
    has $.ns; # Metamodel::Namespace
    has $.setting; # Str
    has $.bottom_ref; # is rw
    has $.xref = [];
    has $.tdeps = {};
    has $.filename; # is rw, Str
    has $.modtime; # is rw, Numeric
    has $.next_anon_stash = 0; # is rw, Int

    method bind_item($path,$item) { $!ns.bind_item($path,$item) }
    method bind_graft($path1,$path2) { $!ns.bind_graft($path1,$path2) }
    method create_stash(@path) { $!ns.create_stash(@path) }
    method create_var(@path) { $!ns.create_var(@path) }
    method list_stash(@path) { $!ns.list_stash(@path) }
    method get_item(@path) { $!ns.get_item(@path) }

    method is_true_setting() { $.name eq 'CORE' }

    method get_unit($name) { %*units{$name} }

    method anon_stash() { "{$.name}:{$.next_anon_stash++}" }

    method deref($thing) {
        die "trying to dereference null" unless $thing;
        self.get_unit($thing[0]).xref[$thing[1]] // die "invalid ref @$thing";
    }

    method visit_units_preorder($cb) {
        my %seen;
        sub rec {
            return Nil if %seen{$_};
            %seen{$_} = True;
            for sort keys self.get_unit($_).tdeps { rec($_) }
            $cb(self.get_unit($_));
        }
        rec($.name);
    }

    method visit_local_packages($cb) {
        for @$.xref -> $x {
            $cb($x) if defined($x) && $x.^isa(Metamodel::Package);
        }
    }

    method clear_optrees() {
        self.visit_local_subs_postorder({ $_.clear_optree })
    }

    method visit_local_subs_postorder($cb) {
        sub rec {
            for $_.children { rec($_) }
            $cb($_);
        }
        rec($.mainline);
    }

    method visit_local_subs_preorder($cb) {
        sub rec {
            $cb($_);
            for $_.children { rec($_) }
        }
        rec($.mainline);
    }

    method need_unit($u2name) {
        my $u2 = %*units{$u2name} //= $*module_loader.($u2name);
        $.tdeps{$u2name} = [ $u2.filename, $u2.modtime ];
        for keys $u2.tdeps -> $k {
            %*units{$k} //= $*module_loader.($k);
            $.tdeps{$k} //= $u2.tdeps{$k};
        }
        $.ns.add_from($u2name);
        $u2;
    }

    # STD-based frontend wants a slightly different representation.
    sub _syml_myname($xr) { "MY:unit<$xr[0]>:xid<$xr[1]>" }

    method create_syml() {
        my $all = {};
        my $*unit = self;

        if (self.get_unit($.name) !=== self) {
            die "Local unit cache inconsistant";
        }

        $.ns.visit_stashes(sub (@path) {
            return Nil unless @path;
            my $tag = join("", map { $_ ~ "::" }, @path);
            my $st = $all{$tag} = Stash.new('!id' => [$tag]);
            my @ppath = @path;
            my $name = pop @ppath;
            my $ptag = join("", map { $_ ~ "::" }, @ppath);
            if $ptag ne '' {
                $st<PARENT::> = [ $ptag ];
                $all{$ptag}{$name ~ '::'} = $st;
            }
            for self.list_stash(@path) -> $tok {
                if $tok[1] eq 'var' {
                    my $name = $tok[0];
                    $st{$name} = NAME.new( name => $name );
                    $st{'&' ~ $name} = $st{$name} if $name !~~ /^<[\$\@\%\&]>/;
                }
            }
        });

        my $top = self.deref($.bottom_ref // $.mainline.xref);
        #say STDERR "Top = $top";
        my $cursor = $top;
        while $cursor {
            my $id = _syml_myname($cursor.xref);
            #say STDERR "Creating $cursor [$id]";
            $all{$id} = Stash.new( '!id' => [ $id ] );
            $cursor = $cursor.outer;
        }

        $cursor = $top;
        while $cursor {
            my $st = $all{_syml_myname($cursor.xref)};
            #say STDERR "Populating $cursor";
            for sort keys $cursor.lexicals -> $name {
                my $lx = $cursor.lexicals{$name};
                $st{$name} = NAME.new( name => $name );
                $st{'&' ~ $name} = $st{$name} if $name !~~ /^<[\$\@\%\&]>/;

                if $lx.^isa(Metamodel::Lexical::Stash) {
                    my @cpath = $.ns.stash_canon($lx.path);
                    $st{$name ~ '::'} = $all{join "", map { $_ ~ "::" },
                        $.ns.stash_canon(@cpath)};
                }
            }
            $st<OUTER::> = $cursor.outer ?? $all{_syml_myname($cursor.outerx)}<!id> !! [];
            if ($cursor.unit.bottom_ref && $cursor.unit.name eq 'CORE') {
                $all<CORE> //= $st;
            }
            if ($cursor.unit.bottom_ref) {
                $all<SETTING> //= $st;
            }
            $cursor = $cursor.outer;
        }
        #say STDERR "UNIT ", $self->mainline;
        #$all->{'UNIT'} = $subt{$self->mainline};
        {
            my @nbits = @( $.mainline.find_pkg([$.name.split('::')]) );
            @nbits = $.ns.stash_canon(@nbits);
            # XXX wrong, but makes STD importing work
            # say STDERR (YAML::XS::Dump @nbits);
            $all<UNIT> = $all{join "", map { $_ ~ '::' }, @nbits};
        }
        # say STDERR (YAML::XS::Dump("Regenerated syml for " . $self->name, $all));
        $all;
    }
}
Something went wrong with that request. Please try again.