Finish implementing our-scoped packages

Body.pm

@@ -146,7 +146,7 @@ use CgOp ();
             $pkgcg = CgOp::scopedlex($components[0]);
             shift @components;
         } else {
-            $pkgcg = CgOp::scopedlex('$?GLOBAL');
+            $pkgcg = CgOp::scopedlex('$?CURPKG');
         }
 
         for my $c (@components) {

Decl.pm

@@ -227,7 +227,6 @@ use CgOp;
     sub preinit_code {
         my ($self, $body) = @_;
 
-        # XXX ought not to have side effects here.
         $::SETTING_RESUME = $body->scopetree;
         my $n = $self->unitname;
         $n =~ s/::/./g;
@@ -249,6 +248,8 @@ use CgOp;
     has bodyvar => (is => 'ro', isa => 'Str');
     has stub    => (is => 'ro', isa => 'Bool', default => 0);
     has name    => (is => 'ro', isa => 'Str', predicate => 'has_name');
+    # my packages always have a unique stash, our ones just alias part of GLOBAL
+    has ourpkg   => (is => 'ro', isa => 'Maybe[ArrayRef[Str]]');
 
     sub bodies { $_[0]->body ? $_[0]->body : () }
     sub stashvar { $_[0]->var . '::' }
@@ -269,11 +270,14 @@ use CgOp;
             return CgOp::prog(
                 CgOp::proto_var($self->var, CgOp::newscalar(CgOp::null('IP6'))),
                 CgOp::proto_var($self->stashvar,
-                    CgOp::wrap(CgOp::rawnew('Dictionary<string,Variable>'))));
+                    ($self->ourpkg ? $body->lookup_pkg(@{ $self->ourpkg }) :
+                    CgOp::wrap(CgOp::rawnew('Dictionary<string,Variable>')))));
         }
 
         CgOp::letn("pkg",
-            CgOp::wrap(CgOp::rawnew('Dictionary<string,Variable>')),
+            ($self->ourpkg ?
+                $body->lookup_pkg(@{ $self->ourpkg }) :
+                CgOp::wrap(CgOp::rawnew('Dictionary<string,Variable>'))),
             CgOp::letn("how", $self->make_how,
                 # catch usages before the closing brace
                 CgOp::proto_var($self->var, CgOp::newscalar(CgOp::null('IP6'))),

Niecza/Actions.pm

@@ -1285,24 +1285,25 @@ sub package_def { my ($cl, $M) = @_;
     if (!$M->{longname}[0]) {
         $scope = 'anon';
     }
-    if ($::SCOPE eq 'augment' || $::SCOPE eq 'supercede') {
+    if ($scope eq 'augment' || $scope eq 'supercede') {
         $M->sorry('Monkey typing is not yet supported');
         return;
     }
-    if ($::SCOPE eq 'has' || $::SCOPE eq 'state') {
-        $M->sorry("Illogical scope $::SCOPE for package block");
+    if ($scope eq 'has' || $scope eq 'state') {
+        $M->sorry("Illogical scope $scope for package block");
         return;
     }
-    # XXX we don't actually implement our packages yet but a STD bug forces
-    # us to declare some packages as our
     # XXX shouldn't fully mangle here, c.f. STD:auth<http://perl.org>
     my $name = $M->{longname}[0] ?
         $cl->mangle_longname($M->{longname}[0], "package definition") : 'ANON';
-    my $outervar = $::SCOPE ne 'anon' ? $name : $cl->gensym;
+    my $outervar = $scope ne 'anon' ? $name : $cl->gensym;
 
     my $optype = 'Op::' . ucfirst($::PKGDECL) . 'Def';
     my $blocktype = $::PKGDECL;
     my $bodyvar = $cl->gensym;
+    # We need the OUR because otherwise the name lookup latches on to the
+    # nascent lexical alias and crashes.  Possibly a bug.
+    my $ourpkg = ($scope eq 'our') ? [ 'OUR::', "${name}::", ] : undef;
 
     if (!$M->{decl}{stub}) {
         my $stmts = $M->{statementlist} // $M->{blockoid};
@@ -1320,12 +1321,14 @@ sub package_def { my ($cl, $M) = @_;
             var     => $outervar,
             exports => \@export,
             bodyvar => $bodyvar,
+            ourpkg  => $ourpkg,
             body    => $cbody);
     } else {
         $M->{_ast} = $optype->new(
             node($M),
             name    => $name,
             var     => $outervar,
+            ourpkg  => $ourpkg,
             stub    => 1);
     }
 }

Op.pm

@@ -485,14 +485,16 @@ use CgOp;
     has stub => (is => 'ro', isa => 'Bool', default => 0);
     has body => (is => 'ro', isa => 'Body');
     has exports => (is => 'ro', isa => 'ArrayRef[Str]', default => sub { [] });
+    has ourpkg => (is => 'ro', isa => 'Maybe[ArrayRef[Str]]');
 
     sub decl_class { 'Decl::Package' }
     sub lift_decls {
         my ($self) = @_;
         my @r = $self->decl_class->new(stub => $self->stub, var => $self->var,
             ($self->has_name ? (name => $self->name) : ()),
             ($self->stub ? () : (body => $self->body,
-                    bodyvar => $self->bodyvar)));
+                    bodyvar => $self->bodyvar)),
+            ourpkg => $self->ourpkg);
 
         for my $tag (@{ $self->exports }) {
             for my $sym ($self->var, $self->var . '::') {