diff --git a/Body.pm b/Body.pm index a8d5d54d..0b93e903 100644 --- a/Body.pm +++ b/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) { diff --git a/Decl.pm b/Decl.pm index 84ff5f1b..73a96e7c 100644 --- a/Decl.pm +++ b/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')))); + ($self->ourpkg ? $body->lookup_pkg(@{ $self->ourpkg }) : + CgOp::wrap(CgOp::rawnew('Dictionary'))))); } CgOp::letn("pkg", - CgOp::wrap(CgOp::rawnew('Dictionary')), + ($self->ourpkg ? + $body->lookup_pkg(@{ $self->ourpkg }) : + CgOp::wrap(CgOp::rawnew('Dictionary'))), CgOp::letn("how", $self->make_how, # catch usages before the closing brace CgOp::proto_var($self->var, CgOp::newscalar(CgOp::null('IP6'))), diff --git a/Niecza/Actions.pm b/Niecza/Actions.pm index 80973126..5c66f66b 100644 --- a/Niecza/Actions.pm +++ b/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 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); } } diff --git a/Op.pm b/Op.pm index 717617c0..1d39da43 100644 --- a/Op.pm +++ b/Op.pm @@ -485,6 +485,7 @@ 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 { @@ -492,7 +493,8 @@ use CgOp; 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 . '::') {