Skip to content

Commit

Permalink
Merge pull request #3154 from vrurg/rakudo_3132
Browse files Browse the repository at this point in the history
Fix for failing declaration of grammar named Grammar

- Re-implemented `v6.e` `Grammar` use by `grammar` using `EXPORTHOW`.
- `p6getlexclient` got second optional parameter: `$setting-only` and was
fixed for correct handling of situations where our client is in `SETTING`
or `CORE` scope.
- Fixed core classes not having their language version set.
  • Loading branch information
vrurg committed Sep 2, 2019
2 parents 579ac66 + 46c0503 commit c757ada
Show file tree
Hide file tree
Showing 12 changed files with 193 additions and 153 deletions.
5 changes: 3 additions & 2 deletions docs/ops.markdown
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
9 changes: 7 additions & 2 deletions src/Perl6/Metamodel/ClassHOW.nqp
@@ -1,7 +1,7 @@
class Perl6::Metamodel::ClassHOW
does Perl6::Metamodel::Naming
does Perl6::Metamodel::Documenting
does Perl6::Metamodel::Versioning
does Perl6::Metamodel::LanguageRevision
does Perl6::Metamodel::Stashing
does Perl6::Metamodel::AttributeContainer
does Perl6::Metamodel::MethodContainer
Expand Down Expand Up @@ -52,7 +52,7 @@ class Perl6::Metamodel::ClassHOW
my $obj := nqp::settypehll($new_type, 'perl6');
$metaclass.set_name($obj, $name // "<anon|{$anon_id++}>");
self.add_stash($obj);
$metaclass.set_ver($obj, $ver);
$metaclass.set_ver($obj, $ver) if $ver;
$metaclass.set_auth($obj, $auth) if $auth;
$metaclass.set_api($obj, $api) if $api;
$metaclass.setup_mixin_cache($obj);
Expand Down Expand Up @@ -92,6 +92,11 @@ class Perl6::Metamodel::ClassHOW
method compose($the-obj, :$compiler_services) {
my $obj := nqp::decont($the-obj);

# Set class language version if class belongs to the CORE
if $*COMPILING_CORE_SETTING {
self.set_language_version($the-obj);
}

# Instantiate all of the roles we have (need to do this since
# all roles are generic on ::?CLASS) and pass them to the
# composer.
Expand Down
4 changes: 2 additions & 2 deletions src/Perl6/Metamodel/DefaultParent.nqp
Expand Up @@ -2,14 +2,14 @@ role Perl6::Metamodel::DefaultParent {
my @default_parent_type;

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

method has_default_parent_type() {
+@default_parent_type
}

method get_default_parent_type() {
nqp::p6getlexclient(@default_parent_type[0]);
@default_parent_type[0]
}
}
4 changes: 4 additions & 0 deletions src/Perl6/Metamodel/LanguageRevision.nqp
Expand Up @@ -6,6 +6,10 @@ role Perl6::Metamodel::LanguageRevision

# The only allowed version format is 6.X
method set_language_version($obj, $ver = NQPMu) {
# Don't override if version is already set
if self.ver($obj) {
return
}
if nqp::isconcrete($ver) {
nqp::die("Language version must be a string in '6.<rev>' format, got `$ver`.")
unless (nqp::iseq_i(nqp::chars($ver), 3) && nqp::eqat($ver, '6.', 0))
Expand Down
3 changes: 0 additions & 3 deletions src/Perl6/Metamodel/Versioning.nqp
Expand Up @@ -8,9 +8,6 @@ role Perl6::Metamodel::Versioning {
method api($obj) { $!api // '' }

method set_ver($obj, $ver) {
if $*COMPILING_CORE_SETTING && !$ver {
$ver := nqp::getcomp('perl6').language_version;
}
$!ver := $ver if $ver
}
method set_auth($obj, $auth) { $!auth := $auth }
Expand Down
233 changes: 151 additions & 82 deletions src/Perl6/Ops.nqp
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]
)
),
),
),
)
)
}
);

0 comments on commit c757ada

Please sign in to comment.