Skip to content

Commit

Permalink
Fix for incorrect default parent lookup
Browse files Browse the repository at this point in the history 
Where default parent is set in BOOTSTRAP it must not be looked up in
immediate client lexical scope but only in its SETTING.

p6getlexclient got second optional parameter: $setting-only and was
fixed for correct handling of situations where our client is in SETTING
or CORE scope.
  • Loading branch information
@vrurg
vrurg committed Aug 30, 2019
1 parent 2e4d295 commit 37d504e
Show file tree
Hide file tree
Showing 4 changed files with 160 additions and 88 deletions.
5 changes: 3 additions & 2 deletions docs/ops.markdown
View file
Expand Up @@ -164,9 +164,10 @@ Decodes the unix timestamp $epoch into a native int array with six fields contai
* p6finddispatcher(str $value)

## p6getlexclient
* p6getlexclient(str $symbol)
* p6getlexclient(str $symbol, int $setting-only)

Takes a name and finds corresponding symbol in lexical scope of [p6clientctx](#p6clientctx).
Takes a name and finds corresponding symbol in lexical scope of [p6clientctx](#p6clientctx). If `$setting-only` is set
to a _true_ value then lookup is performed only in client's SETTING.

## p6getouterctx
* p6getouterctx(Mu $closure)
Expand Down
6 changes: 4 additions & 2 deletions src/Perl6/Metamodel/DefaultParent.nqp
View file
@@ -1,15 +1,17 @@
role Perl6::Metamodel::DefaultParent {
my @default_parent_type;
my $setting_only := 0;

method set_default_parent_type($type) {
method set_default_parent_type($type, :$setting-only = 0) {
@default_parent_type[0] := nqp::isconcrete($type) ?? $type !! $type.HOW.name($type);
$setting_only := $setting-only;
}

method has_default_parent_type() {
+@default_parent_type
}

method get_default_parent_type() {
nqp::p6getlexclient(@default_parent_type[0]);
nqp::p6getlexclient( @default_parent_type[0], $setting_only );
}
}
233 changes: 151 additions & 82 deletions src/Perl6/Ops.nqp
View file
Expand Up @@ -192,119 +192,188 @@ _register_op_with_nqp( 'p6getlexclient', -> $qast {
my $PseudoStash := QAST::Node.unique('$PseudoStash');
my $Map := QAST::Node.unique('$Map');
my $stash := QAST::Node.unique('$stash');
QAST::Op.new(
:op<if>,
QAST::Op.new(
:op<isconcrete>,
QAST::VarWithFallback.new(
:name<$*OPTIMIZER-SYMBOLS>,
:fallback(
QAST::WVal.new( :value(Mu) )
),
:scope<contextual>
)
),
my $setting-only := QAST::Node.unique('$setting-only');
my $setting-only-var := QAST::Var.new( :name($setting-only), :scope<local> );
my $setting-only-named := QAST::Var.new( :name($setting-only), :scope<local> );
$setting-only-named.named('setting-only');
QAST::Stmts.new(
QAST::Op.new(
:op<callmethod>,
QAST::Var.new( :name<$*OPTIMIZER-SYMBOLS>, :scope<contextual> ),
QAST::SVal.new( :value<find_symbol> ),
QAST::Op.new(
:op<split>,
QAST::SVal.new( :value<::> ),
$qast[0]
)
:op<bind>,
QAST::Var.new( :name($setting-only), :scope<local>, :decl<var> ),
(nqp::atpos($qast, 1) || QAST::IVal.new( :value(0) ))
),
# QAST::Op.new(
# :op<if>,
# QAST::Op.new(:op<atkey>, QAST::Op.new(:op<getenvhash>), QAST::SVal.new(:value<RAKUDO_DEBUG>)),
# QAST::Op.new(
# :op<say>,
# QAST::Op.new(
# :op<concat>,
# QAST::SVal.new( value => "p6getlexclient: "),
# QAST::Op.new(
# :op<concat>,
# $qast[0],
# QAST::Op.new(
# :op<concat>,
# QAST::SVal.new(:value<, >),
# $setting-only-var
# )
# )
# )
# ),
# ),
QAST::Op.new(
:op<if>,
QAST::Op.new(
:op<isconcrete>,
QAST::VarWithFallback.new(
:name<$*W>,
:name<$*OPTIMIZER-SYMBOLS>,
:fallback(
QAST::Op.new( :op<null> )
# QAST::WVal.new( :value(NQPMu) )
QAST::WVal.new( :value(Mu) )
),
:scope<contextual>
)
),
QAST::Op.new(
:op<callmethod>,
QAST::Var.new( :name<$*W>, :scope<contextual> ),
QAST::SVal.new( :value<find_symbol> ),
:op<if>,
$setting-only-var,
QAST::Op.new(
:op<split>,
QAST::SVal.new( :value<::> ),
:op<callmethod>,
QAST::Var.new( :name<$*OPTIMIZER-SYMBOLS>, :scope<contextual> ),
QAST::SVal.new( :value<find_in_setting> ),
$qast[0]
)
),
QAST::Op.new(
:op<callmethod>,
QAST::Var.new( :name<$*OPTIMIZER-SYMBOLS>, :scope<contextual> ),
QAST::SVal.new( :value<find_symbol> ),
QAST::Op.new(
:op<split>,
QAST::SVal.new( :value<::> ),
$qast[0]
)
),
),
QAST::Stmts.new(
QAST::Op.new(
:op<if>,
QAST::Op.new(
:op<bind>,
QAST::Var.new( :name($ctx), :scope<local>, :decl<var> ),
QAST::Op.new( :op<p6clientctx> ),
:op<isconcrete>,
QAST::VarWithFallback.new(
:name<$*W>,
:fallback(
QAST::Op.new( :op<null> )
# QAST::WVal.new( :value(NQPMu) )
),
:scope<contextual>
)
),
QAST::Op.new(
:op<bind>,
QAST::Var.new( :name($PseudoStash), :scope<local>, :decl<var> ),
:op<callmethod>,
QAST::Var.new( :name<$*W>, :scope<contextual> ),
QAST::SVal.new( :value<find_symbol> ),
QAST::Op.new(
:op<getlexrel>,
QAST::Var.new( :name($ctx), :scope<local> ),
QAST::SVal.new( :value<PseudoStash> )
:op<split>,
QAST::SVal.new( :value<::> ),
$qast[0]
),
$setting-only-named
),
QAST::Op.new(
:op<bind>,
QAST::Var.new( :name($Map), :scope<local>, :decl<var> ),
QAST::Stmts.new(
QAST::Op.new(
:op<getlexrel>,
QAST::Var.new( :name($ctx), :scope<local> ),
QAST::SVal.new( :value<Map> )
:op<bind>,
QAST::Var.new( :name($ctx), :scope<local>, :decl<var> ),
QAST::Op.new( :op<p6clientctx> ),
),
),
QAST::Op.new(
:op<bind>,
QAST::Var.new( :name($stash), :scope<local>, :decl<var> ),
QAST::Op.new(
:op<create>,
QAST::Var.new( :name($PseudoStash), :scope<local> ),
)
),
QAST::Op.new(
:op<bindattr>,
QAST::Var.new( :name($stash), :scope<local> ),
QAST::Var.new( :name($Map), :scope<local> ),
QAST::SVal.new( :value<$!storage> ),
:op<bind>,
QAST::Var.new( :name($PseudoStash), :scope<local>, :decl<var> ),
QAST::Op.new(
:op<getlexrel>,
QAST::Var.new( :name($ctx), :scope<local> ),
QAST::SVal.new( :value<PseudoStash> )
),
),
QAST::Op.new(
:op<ctxlexpad>,
QAST::Var.new( :name($ctx), :scope<local> ),
:op<bind>,
QAST::Var.new( :name($Map), :scope<local>, :decl<var> ),
QAST::Op.new(
:op<getlexrel>,
QAST::Var.new( :name($ctx), :scope<local> ),
QAST::SVal.new( :value<Map> )
),
),
QAST::Op.new(
:op<bind>,
QAST::Var.new( :name($stash), :scope<local>, :decl<var> ),
QAST::Op.new(
:op<create>,
QAST::Var.new( :name($PseudoStash), :scope<local> ),
)
),
QAST::Op.new(
:op<bindattr>,
QAST::Var.new( :name($stash), :scope<local> ),
QAST::Var.new( :name($Map), :scope<local> ),
QAST::SVal.new( :value<$!storage> ),
QAST::Op.new(
:op<ctxlexpad>,
QAST::Var.new( :name($ctx), :scope<local> ),
),
),
),
QAST::Op.new(
:op<bindattr>,
QAST::Var.new( :name($stash), :scope<local> ),
QAST::Var.new( :name($PseudoStash), :scope<local> ),
QAST::SVal.new( :value<$!ctx> ),
QAST::Var.new( :name($ctx), :scope<local> ),
),
QAST::Op.new(
:op<bindattr_i>,
QAST::Var.new( :name($stash), :scope<local> ),
QAST::Var.new( :name($PseudoStash), :scope<local> ),
QAST::SVal.new( :value<$!mode> ),
QAST::IVal.new( :value(1) ) # PseudoStash::STATIC_CHAIN constant value
),
QAST::Op.new(
:op<call>,
QAST::Op.new(
:op<getlexrel>,
:op<bindattr>,
QAST::Var.new( :name($stash), :scope<local> ),
QAST::Var.new( :name($PseudoStash), :scope<local> ),
QAST::SVal.new( :value<$!ctx> ),
QAST::Var.new( :name($ctx), :scope<local> ),
QAST::SVal.new( :value<&INDIRECT_NAME_LOOKUP> )
),
QAST::Var.new( :name($stash), :scope<local> ),
$qast[0]
)
QAST::Op.new(
:op<bindattr_i>,
QAST::Var.new( :name($stash), :scope<local> ),
QAST::Var.new( :name($PseudoStash), :scope<local> ),
QAST::SVal.new( :value<$!mode> ),
QAST::IVal.new( :value(1) ) # PseudoStash::STATIC_CHAIN constant value
),
QAST::Op.new(
:op<if>,
$setting-only-var,
QAST::Op.new(
:op<bind>,
QAST::Var.new( :name($stash), :scope<local> ),
QAST::Op.new(
:op<who>,
QAST::Op.new(
:op<callmethod>,
QAST::Var.new( :name($stash), :scope<local> ),
QAST::SVal.new( :value<AT-KEY> ),
QAST::Op.new(
:op<if>, # If we can't 'see' '!UNIT_MARKER' then client is in CORE and SETTING cannot be used
QAST::Op.new(
:op<callmethod>,
QAST::Var.new( :name($stash), :scope<local> ),
QAST::SVal.new( :value<EXISTS-KEY> ),
QAST::SVal.new( :value<!UNIT_MARKER> )
),
QAST::SVal.new( :value<SETTING> ),
QAST::SVal.new( :value<CORE> )
)
)
)
)
),
QAST::Op.new(
:op<call>,
QAST::Op.new(
:op<getlexrel>,
QAST::Var.new( :name($ctx), :scope<local> ),
QAST::SVal.new( :value<&INDIRECT_NAME_LOOKUP> )
),
QAST::Var.new( :name($stash), :scope<local> ),
$qast[0]
)
),
),
),
)
)
}
);
4 changes: 2 additions & 2 deletions src/Perl6/bootstrap.c/BOOTSTRAP.nqp
View file
Expand Up @@ -3922,8 +3922,8 @@ Perl6::Metamodel::Configuration.set_stash_type(Stash, Map);
Perl6::Metamodel::Configuration.set_submethod_type(Submethod);

# Register default parent types.
Perl6::Metamodel::ClassHOW.set_default_parent_type(Any);
Perl6::Metamodel::GrammarHOW.set_default_parent_type(Grammar);
Perl6::Metamodel::ClassHOW.set_default_parent_type(Any, :setting-only);
Perl6::Metamodel::GrammarHOW.set_default_parent_type(Grammar, :setting-only);

# Put PROCESS in place, and ensure it's never repossessed.
nqp::neverrepossess(PROCESS.WHO);
Expand Down

0 comments on commit 37d504e

Please sign in to comment.