Skip to content

Commit

Permalink
Make 6.e PseudoStash a child of 6.c PseudoStash
Browse files Browse the repository at this point in the history 
Resolve a problem with `EVAL` which wasn't accepting 6.e `PseudoStash`
in `:context` argument.

This commit is currently more of a proof of concept because complete
solution requires support for `:implementation-detail` argument support in
methods `keys`, `pairs`, etc. -- see 6.c version of the class.
  • Loading branch information
@vrurg
vrurg committed May 20, 2021
1 parent ea92934 commit 3fcf6f7
Showing 1 changed file with 53 additions and 69 deletions.
122 changes: 53 additions & 69 deletions src/core.e/PseudoStash.pm6
View file
Original file line number Diff line number Diff line change
Expand Up @@ -2,36 +2,27 @@
# my class X::Caller::NotDynamic { ... }
# my class X::NoSuchSymbol { ... }

my class PseudoStash is Map {
has Mu $!ctx;
has int $!mode;
my class PseudoStash is CORE::v6c::PseudoStash {
has $!package; # Parent package, for which we serve as .WHO

# Lookup modes.
# Lookup modes. Must be kept in sync with CORE::v6c::PseudoStash mode constants.
my int constant PICK_CHAIN_BY_NAME = 0;
my int constant STATIC_CHAIN = 1;
my int constant DYNAMIC_CHAIN = 2;
my int constant PRECISE_SCOPE = 4;
my int constant REQUIRE_DYNAMIC = 8;

method new() {
my $obj := nqp::create(self);
my $ctx := nqp::ctxcaller(nqp::ctx());
nqp::bindattr($obj, PseudoStash, '$!ctx', $ctx);
nqp::bindattr($obj, Map, '$!storage', nqp::ctxlexpad($ctx));
$obj
}

multi method WHICH(PseudoStash:D: --> ObjAt:D) { self.Mu::WHICH }
# A convenience shortcut
my constant PseudoStash6c = CORE::v6c::PseudoStash;

my $pseudoers := nqp::hash(
'MY', sub ($cur) {
my $stash := nqp::clone($cur);
nqp::bindattr_i($stash, PseudoStash, '$!mode', PRECISE_SCOPE);
nqp::bindattr_i($stash, PseudoStash6c, '$!mode', PRECISE_SCOPE);
$stash.pseudo-package('MY');
},
'CORE', sub ($cur) {
my Mu $ctx := nqp::getattr(nqp::decont($cur), PseudoStash, '$!ctx');
my Mu $ctx := nqp::getattr(nqp::decont($cur), PseudoStash6c, '$!ctx');
until nqp::isnull($ctx) || nqp::existskey(nqp::ctxlexpad($ctx), 'CORE-SETTING-REV') {
$ctx := nqp::ctxouterskipthunks($ctx);
}
Expand All @@ -41,8 +32,8 @@ my class PseudoStash is Map {
nqp::stmts(
(my $stash := nqp::create(PseudoStash)),
nqp::bindattr($stash, Map, '$!storage', nqp::ctxlexpad($ctx)),
nqp::bindattr($stash, PseudoStash, '$!ctx', $ctx),
nqp::bindattr_i($stash, PseudoStash, '$!mode', STATIC_CHAIN),
nqp::bindattr($stash, PseudoStash6c, '$!ctx', $ctx),
nqp::bindattr_i($stash, PseudoStash6c, '$!mode', STATIC_CHAIN),
$stash.pseudo-package('CORE'),
)
)
Expand All @@ -51,74 +42,74 @@ my class PseudoStash is Map {
nqp::if(
nqp::isnull(
my Mu $ctx := nqp::ctxcallerskipthunks(
nqp::getattr(nqp::decont($cur), PseudoStash, '$!ctx'))),
nqp::getattr(nqp::decont($cur), PseudoStash6c, '$!ctx'))),
Nil,
nqp::stmts(
(my $stash := nqp::create(PseudoStash)),
nqp::bindattr($stash, Map, '$!storage', nqp::ctxlexpad($ctx)),
nqp::bindattr($stash, PseudoStash, '$!ctx', $ctx),
nqp::bindattr_i($stash, PseudoStash, '$!mode', PRECISE_SCOPE +| REQUIRE_DYNAMIC),
nqp::bindattr($stash, PseudoStash6c, '$!ctx', $ctx),
nqp::bindattr_i($stash, PseudoStash6c, '$!mode', PRECISE_SCOPE +| REQUIRE_DYNAMIC),
$stash.pseudo-package('CALLER')
)
)
},
'OUTER', sub ($cur) is raw {
my Mu $ctx := nqp::ctxouterskipthunks(
nqp::getattr(nqp::decont($cur),PseudoStash,'$!ctx'));
nqp::getattr(nqp::decont($cur), PseudoStash6c, '$!ctx'));

if nqp::isnull($ctx) {
Nil
}
else {
my $stash := nqp::create(PseudoStash);
nqp::bindattr($stash, Map, '$!storage', nqp::ctxlexpad($ctx));
nqp::bindattr($stash, PseudoStash, '$!ctx', $ctx);
nqp::bindattr_i($stash, PseudoStash, '$!mode', PRECISE_SCOPE);
nqp::bindattr($stash, PseudoStash6c, '$!ctx', $ctx);
nqp::bindattr_i($stash, PseudoStash6c, '$!mode', PRECISE_SCOPE);
$stash.pseudo-package('OUTER')
}
},
'LEXICAL', sub ($cur) {
my $stash := nqp::clone($cur);
nqp::bindattr_i($stash, PseudoStash, '$!mode', STATIC_CHAIN +| DYNAMIC_CHAIN);
nqp::bindattr_i($stash, PseudoStash6c, '$!mode', STATIC_CHAIN +| DYNAMIC_CHAIN);
$stash.pseudo-package('LEXICAL')
},
'OUTERS', sub ($cur) {
my Mu $ctx := nqp::ctxouterskipthunks(
nqp::getattr(nqp::decont($cur), PseudoStash, '$!ctx'));
nqp::getattr(nqp::decont($cur), PseudoStash6c, '$!ctx'));

if nqp::isnull($ctx) {
Nil
}
else {
my $stash := nqp::create(PseudoStash);
nqp::bindattr($stash, Map, '$!storage', nqp::ctxlexpad($ctx));
nqp::bindattr($stash, PseudoStash, '$!ctx', $ctx);
nqp::bindattr_i($stash, PseudoStash, '$!mode', STATIC_CHAIN);
nqp::bindattr($stash, PseudoStash6c, '$!ctx', $ctx);
nqp::bindattr_i($stash, PseudoStash6c, '$!mode', STATIC_CHAIN);
$stash.pseudo-package('OUTERS')
}
},
'DYNAMIC', sub ($cur) {
my $stash := nqp::clone($cur);
nqp::bindattr_i($stash, PseudoStash, '$!mode', DYNAMIC_CHAIN +| REQUIRE_DYNAMIC);
nqp::bindattr_i($stash, PseudoStash6c, '$!mode', DYNAMIC_CHAIN +| REQUIRE_DYNAMIC);
$stash.pseudo-package('DYNAMIC');
},
'CALLERS', sub ($cur) {
nqp::if(
nqp::isnull(
my Mu $ctx := nqp::ctxcallerskipthunks(
nqp::getattr(nqp::decont($cur), PseudoStash, '$!ctx'))),
nqp::getattr(nqp::decont($cur), PseudoStash6c, '$!ctx'))),
Nil,
nqp::stmts(
(my $stash := nqp::create(PseudoStash)),
nqp::bindattr($stash, Map, '$!storage', nqp::ctxlexpad($ctx)),
nqp::bindattr($stash, PseudoStash, '$!ctx', $ctx),
nqp::bindattr_i($stash, PseudoStash, '$!mode', DYNAMIC_CHAIN +| REQUIRE_DYNAMIC),
nqp::bindattr($stash, PseudoStash6c, '$!ctx', $ctx),
nqp::bindattr_i($stash, PseudoStash6c, '$!mode', DYNAMIC_CHAIN +| REQUIRE_DYNAMIC),
$stash.pseudo-package('CALLERS')
)
)
},
'UNIT', sub ($cur) {
my Mu $ctx := nqp::getattr(nqp::decont($cur), PseudoStash, '$!ctx');
my Mu $ctx := nqp::getattr(nqp::decont($cur), PseudoStash6c, '$!ctx');
until nqp::isnull($ctx) || nqp::existskey(nqp::ctxlexpad($ctx), '!UNIT_MARKER') {
$ctx := nqp::ctxouterskipthunks($ctx);
}
Expand All @@ -128,16 +119,16 @@ my class PseudoStash is Map {
nqp::stmts(
(my $stash := nqp::create(PseudoStash)),
nqp::bindattr($stash, Map, '$!storage',nqp::ctxlexpad($ctx)),
nqp::bindattr($stash, PseudoStash, '$!ctx', $ctx),
nqp::bindattr_i($stash, PseudoStash, '$!mode', STATIC_CHAIN),
nqp::bindattr($stash, PseudoStash6c, '$!ctx', $ctx),
nqp::bindattr_i($stash, PseudoStash6c, '$!mode', STATIC_CHAIN),
$stash.pseudo-package('UNIT')
)
)
},
'SETTING', sub ($cur) {
# Same as UNIT, but go a little further out (two steps, for
# internals reasons).
my Mu $ctx := nqp::getattr(nqp::decont($cur), PseudoStash, '$!ctx');
my Mu $ctx := nqp::getattr(nqp::decont($cur), PseudoStash6c, '$!ctx');
until nqp::isnull($ctx)
|| (nqp::existskey(nqp::ctxlexpad($ctx), '!UNIT_MARKER')
&& !nqp::existskey(nqp::ctxlexpad($ctx), '!EVAL_MARKER')) {
Expand All @@ -158,39 +149,39 @@ my class PseudoStash is Map {
nqp::stmts(
(my $stash := nqp::create(PseudoStash)),
nqp::bindattr($stash, Map, '$!storage', nqp::ctxlexpad($ctx)),
nqp::bindattr($stash, PseudoStash, '$!ctx', $ctx),
nqp::bindattr_i($stash, PseudoStash, '$!mode', STATIC_CHAIN),
nqp::bindattr($stash, PseudoStash6c, '$!ctx', $ctx),
nqp::bindattr_i($stash, PseudoStash6c, '$!mode', STATIC_CHAIN),
$stash.pseudo-package('SETTING')
)
)
},
'CLIENT', sub ($cur) {
my $pkg := nqp::getlexrel(
nqp::getattr(nqp::decont($cur), PseudoStash, '$!ctx'),
nqp::getattr(nqp::decont($cur), PseudoStash6c, '$!ctx'),
'$?PACKAGE');
my Mu $ctx := nqp::ctxcallerskipthunks(
nqp::getattr(nqp::decont($cur), PseudoStash, '$!ctx'));
nqp::getattr(nqp::decont($cur), PseudoStash6c, '$!ctx'));
while nqp::eqaddr(nqp::getlexrel($ctx, '$?PACKAGE'), $pkg) {
$ctx := nqp::ctxcallerskipthunks($ctx);
die "No client package found" unless $ctx;
}
my $stash := nqp::create(PseudoStash);
nqp::bindattr($stash, Map, '$!storage', nqp::ctxlexpad($ctx));
nqp::bindattr($stash, PseudoStash, '$!ctx', $ctx);
nqp::bindattr_i($stash, PseudoStash, '$!mode', PRECISE_SCOPE +| REQUIRE_DYNAMIC);
nqp::bindattr($stash, PseudoStash6c, '$!ctx', $ctx);
nqp::bindattr_i($stash, PseudoStash6c, '$!mode', PRECISE_SCOPE +| REQUIRE_DYNAMIC);
$stash.pseudo-package('CLIENT');
},
'OUR', sub ($cur) {
nqp::getlexrel(
nqp::getattr(nqp::decont($cur), PseudoStash, '$!ctx'),
nqp::getattr(nqp::decont($cur), PseudoStash6c, '$!ctx'),
'$?PACKAGE')
}
);


method !find-rev-core($key) {
my $rev = nqp::substr($key, 2, 1);
my $ctx := $!ctx;
my $ctx := nqp::getattr(self, PseudoStash6c, '$!ctx');
my $found := nqp::null();
my $stash;
nqp::while(
Expand All @@ -211,8 +202,8 @@ my class PseudoStash is Map {
nqp::stmts(
($stash := nqp::create(PseudoStash)),
nqp::bindattr($stash, Map, '$!storage', nqp::ctxlexpad($found)),
nqp::bindattr($stash, PseudoStash, '$!ctx', $found),
nqp::bindattr_i($stash, PseudoStash, '$!mode', PRECISE_SCOPE),
nqp::bindattr($stash, PseudoStash6c, '$!ctx', $found),
nqp::bindattr_i($stash, PseudoStash6c, '$!mode', PRECISE_SCOPE),
$stash.pseudo-package('CORE::' ~ $key)
)
)
Expand All @@ -232,7 +223,7 @@ my class PseudoStash is Map {
($val := nqp::atkey($pseudoers,$key)(self)),
nqp::stmts(
nqp::if( # PRECISE_SCOPE is exclusive
nqp::bitand_i($!mode,PRECISE_SCOPE),
nqp::bitand_i(nqp::getattr_i(self, PseudoStash6c, '$!mode'),PRECISE_SCOPE),
nqp::if(
nqp::existskey(
nqp::getattr(self,Map,'$!storage'),nqp::unbox_s($key)),
Expand All @@ -242,28 +233,28 @@ my class PseudoStash is Map {
nqp::stmts( # DYNAMIC_CHAIN can be combined with STATIC_CHAIN
nqp::if( # DYNAMIC_CHAIN
(nqp::isnull($val)
&& nqp::bitand_i(
$!mode,nqp::bitor_i(DYNAMIC_CHAIN,PICK_CHAIN_BY_NAME)
) && nqp::iseq_i(nqp::ord(nqp::unbox_s($key),1),42)), # "*"
&& nqp::bitand_i(nqp::getattr_i(self, PseudoStash6c, '$!mode'),
nqp::bitor_i(DYNAMIC_CHAIN,PICK_CHAIN_BY_NAME))
&& nqp::iseq_i(nqp::ord(nqp::unbox_s($key),1),42)), # "*"
($val := nqp::ifnull(
nqp::getlexreldyn(
nqp::getattr(self,PseudoStash,'$!ctx'),nqp::unbox_s($key)),
nqp::getattr(self,PseudoStash6c,'$!ctx'),nqp::unbox_s($key)),
nqp::null()
))
),
nqp::if( # STATIC_CHAIN is the default
nqp::isnull($val),
($val := nqp::ifnull(
nqp::getlexrel(
nqp::getattr(self,PseudoStash,'$!ctx'),nqp::unbox_s($key)),
nqp::getattr(self,PseudoStash6c,'$!ctx'),nqp::unbox_s($key)),
nqp::null()
))
)
)
),
nqp::if(
(nqp::not_i(nqp::isnull($val))
&& nqp::bitand_i($!mode,REQUIRE_DYNAMIC)),
&& nqp::bitand_i(nqp::getattr_i(self, PseudoStash6c, '$!mode'), REQUIRE_DYNAMIC)),
nqp::if(
(try nqp::not_i($val.VAR.dynamic)),
($val := Failure.new(X::Caller::NotDynamic.new(symbol => $key)))
Expand All @@ -276,10 +267,6 @@ my class PseudoStash is Map {
!! $val
}

multi method ASSIGN-KEY(PseudoStash:D: Str() $key, Mu \value) is raw {
self.AT-KEY($key) = value
}

# Walks over contexts, respects combined chains (DYNAMIC_CHAIN +| STATIC_CHAIN). It latter case the inital context
# would be repeated for each mode.
my class CtxWalker {
Expand All @@ -289,10 +276,10 @@ my class PseudoStash is Map {
has $!modes;

method !SET-SELF(CtxWalker:D: PseudoStash:D \pseudo) {
nqp::bindattr(self, CtxWalker, '$!start-ctx', nqp::getattr(pseudo, PseudoStash, '$!ctx'));
nqp::bindattr(self, CtxWalker, '$!ctx', nqp::getattr(pseudo, PseudoStash, '$!ctx'));
nqp::bindattr(self, CtxWalker, '$!start-ctx', nqp::getattr(pseudo, PseudoStash6c, '$!ctx'));
nqp::bindattr(self, CtxWalker, '$!ctx', nqp::getattr(pseudo, PseudoStash6c, '$!ctx'));
nqp::bindattr_i(self, CtxWalker, '$!stash-mode',
(nqp::getattr(pseudo, PseudoStash, '$!mode') || STATIC_CHAIN) # We default to STATIC_CHAIN
(nqp::getattr(pseudo, PseudoStash6c, '$!mode') || STATIC_CHAIN) # We default to STATIC_CHAIN
);
$!modes := nqp::list_i(PRECISE_SCOPE, DYNAMIC_CHAIN, STATIC_CHAIN);
self
Expand Down Expand Up @@ -382,7 +369,7 @@ my class PseudoStash is Map {
nqp::existskey($pseudoers,$key),
X::Bind.new(target => "pseudo-package $key").throw,
nqp::if(
nqp::bitand_i($!mode,PRECISE_SCOPE),
nqp::bitand_i(nqp::getattr_i(self, PseudoStash6c, '$!mode'), PRECISE_SCOPE),
nqp::bindkey(
nqp::getattr(self,Map,'$!storage'),nqp::unbox_s($key),value
),
Expand All @@ -397,26 +384,27 @@ my class PseudoStash is Map {

# for some reason we get an ambiguous dispatch error by making this a multi
method EXISTS-KEY(PseudoStash:D: Str() $key) {
my $mode := nqp::getattr_i(self, PseudoStash6c, '$!mode');
nqp::unless(
nqp::existskey($pseudoers,$key),
nqp::hllbool(
nqp::if(
nqp::bitand_i($!mode,PRECISE_SCOPE),
nqp::bitand_i($mode,PRECISE_SCOPE),
nqp::existskey(
nqp::getattr(self,Map,'$!storage'),nqp::unbox_s($key)),
nqp::if(
nqp::bitand_i(
$!mode,nqp::bitor_i(DYNAMIC_CHAIN,PICK_CHAIN_BY_NAME)
$mode,nqp::bitor_i(DYNAMIC_CHAIN,PICK_CHAIN_BY_NAME)
) && nqp::iseq_i(nqp::ord(nqp::unbox_s($key),1),42), # "*"
nqp::not_i(
nqp::isnull(
nqp::getlexreldyn(
nqp::getattr(self, PseudoStash, '$!ctx'),
nqp::getattr(self, PseudoStash6c, '$!ctx'),
nqp::unbox_s($key)))),
nqp::not_i( # STATIC_CHAIN
nqp::isnull(
nqp::getlexrel(
nqp::getattr(self, PseudoStash, '$!ctx'),
nqp::getattr(self, PseudoStash6c, '$!ctx'),
nqp::unbox_s($key))))
)
)
Expand All @@ -437,7 +425,7 @@ my class PseudoStash is Map {
method !SET-SELF(PseudoStash:D \pseudo) {
$!stash := pseudo;
$!ctx-walker := CtxWalker.new(pseudo); # Don't waste memory, create for chained modes only
$!stash-mode := nqp::getattr(pseudo, PseudoStash, '$!mode'); # Cache for faster access
$!stash-mode := nqp::getattr(pseudo, PseudoStash6c, '$!mode'); # Cache for faster access
self
}

Expand Down Expand Up @@ -528,10 +516,6 @@ my class PseudoStash is Map {

multi method iterator(PseudoStash:D: --> Iterator:D) { CtxSymIterator::Pairs.new(self) }

multi method pairs(PseudoStash:D: --> Seq:D) {
Seq.new(self.iterator)
}

multi method keys(PseudoStash:D: --> Seq:D) {
Seq.new(CtxSymIterator::Keys.new(self))
}
Expand Down

0 comments on commit 3fcf6f7

Please sign in to comment.