From 58c2d6492cd5419eeb45815849ceb6c2cec0c096 Mon Sep 17 00:00:00 2001 From: Vadim Belman Date: Fri, 1 Mar 2019 20:44:50 -0500 Subject: [PATCH 001/160] Fix for #2166 --- src/Perl6/Actions.nqp | 4 +++- src/Perl6/Metamodel/BOOTSTRAP.nqp | 10 +++++++--- src/Perl6/Metamodel/SubsetHOW.nqp | 3 +-- 3 files changed, 11 insertions(+), 6 deletions(-) diff --git a/src/Perl6/Actions.nqp b/src/Perl6/Actions.nqp index 8a450674597..1de5bfd69c0 100644 --- a/src/Perl6/Actions.nqp +++ b/src/Perl6/Actions.nqp @@ -3553,7 +3553,9 @@ class Perl6::Actions is HLL::Actions does STDActions { } sub check_default_value_type($/, $descriptor, $bind_constraint, $what) { - unless nqp::istype($descriptor.default, $bind_constraint) { + unless !( ( $descriptor.of.HOW =:= $*W.find_symbol(['Metamodel', 'DefiniteHOW'])) + || $descriptor.explicit_default ) + || nqp::istype($descriptor.default, $bind_constraint ) { $*W.throw($/, 'X::Syntax::Variable::MissingInitializer', type => nqp::how($bind_constraint).name($bind_constraint), implicit => !nqp::istype($*OFTYPE, NQPMatch) || !$*OFTYPE || $*OFTYPE && !$*OFTYPE.ast && !$*OFTYPE.ast diff --git a/src/Perl6/Metamodel/BOOTSTRAP.nqp b/src/Perl6/Metamodel/BOOTSTRAP.nqp index 73e030909d6..4a38adc653c 100644 --- a/src/Perl6/Metamodel/BOOTSTRAP.nqp +++ b/src/Perl6/Metamodel/BOOTSTRAP.nqp @@ -1133,22 +1133,26 @@ class ContainerDescriptor { has str $!name; has $!default; has int $!dynamic; + has int $!explicit_default; # I.e. default is explicitly set, not taken from $!of - method BUILD(:$of, str :$name, :$default, int :$dynamic) { + method BUILD(:$of, str :$name, :$default, int :$dynamic, int :$explicit_default = 0) { $!of := $of; $!name := $name; $!default := $default; $!dynamic := $dynamic; + $!explicit_default := $explicit_default; } method of() { $!of } method name() { $!name } method default() { $!default } method dynamic() { $!dynamic } + method explicit_default() { $!explicit_default } method set_of($of) { $!of := $of; self } - method set_default($default) { $!default := $default; self } + method set_default($default) { $!explicit_default := 1; $!default := $default; self } method set_dynamic($dynamic) { $!dynamic := $dynamic; self } + method set_explicit_default($explicit) { $!explicit_default := $explicit; self } method is_generic() { $!of.HOW.archetypes.generic @@ -1212,7 +1216,7 @@ class ContainerDescriptor::BindArrayPos2D does ContainerDescriptor::Whence { $self } - method name() { + method name() { 'element at [' ~ $!one ~ ',' ~ $!two ~ ']' # XXX name ? } method assigned($scalar) { diff --git a/src/Perl6/Metamodel/SubsetHOW.nqp b/src/Perl6/Metamodel/SubsetHOW.nqp index b661644a51b..ad5dbb01358 100644 --- a/src/Perl6/Metamodel/SubsetHOW.nqp +++ b/src/Perl6/Metamodel/SubsetHOW.nqp @@ -77,8 +77,7 @@ class Perl6::Metamodel::SubsetHOW # Do check when we're on LHS of smartmatch (e.g. Even ~~ Int). method type_check($obj, $checkee) { - nqp::hllboolfor(nqp::istrue($checkee.HOW =:= self) || - nqp::istype($!refinee, $checkee), "perl6") + nqp::hllboolfor( nqp::istype($!refinee, $checkee), "perl6" ) } # Here we check the value itself (when on RHS on smartmatch). From e297418e0a8dfe8e32c3b68cff8880aa7daa4303 Mon Sep 17 00:00:00 2001 From: Vadim Belman Date: Tue, 19 Mar 2019 17:49:51 -0400 Subject: [PATCH 002/160] Intermidate results, hit multi-dispatch proto choosing bug --- src/Perl6/Actions.nqp | 14 +++++-- src/Perl6/Metamodel/BOOTSTRAP.nqp | 39 ++++++++++++++++--- src/Perl6/Metamodel/Dispatchers.nqp | 1 + .../Metamodel/MROBasedMethodDispatch.nqp | 2 + src/Perl6/Metamodel/SubsetHOW.nqp | 16 +++++++- src/Perl6/World.nqp | 22 +++++++++-- src/core/Code.pm6 | 1 + src/core/IO/Socket/Async.pm6 | 5 ++- src/core/Mu.pm6 | 22 ++++++++++- src/core/Routine.pm6 | 1 + src/core/Signature.pm6 | 3 ++ 11 files changed, 110 insertions(+), 16 deletions(-) diff --git a/src/Perl6/Actions.nqp b/src/Perl6/Actions.nqp index 1de5bfd69c0..70a9f8735a8 100644 --- a/src/Perl6/Actions.nqp +++ b/src/Perl6/Actions.nqp @@ -3553,9 +3553,7 @@ class Perl6::Actions is HLL::Actions does STDActions { } sub check_default_value_type($/, $descriptor, $bind_constraint, $what) { - unless !( ( $descriptor.of.HOW =:= $*W.find_symbol(['Metamodel', 'DefiniteHOW'])) - || $descriptor.explicit_default ) - || nqp::istype($descriptor.default, $bind_constraint ) { + unless nqp::istype($descriptor.default, $bind_constraint) { $*W.throw($/, 'X::Syntax::Variable::MissingInitializer', type => nqp::how($bind_constraint).name($bind_constraint), implicit => !nqp::istype($*OFTYPE, NQPMatch) || !$*OFTYPE || $*OFTYPE && !$*OFTYPE.ast && !$*OFTYPE.ast @@ -4739,6 +4737,12 @@ class Perl6::Actions is HLL::Actions does STDActions { } # Add dispatching code. + # $BLOCK.push( + # QAST::Op.new( + # :op('say'), + # QAST::SVal.new(:value("onlystar call")) + # ) + # ); $BLOCK.push(QAST::Op.new( :op('invokewithcapture'), QAST::Op.new( @@ -6469,6 +6473,10 @@ class Perl6::Actions is HLL::Actions does STDActions { method term:sym($/) { my $dc_name := QAST::Node.unique('dispatch_cap'); my $stmts := QAST::Stmts.new( + QAST::Op.new( + :op('say'), + QAST::SVal.new(:value("term:sym call")) + ), QAST::Op.new( :op('bind'), QAST::Var.new( :name($dc_name), :scope('local'), :decl('var') ), diff --git a/src/Perl6/Metamodel/BOOTSTRAP.nqp b/src/Perl6/Metamodel/BOOTSTRAP.nqp index 4a38adc653c..aac80da34c6 100644 --- a/src/Perl6/Metamodel/BOOTSTRAP.nqp +++ b/src/Perl6/Metamodel/BOOTSTRAP.nqp @@ -1133,26 +1133,22 @@ class ContainerDescriptor { has str $!name; has $!default; has int $!dynamic; - has int $!explicit_default; # I.e. default is explicitly set, not taken from $!of - method BUILD(:$of, str :$name, :$default, int :$dynamic, int :$explicit_default = 0) { + method BUILD(:$of, str :$name, :$default, int :$dynamic) { $!of := $of; $!name := $name; $!default := $default; $!dynamic := $dynamic; - $!explicit_default := $explicit_default; } method of() { $!of } method name() { $!name } method default() { $!default } method dynamic() { $!dynamic } - method explicit_default() { $!explicit_default } method set_of($of) { $!of := $of; self } - method set_default($default) { $!explicit_default := 1; $!default := $default; self } + method set_default($default) { $!default := $default; self } method set_dynamic($dynamic) { $!dynamic := $dynamic; self } - method set_explicit_default($explicit) { $!explicit_default := $explicit; self } method is_generic() { $!of.HOW.archetypes.generic @@ -2213,6 +2209,9 @@ BEGIN { })); Routine.HOW.add_method(Routine, 'add_dispatchee', nqp::getstaticcode(sub ($self, $dispatchee) { my $dc_self := nqp::decont($self); + + my $pkg := nqp::getattr($dc_self, Routine, '$!package'); + my $disp_list := nqp::getattr($dc_self, Routine, '@!dispatchees'); if nqp::defined($disp_list) { $disp_list.push($dispatchee); @@ -2371,8 +2370,11 @@ BEGIN { my $dcself := nqp::decont($self); my @candidates := nqp::getattr($dcself, Routine, '@!dispatchees'); + nqp::say("Sorting " ~ +@candidates ~ " candidate(s) on " ~ $dcself.HOW.name($dcself)) if $*DFBD; + # Create a node for each candidate in the graph. my @graph; + my $ccnt := 0; for @candidates -> $candidate { # Get hold of signature. my $sig := nqp::getattr($candidate, Code, '$!signature'); @@ -2611,8 +2613,12 @@ BEGIN { # Get list and number of candidates, triggering a sort if there are none. my $dcself := nqp::decont($self); + my $pkg := nqp::getattr($dcself, Routine, '$!package'); + nqp::say("Seeking on " ~ $pkg.HOW.name($pkg) ~ " " ~ $dcself.HOW.name($dcself)) if $*DFBD; + nqp::say("NUM ARGS: " ~ $num_args) if $*DFBD; my @candidates := nqp::getattr($dcself, Routine, '@!dispatch_order'); if nqp::isnull(@candidates) { + nqp::say("no candidates, resorting") if $*DFBD; nqp::scwbdisable(); @candidates := $dcself.'!sort_dispatchees_internal'(); nqp::bindattr($dcself, Routine, '@!dispatch_order', @candidates); @@ -2635,12 +2641,20 @@ BEGIN { my $Positional := nqp::gethllsym('perl6', 'MD_Pos'); until $done { $cur_candidate := nqp::atpos(@candidates, $cur_idx); + nqp::say("? candidate // is concrete: " ~ nqp::isconcrete($cur_candidate)) if $*DFBD; + my $csub := nqp::atkey($cur_candidate, 'sub'); + if $csub && $*DFBD { + $pkg := nqp::getattr($csub, Routine, '$!package'); + nqp::say("? candidate name: " ~ $pkg.HOW.name($pkg) ~ "::" ~ $csub.name ~ " of " ~ $csub.HOW.name($csub)); + } if nqp::isconcrete($cur_candidate) { # Check if it's admissible by arity. + nqp::say("is concrete " ~ $cur_candidate.HOW.name($cur_candidate)) if $*DFBD; unless $num_args < nqp::atkey($cur_candidate, 'min_arity') || $num_args > nqp::atkey($cur_candidate, 'max_arity') { # Arity OK; now check if it's admissible by type. + nqp::say("arity ok") if $*DFBD; $type_check_count := nqp::atkey($cur_candidate, 'num_types') > $num_args ?? $num_args !! nqp::atkey($cur_candidate, 'num_types'); @@ -2649,15 +2663,18 @@ BEGIN { $i := 0; while $i < $type_check_count && !$type_mismatch && !$rwness_mismatch { + nqp::say("check param " ~ $i) if $*DFBD; my $type_obj := nqp::atpos(nqp::atkey($cur_candidate, 'types'), $i); my int $type_flags := nqp::atpos_i(nqp::atkey($cur_candidate, 'type_flags'), $i); my int $got_prim := nqp::captureposprimspec($capture, $i); my int $rwness := nqp::atpos_i(nqp::atkey($cur_candidate, 'rwness'), $i); if $rwness && !nqp::isrwcont(nqp::captureposarg($capture, $i)) { + nqp::say("rw mismatch for " ~ $i) if $*DFBD; # If we need a container but don't have one it clearly can't work. $rwness_mismatch := 1; } elsif $type_flags +& $TYPE_NATIVE_MASK { + nqp::say("natively typed? " ~ $i) if $*DFBD; # Looking for a natively typed value. Did we get one? if $got_prim == $BIND_VAL_OBJ { # Object, but could be a native container. If not, mismatch. @@ -2679,6 +2696,7 @@ BEGIN { my $param; my int $primish := 0; if $got_prim == $BIND_VAL_OBJ { + nqp::say("BIND_VAL_OBJ") if $*DFBD; $param := nqp::captureposarg($capture, $i); if nqp::iscont_i($param) { $param := Int; $primish := 1; } elsif nqp::iscont_n($param) { $param := Num; $primish := 1; } @@ -2686,25 +2704,31 @@ BEGIN { else { $param := nqp::hllizefor($param, 'perl6') } } else { + nqp::say("BIND_VAL_BASE") if $*DFBD; $param := $got_prim == $BIND_VAL_INT ?? Int !! $got_prim == $BIND_VAL_NUM ?? Num !! Str; $primish := 1; } if nqp::eqaddr($type_obj, Mu) || nqp::istype($param, $type_obj) { + nqp::say("type_obj type match?") if $*DFBD; if $i == 0 && nqp::existskey($cur_candidate, 'exact_invocant') { unless $param.WHAT =:= $type_obj { + nqp::say("type mismatch of param.WHAT =:= type_obj") if $*DFBD; $type_mismatch := 1; } } } else { if $type_obj =:= $Positional { + nqp::say("type_obj is Positional") if $*DFBD; my $PositionalBindFailover := nqp::gethllsym('perl6', 'MD_PBF'); unless nqp::istype($param, $PositionalBindFailover) { + nqp::say("type mismatch: PositionalBindFailover") if $*DFBD; $type_mismatch := 1; } } else { + nqp::say("type mistmatch: not Positional") if $*DFBD; $type_mismatch := 1; } } @@ -2713,6 +2737,7 @@ BEGIN { my int $desired := $type_flags +& $DEFCON_MASK; if ($defined && $desired == $DEFCON_UNDEFINED) || (!$defined && $desired == $DEFCON_DEFINED) { + nqp::say("type mistmatch: DEFCON") if $*DFBD; $type_mismatch := 1; } } @@ -2728,6 +2753,7 @@ BEGIN { ++$cur_idx; } else { + nqp::say("end of a tied group: got " ~ +@possibles ~ " possibles") if $*DFBD; # We've hit the end of a tied group now. If any of them have a # bindability check requirement, we'll do any of those now. if nqp::elems(@possibles) { @@ -3757,6 +3783,7 @@ nqp::sethllconfig('perl6', nqp::hash( # Tell parametric role groups how to create a dispatcher. Perl6::Metamodel::ParametricRoleGroupHOW.set_selector_creator({ + nqp::say("set_selector_creator") if $*DFBD; my $sel := nqp::create(Sub); my $onlystar := sub (*@pos, *%named) { nqp::invokewithcapture( diff --git a/src/Perl6/Metamodel/Dispatchers.nqp b/src/Perl6/Metamodel/Dispatchers.nqp index 4fc9ab3caea..e692a66f24c 100644 --- a/src/Perl6/Metamodel/Dispatchers.nqp +++ b/src/Perl6/Metamodel/Dispatchers.nqp @@ -81,6 +81,7 @@ class Perl6::Metamodel::MultiDispatcher is Perl6::Metamodel::BaseDispatcher { } method vivify_for($sub, $lexpad, $args) { + nqp::say("MultiDispatcher::vivify_for"); my $disp := $sub.dispatcher(); my $has_invocant := nqp::existskey($lexpad, 'self'); my $invocant := $has_invocant && $lexpad; diff --git a/src/Perl6/Metamodel/MROBasedMethodDispatch.nqp b/src/Perl6/Metamodel/MROBasedMethodDispatch.nqp index 148c00e0272..f075e20ad77 100644 --- a/src/Perl6/Metamodel/MROBasedMethodDispatch.nqp +++ b/src/Perl6/Metamodel/MROBasedMethodDispatch.nqp @@ -3,6 +3,8 @@ role Perl6::Metamodel::MROBasedMethodDispatch { # this is here as a fallback. method find_method($obj, $name, :$no_fallback, *%adverbs) { + nqp::say("find_method(" ~ $name ~ ")") if $*DFBD; + # uncomment line below for verbose information about uncached method lookups #nqp::say( "looking for " ~ $name ~ " in " ~ $obj.HOW.name($obj) ); # diff --git a/src/Perl6/Metamodel/SubsetHOW.nqp b/src/Perl6/Metamodel/SubsetHOW.nqp index ad5dbb01358..e992cfc874d 100644 --- a/src/Perl6/Metamodel/SubsetHOW.nqp +++ b/src/Perl6/Metamodel/SubsetHOW.nqp @@ -82,8 +82,22 @@ class Perl6::Metamodel::SubsetHOW # Here we check the value itself (when on RHS on smartmatch). method accepts_type($obj, $checkee) { + note("accepts_type(", $obj.HOW.name($obj), ", ", $checkee.HOW.name($checkee), ")"); + note("refinement is: ", $!refinement.HOW.name($!refinement)); + $!refinement.arep(); + + my &m := nqp::decont($!refinement.HOW.find_method($!refinement, 'ACCEPTS')); + nqp::say("Found ACCEPTS: " ~ &m.HOW.name(&m)); + nqp::say("is dispatcher? " ~ &m.is_dispatcher); + my @cand := nqp::getattr(&m, $*W.find_symbol(['Routine']), '@!dispatchees'); + nqp::say("candidates: " ~ +@cand); + my $*DFBD := 1; # Debug Find Best Dispatchee + nqp::say("ACCEPTS? " ~ nqp::callmethod($!refinement, 'ACCEPTS', $checkee)); + nqp::hllboolfor( nqp::istype($checkee, $!refinee) && - nqp::istrue($!refinement.ACCEPTS($checkee)), "perl6") + nqp::istrue($!refinement.ACCEPTS($checkee)), + "perl6" + ) } } diff --git a/src/Perl6/World.nqp b/src/Perl6/World.nqp index d483a10b593..28cd39accf1 100644 --- a/src/Perl6/World.nqp +++ b/src/Perl6/World.nqp @@ -1808,7 +1808,7 @@ class Perl6::World is HLL::World { %info := self.parameterize_type_with_args($/, %info, [$vtype], nqp::hash()); %info := $vtype; - %info := self.maybe-definite-how-base: $vtype; + %info := self.maybe-nominalize: $vtype; } else { %info := %info; @@ -1876,7 +1876,7 @@ class Perl6::World is HLL::World { %info, @value_type, nqp::hash()); %info := @value_type[0]; %info - := self.maybe-definite-how-base: @value_type[0]; + := self.maybe-nominalize: @value_type[0]; } else { %info := %info; @@ -1918,7 +1918,7 @@ class Perl6::World is HLL::World { %info := @value_type[0]; %info := @value_type[0]; %info - := self.maybe-definite-how-base: @value_type[0]; + := self.maybe-nominalize: @value_type[0]; } else { %info := self.find_symbol(['Mu'], :setting-only); @@ -1929,7 +1929,8 @@ class Perl6::World is HLL::World { } %info } - method maybe-definite-how-base ($v) { + + method maybe-definite-how-base($v) { # returns the value itself, unless it's a DefiniteHOW, in which case, # it returns its base type. Behaviour available in 6.d and later only. ! $*W.lang-ver-before('d') && nqp::eqaddr($v.HOW, @@ -1937,6 +1938,13 @@ class Perl6::World is HLL::World { ) ?? $v.HOW.base_type: $v !! $v } + method maybe-nominalize($v) { + # if $*W.lang-ver-before('e') { + # return self.maybe-definite-how-base($v); + # } + $v.HOW.archetypes.nominalizable ?? $v.HOW.nominalize($v) !! $v + } + # Installs one of the magical lexicals ($_, $/ and $!). Uses a cache to # avoid massive duplication of containers and container descriptors. method install_lexical_magical($block, $name) { @@ -2469,9 +2477,15 @@ class Perl6::World is HLL::World { } }; my $stub := nqp::freshcoderef(sub (*@pos, *%named) { + if $*DFBD { + for @pos -> $pp { + nqp::say("> pos: " ~ $pp.HOW.name($pp)); + } + } unless $precomp { $compiler_thunk(); } + nqp::say("PRECOMP: " ~ $precomp.HOW.name($precomp)) if $*DFBD; $precomp(|@pos, |%named); }); @compstuff[1] := $compiler_thunk; diff --git a/src/core/Code.pm6 b/src/core/Code.pm6 index 35580fd9df5..81d836a0253 100644 --- a/src/core/Code.pm6 +++ b/src/core/Code.pm6 @@ -5,6 +5,7 @@ my class Code does Callable { # declared in BOOTSTRAP # has @!compstuff; # Place for the compiler to hang stuff multi method ACCEPTS(Code:D $self: Mu $topic is raw) { + nqp::say("Code::ACCEPTS??"); $self.count ?? $self($topic) !! $self() } diff --git a/src/core/IO/Socket/Async.pm6 b/src/core/IO/Socket/Async.pm6 index ce4f62fb01d..e13cad7cecc 100644 --- a/src/core/IO/Socket/Async.pm6 +++ b/src/core/IO/Socket/Async.pm6 @@ -8,7 +8,10 @@ my class IO::Socket::Async { has $!close-promise; has $!close-vow; - subset Port-Number of Int where { !defined($_) or $_ ~~ ^65536 }; + subset SS of Str where { True }; + subset Port-Number of Int where { nqp::say("REFINEE!"); !defined($_) or $_ ~~ ^65536 }; + + has SS $.foo; has Str $.peer-host; has Port-Number $.peer-port; diff --git a/src/core/Mu.pm6 b/src/core/Mu.pm6 index bd11bdf35bb..b770c4de8a2 100644 --- a/src/core/Mu.pm6 +++ b/src/core/Mu.pm6 @@ -12,14 +12,34 @@ my class Mu { # declared in BOOTSTRAP method sink(--> Nil) { } - proto method ACCEPTS(|) {*} + proto method ACCEPTS(|c) {*} multi method ACCEPTS(Mu:U: Any \topic) { + nqp::say("Mu::ACCEPTS(Any): " ~ topic.^name); nqp::hllbool(nqp::istype(topic, self)) } multi method ACCEPTS(Mu:U: Mu:U \topic) { + nqp::say("Mu::ACCEPTS(Mu:U): " ~ topic.^name); nqp::hllbool(nqp::istype(topic, self)) } + method arep { + nqp::say( "--arep-- " ~ ($*W ?? "compile time" !! "no compiler") ~ " on " ~ self.^name); + my $am = self.^find_method('ACCEPTS'); + sub report_candidates ($m) { + nqp::say( ">------------------- " ~ $m.WHICH); + nqp::say($m.package.^name ~ "::" ~ $m.name); + nqp::say("is_dispatcher: " ~ nqp::istrue($m.is_dispatcher)); + nqp::say("candidates: " ~ $m.candidates.elems); + for $m.candidates -> \c { + nqp::say(c.^name ~ " " ~ (c.defined ?? "defined" !! "undefined") ~ " " ~ c.package.^name ~ "::" ~ c.name); + } + nqp::say( "<-------------------" ); + } + report_candidates($am); + report_candidates(Mu.^find_method('ACCEPTS')); + nqp::say("WHAT IF? " ~ self.ACCEPTS(Str)); + } + method WHERE() { nqp::p6box_i(nqp::where(self)) } diff --git a/src/core/Routine.pm6 b/src/core/Routine.pm6 index af67b8142f3..7c8899d1cb6 100644 --- a/src/core/Routine.pm6 +++ b/src/core/Routine.pm6 @@ -29,6 +29,7 @@ my class Routine { # declared in BOOTSTRAP } method cando(Capture:D $c) { + nqp::say("Routine::cando"); my $disp; if self.is_dispatcher { $disp := self; diff --git a/src/core/Signature.pm6 b/src/core/Signature.pm6 index 596b83835c3..c2068a32678 100644 --- a/src/core/Signature.pm6 +++ b/src/core/Signature.pm6 @@ -26,12 +26,15 @@ my class Signature { # declared in BOOTSTRAP } multi method ACCEPTS(Signature:D: Mu \topic) { + nqp::say("Signature::ACCEPTS(Mu)"); nqp::hllbool(nqp::istrue(try self.ACCEPTS: topic.Capture)) } multi method ACCEPTS(Signature:D: Capture $topic) { + nqp::say("Signature::ACCEPTS(Capture)"); nqp::hllbool(nqp::p6isbindable(self, nqp::decont($topic))); } multi method ACCEPTS(Signature:D: Signature:D $topic) { + nqp::say("Signature::ACCEPTS(Signature)"); my $sclass = self.params.classify({.named}); my $tclass = $topic.params.classify({.named}); my @spos := $sclass{False} // (); From b959ec9ba942f73172c23b40b5789e508022e3c8 Mon Sep 17 00:00:00 2001 From: Vadim Belman Date: Thu, 21 Mar 2019 14:49:39 -0400 Subject: [PATCH 003/160] Intermidiate commit Fighting rakudo/rakudo#2772 --- src/Perl6/Actions.nqp | 2 +- src/Perl6/Metamodel/BOOTSTRAP.nqp | 5 +++++ src/Perl6/Metamodel/MROBasedMethodDispatch.nqp | 2 -- src/Perl6/Metamodel/SubsetHOW.nqp | 17 +++++++++++------ src/Perl6/World.nqp | 9 +++++++++ src/core/Mu.pm6 | 1 - 6 files changed, 26 insertions(+), 10 deletions(-) diff --git a/src/Perl6/Actions.nqp b/src/Perl6/Actions.nqp index 70a9f8735a8..4702d1e2738 100644 --- a/src/Perl6/Actions.nqp +++ b/src/Perl6/Actions.nqp @@ -4073,7 +4073,7 @@ class Perl6::Actions is HLL::Actions does STDActions { my $predeclared := $outer.symbol($name); if $predeclared { my $Routine := $*W.find_symbol(['Routine'], :setting-only); - unless nqp::istype( $predeclared, $Routine) + unless nqp::istype($predeclared, $Routine) && nqp::getattr_i($predeclared, $Routine, '$!yada') { $*W.throw($/, ['X', 'Redeclaration'], symbol => ~$.ast, diff --git a/src/Perl6/Metamodel/BOOTSTRAP.nqp b/src/Perl6/Metamodel/BOOTSTRAP.nqp index aac80da34c6..cc25f38e591 100644 --- a/src/Perl6/Metamodel/BOOTSTRAP.nqp +++ b/src/Perl6/Metamodel/BOOTSTRAP.nqp @@ -2231,8 +2231,12 @@ BEGIN { })); Routine.HOW.add_method(Routine, 'derive_dispatcher', nqp::getstaticcode(sub ($self) { my $clone := $self.clone(); + my $*DFBD := 1; + nqp::say("+++++ derive_dispatcher clone") if $*DFBD; nqp::bindattr($clone, Routine, '@!dispatchees', nqp::clone(nqp::getattr($self, Routine, '@!dispatchees'))); + nqp::bindattr($clone, Routine, '$!package', $*PACKAGE); + nqp::say("----- derive_dispatcher cloned") if $*DFBD; $clone })); Routine.HOW.add_method(Routine, 'dispatcher', nqp::getstaticcode(sub ($self) { @@ -3786,6 +3790,7 @@ Perl6::Metamodel::ParametricRoleGroupHOW.set_selector_creator({ nqp::say("set_selector_creator") if $*DFBD; my $sel := nqp::create(Sub); my $onlystar := sub (*@pos, *%named) { + nqp::say("set_selector_creator / onlystar") if $*DFBD; nqp::invokewithcapture( nqp::getcodeobj(nqp::curcode()).find_best_dispatchee(nqp::usecapture()), nqp::usecapture()) diff --git a/src/Perl6/Metamodel/MROBasedMethodDispatch.nqp b/src/Perl6/Metamodel/MROBasedMethodDispatch.nqp index f075e20ad77..148c00e0272 100644 --- a/src/Perl6/Metamodel/MROBasedMethodDispatch.nqp +++ b/src/Perl6/Metamodel/MROBasedMethodDispatch.nqp @@ -3,8 +3,6 @@ role Perl6::Metamodel::MROBasedMethodDispatch { # this is here as a fallback. method find_method($obj, $name, :$no_fallback, *%adverbs) { - nqp::say("find_method(" ~ $name ~ ")") if $*DFBD; - # uncomment line below for verbose information about uncached method lookups #nqp::say( "looking for " ~ $name ~ " in " ~ $obj.HOW.name($obj) ); # diff --git a/src/Perl6/Metamodel/SubsetHOW.nqp b/src/Perl6/Metamodel/SubsetHOW.nqp index e992cfc874d..70e197204aa 100644 --- a/src/Perl6/Metamodel/SubsetHOW.nqp +++ b/src/Perl6/Metamodel/SubsetHOW.nqp @@ -84,14 +84,19 @@ class Perl6::Metamodel::SubsetHOW method accepts_type($obj, $checkee) { note("accepts_type(", $obj.HOW.name($obj), ", ", $checkee.HOW.name($checkee), ")"); note("refinement is: ", $!refinement.HOW.name($!refinement)); - $!refinement.arep(); + # $!refinement.arep(); - my &m := nqp::decont($!refinement.HOW.find_method($!refinement, 'ACCEPTS')); - nqp::say("Found ACCEPTS: " ~ &m.HOW.name(&m)); - nqp::say("is dispatcher? " ~ &m.is_dispatcher); - my @cand := nqp::getattr(&m, $*W.find_symbol(['Routine']), '@!dispatchees'); - nqp::say("candidates: " ~ +@cand); + # my &m := nqp::decont($!refinement.HOW.find_method($!refinement, 'ACCEPTS')); + # nqp::say("Found ACCEPTS: " ~ &m.HOW.name(&m)); + # nqp::say("is dispatcher? " ~ &m.is_dispatcher); + # my @cand := nqp::getattr(&m, $*W.find_symbol(['Routine']), '@!dispatchees'); + # nqp::say("candidates: " ~ +@cand); my $*DFBD := 1; # Debug Find Best Dispatchee + my %mt := nqp::getattr($*W.find_symbol(['Code']).HOW, Perl6::Metamodel::ClassHOW, '%!methods'); + my $m := nqp::atkey(%mt, 'ACCEPTS'); + nqp::say("... From methods table: " ~ $m.HOW.name($m)); + nqp::say("... Method package: " ~ $m.package.HOW.name($m.package)); + nqp::say("... Is dispatcher? " ~ $m.is_dispatcher); nqp::say("ACCEPTS? " ~ nqp::callmethod($!refinement, 'ACCEPTS', $checkee)); nqp::hllboolfor( diff --git a/src/Perl6/World.nqp b/src/Perl6/World.nqp index 28cd39accf1..8c6ea9115ba 100644 --- a/src/Perl6/World.nqp +++ b/src/Perl6/World.nqp @@ -2464,9 +2464,11 @@ class Perl6::World is HLL::World { # Compile the block. $precomp := self.compile_in_context($code_past, $code_type); + nqp::say("??? precomp is: " ~ $precomp.HOW.name($precomp)) if $*DFBD; # Also compile the candidates if this is a proto. if $is_dispatcher { + nqp::say("??? is dispatcher in thunk") if $*DFBD; for nqp::getattr($code, $routine_type, '@!dispatchees') { my $cs := nqp::getattr($_, $code_type, '@!compstuff'); my $past := $cs[0] unless nqp::isnull($cs); @@ -2483,6 +2485,7 @@ class Perl6::World is HLL::World { } } unless $precomp { + nqp::say("??? compiler thunk?") if $*DFBD; $compiler_thunk(); } nqp::say("PRECOMP: " ~ $precomp.HOW.name($precomp)) if $*DFBD; @@ -2502,6 +2505,7 @@ class Perl6::World is HLL::World { # boundary. if self.is_precompilation_mode() { @compstuff[2] := sub ($orig, $clone) { + nqp::say("??? stub \$!do mark boundary"); my $do := nqp::getattr($clone, $code_type, '$!do'); nqp::markcodestub($do); self.context().add_cleanup_task(sub () { @@ -2744,6 +2748,7 @@ class Perl6::World is HLL::World { # We need to do this for BEGIN but also for things that get called in # the compilation process, like user defined traits. method compile_in_context($past, $code_type) { + nqp::say("??? compile_in_context") if $*DFBD; # Ensure that we have the appropriate op libs loaded and correct # HLL. my $wrapper := QAST::Block.new(QAST::Stmts.new(), $past); @@ -2784,6 +2789,7 @@ class Perl6::World is HLL::World { $cur_block := $cur_block.ann('outer'); } + nqp::say("??? compile_in_context 2") if $*DFBD; # Compile it, set wrapper's static lexpad, then invoke the wrapper, # which fixes up the lexicals. my $compunit := QAST::CompUnit.new( @@ -2795,7 +2801,9 @@ class Perl6::World is HLL::World { my $comp := nqp::getcomp('perl6'); my $precomp := $comp.compile($compunit, :from, :compunit_ok(1), :lineposcache($*LINEPOSCACHE)); + nqp::say("??? compile_in_context 2a") if $*DFBD; my $mainline := $comp.backend.compunit_mainline($precomp); + nqp::say("??? compile_in_context 3") if $*DFBD; $mainline(); # Fix up Code object associations (including nested blocks). @@ -2841,6 +2849,7 @@ class Perl6::World is HLL::World { } # Flag block as dynamically compiled. + nqp::say("??? compile_in_context 4") if $*DFBD; $past.annotate('DYNAMICALLY_COMPILED', 1); # Return the VM coderef that maps to the thing we were originally diff --git a/src/core/Mu.pm6 b/src/core/Mu.pm6 index b770c4de8a2..468cca15713 100644 --- a/src/core/Mu.pm6 +++ b/src/core/Mu.pm6 @@ -37,7 +37,6 @@ my class Mu { # declared in BOOTSTRAP } report_candidates($am); report_candidates(Mu.^find_method('ACCEPTS')); - nqp::say("WHAT IF? " ~ self.ACCEPTS(Str)); } method WHERE() { From 09242aa732249dee4dc264119f0b6baaad83d752 Mon Sep 17 00:00:00 2001 From: Vadim Belman Date: Fri, 22 Mar 2019 13:52:53 -0400 Subject: [PATCH 004/160] Got working model for the new subset behavior --- src/Perl6/Actions.nqp | 10 ---------- src/Perl6/Metamodel/BOOTSTRAP.nqp | 30 ----------------------------- src/Perl6/Metamodel/Dispatchers.nqp | 1 - src/Perl6/Metamodel/SubsetHOW.nqp | 17 ---------------- src/core/Code.pm6 | 1 - src/core/IO/Socket/Async.pm6 | 5 +---- src/core/Mu.pm6 | 21 +------------------- src/core/Routine.pm6 | 1 - src/core/Signature.pm6 | 3 --- 9 files changed, 2 insertions(+), 87 deletions(-) diff --git a/src/Perl6/Actions.nqp b/src/Perl6/Actions.nqp index 4702d1e2738..b26a1da44fe 100644 --- a/src/Perl6/Actions.nqp +++ b/src/Perl6/Actions.nqp @@ -4737,12 +4737,6 @@ class Perl6::Actions is HLL::Actions does STDActions { } # Add dispatching code. - # $BLOCK.push( - # QAST::Op.new( - # :op('say'), - # QAST::SVal.new(:value("onlystar call")) - # ) - # ); $BLOCK.push(QAST::Op.new( :op('invokewithcapture'), QAST::Op.new( @@ -6473,10 +6467,6 @@ class Perl6::Actions is HLL::Actions does STDActions { method term:sym($/) { my $dc_name := QAST::Node.unique('dispatch_cap'); my $stmts := QAST::Stmts.new( - QAST::Op.new( - :op('say'), - QAST::SVal.new(:value("term:sym call")) - ), QAST::Op.new( :op('bind'), QAST::Var.new( :name($dc_name), :scope('local'), :decl('var') ), diff --git a/src/Perl6/Metamodel/BOOTSTRAP.nqp b/src/Perl6/Metamodel/BOOTSTRAP.nqp index cc25f38e591..0480dfd18fd 100644 --- a/src/Perl6/Metamodel/BOOTSTRAP.nqp +++ b/src/Perl6/Metamodel/BOOTSTRAP.nqp @@ -2231,12 +2231,9 @@ BEGIN { })); Routine.HOW.add_method(Routine, 'derive_dispatcher', nqp::getstaticcode(sub ($self) { my $clone := $self.clone(); - my $*DFBD := 1; - nqp::say("+++++ derive_dispatcher clone") if $*DFBD; nqp::bindattr($clone, Routine, '@!dispatchees', nqp::clone(nqp::getattr($self, Routine, '@!dispatchees'))); nqp::bindattr($clone, Routine, '$!package', $*PACKAGE); - nqp::say("----- derive_dispatcher cloned") if $*DFBD; $clone })); Routine.HOW.add_method(Routine, 'dispatcher', nqp::getstaticcode(sub ($self) { @@ -2374,8 +2371,6 @@ BEGIN { my $dcself := nqp::decont($self); my @candidates := nqp::getattr($dcself, Routine, '@!dispatchees'); - nqp::say("Sorting " ~ +@candidates ~ " candidate(s) on " ~ $dcself.HOW.name($dcself)) if $*DFBD; - # Create a node for each candidate in the graph. my @graph; my $ccnt := 0; @@ -2618,11 +2613,8 @@ BEGIN { # Get list and number of candidates, triggering a sort if there are none. my $dcself := nqp::decont($self); my $pkg := nqp::getattr($dcself, Routine, '$!package'); - nqp::say("Seeking on " ~ $pkg.HOW.name($pkg) ~ " " ~ $dcself.HOW.name($dcself)) if $*DFBD; - nqp::say("NUM ARGS: " ~ $num_args) if $*DFBD; my @candidates := nqp::getattr($dcself, Routine, '@!dispatch_order'); if nqp::isnull(@candidates) { - nqp::say("no candidates, resorting") if $*DFBD; nqp::scwbdisable(); @candidates := $dcself.'!sort_dispatchees_internal'(); nqp::bindattr($dcself, Routine, '@!dispatch_order', @candidates); @@ -2645,20 +2637,12 @@ BEGIN { my $Positional := nqp::gethllsym('perl6', 'MD_Pos'); until $done { $cur_candidate := nqp::atpos(@candidates, $cur_idx); - nqp::say("? candidate // is concrete: " ~ nqp::isconcrete($cur_candidate)) if $*DFBD; - my $csub := nqp::atkey($cur_candidate, 'sub'); - if $csub && $*DFBD { - $pkg := nqp::getattr($csub, Routine, '$!package'); - nqp::say("? candidate name: " ~ $pkg.HOW.name($pkg) ~ "::" ~ $csub.name ~ " of " ~ $csub.HOW.name($csub)); - } if nqp::isconcrete($cur_candidate) { # Check if it's admissible by arity. - nqp::say("is concrete " ~ $cur_candidate.HOW.name($cur_candidate)) if $*DFBD; unless $num_args < nqp::atkey($cur_candidate, 'min_arity') || $num_args > nqp::atkey($cur_candidate, 'max_arity') { # Arity OK; now check if it's admissible by type. - nqp::say("arity ok") if $*DFBD; $type_check_count := nqp::atkey($cur_candidate, 'num_types') > $num_args ?? $num_args !! nqp::atkey($cur_candidate, 'num_types'); @@ -2667,18 +2651,15 @@ BEGIN { $i := 0; while $i < $type_check_count && !$type_mismatch && !$rwness_mismatch { - nqp::say("check param " ~ $i) if $*DFBD; my $type_obj := nqp::atpos(nqp::atkey($cur_candidate, 'types'), $i); my int $type_flags := nqp::atpos_i(nqp::atkey($cur_candidate, 'type_flags'), $i); my int $got_prim := nqp::captureposprimspec($capture, $i); my int $rwness := nqp::atpos_i(nqp::atkey($cur_candidate, 'rwness'), $i); if $rwness && !nqp::isrwcont(nqp::captureposarg($capture, $i)) { - nqp::say("rw mismatch for " ~ $i) if $*DFBD; # If we need a container but don't have one it clearly can't work. $rwness_mismatch := 1; } elsif $type_flags +& $TYPE_NATIVE_MASK { - nqp::say("natively typed? " ~ $i) if $*DFBD; # Looking for a natively typed value. Did we get one? if $got_prim == $BIND_VAL_OBJ { # Object, but could be a native container. If not, mismatch. @@ -2700,7 +2681,6 @@ BEGIN { my $param; my int $primish := 0; if $got_prim == $BIND_VAL_OBJ { - nqp::say("BIND_VAL_OBJ") if $*DFBD; $param := nqp::captureposarg($capture, $i); if nqp::iscont_i($param) { $param := Int; $primish := 1; } elsif nqp::iscont_n($param) { $param := Num; $primish := 1; } @@ -2708,31 +2688,25 @@ BEGIN { else { $param := nqp::hllizefor($param, 'perl6') } } else { - nqp::say("BIND_VAL_BASE") if $*DFBD; $param := $got_prim == $BIND_VAL_INT ?? Int !! $got_prim == $BIND_VAL_NUM ?? Num !! Str; $primish := 1; } if nqp::eqaddr($type_obj, Mu) || nqp::istype($param, $type_obj) { - nqp::say("type_obj type match?") if $*DFBD; if $i == 0 && nqp::existskey($cur_candidate, 'exact_invocant') { unless $param.WHAT =:= $type_obj { - nqp::say("type mismatch of param.WHAT =:= type_obj") if $*DFBD; $type_mismatch := 1; } } } else { if $type_obj =:= $Positional { - nqp::say("type_obj is Positional") if $*DFBD; my $PositionalBindFailover := nqp::gethllsym('perl6', 'MD_PBF'); unless nqp::istype($param, $PositionalBindFailover) { - nqp::say("type mismatch: PositionalBindFailover") if $*DFBD; $type_mismatch := 1; } } else { - nqp::say("type mistmatch: not Positional") if $*DFBD; $type_mismatch := 1; } } @@ -2741,7 +2715,6 @@ BEGIN { my int $desired := $type_flags +& $DEFCON_MASK; if ($defined && $desired == $DEFCON_UNDEFINED) || (!$defined && $desired == $DEFCON_DEFINED) { - nqp::say("type mistmatch: DEFCON") if $*DFBD; $type_mismatch := 1; } } @@ -2757,7 +2730,6 @@ BEGIN { ++$cur_idx; } else { - nqp::say("end of a tied group: got " ~ +@possibles ~ " possibles") if $*DFBD; # We've hit the end of a tied group now. If any of them have a # bindability check requirement, we'll do any of those now. if nqp::elems(@possibles) { @@ -3787,10 +3759,8 @@ nqp::sethllconfig('perl6', nqp::hash( # Tell parametric role groups how to create a dispatcher. Perl6::Metamodel::ParametricRoleGroupHOW.set_selector_creator({ - nqp::say("set_selector_creator") if $*DFBD; my $sel := nqp::create(Sub); my $onlystar := sub (*@pos, *%named) { - nqp::say("set_selector_creator / onlystar") if $*DFBD; nqp::invokewithcapture( nqp::getcodeobj(nqp::curcode()).find_best_dispatchee(nqp::usecapture()), nqp::usecapture()) diff --git a/src/Perl6/Metamodel/Dispatchers.nqp b/src/Perl6/Metamodel/Dispatchers.nqp index e692a66f24c..4fc9ab3caea 100644 --- a/src/Perl6/Metamodel/Dispatchers.nqp +++ b/src/Perl6/Metamodel/Dispatchers.nqp @@ -81,7 +81,6 @@ class Perl6::Metamodel::MultiDispatcher is Perl6::Metamodel::BaseDispatcher { } method vivify_for($sub, $lexpad, $args) { - nqp::say("MultiDispatcher::vivify_for"); my $disp := $sub.dispatcher(); my $has_invocant := nqp::existskey($lexpad, 'self'); my $invocant := $has_invocant && $lexpad; diff --git a/src/Perl6/Metamodel/SubsetHOW.nqp b/src/Perl6/Metamodel/SubsetHOW.nqp index 70e197204aa..a5075a11a7a 100644 --- a/src/Perl6/Metamodel/SubsetHOW.nqp +++ b/src/Perl6/Metamodel/SubsetHOW.nqp @@ -82,23 +82,6 @@ class Perl6::Metamodel::SubsetHOW # Here we check the value itself (when on RHS on smartmatch). method accepts_type($obj, $checkee) { - note("accepts_type(", $obj.HOW.name($obj), ", ", $checkee.HOW.name($checkee), ")"); - note("refinement is: ", $!refinement.HOW.name($!refinement)); - # $!refinement.arep(); - - # my &m := nqp::decont($!refinement.HOW.find_method($!refinement, 'ACCEPTS')); - # nqp::say("Found ACCEPTS: " ~ &m.HOW.name(&m)); - # nqp::say("is dispatcher? " ~ &m.is_dispatcher); - # my @cand := nqp::getattr(&m, $*W.find_symbol(['Routine']), '@!dispatchees'); - # nqp::say("candidates: " ~ +@cand); - my $*DFBD := 1; # Debug Find Best Dispatchee - my %mt := nqp::getattr($*W.find_symbol(['Code']).HOW, Perl6::Metamodel::ClassHOW, '%!methods'); - my $m := nqp::atkey(%mt, 'ACCEPTS'); - nqp::say("... From methods table: " ~ $m.HOW.name($m)); - nqp::say("... Method package: " ~ $m.package.HOW.name($m.package)); - nqp::say("... Is dispatcher? " ~ $m.is_dispatcher); - nqp::say("ACCEPTS? " ~ nqp::callmethod($!refinement, 'ACCEPTS', $checkee)); - nqp::hllboolfor( nqp::istype($checkee, $!refinee) && nqp::istrue($!refinement.ACCEPTS($checkee)), diff --git a/src/core/Code.pm6 b/src/core/Code.pm6 index 81d836a0253..35580fd9df5 100644 --- a/src/core/Code.pm6 +++ b/src/core/Code.pm6 @@ -5,7 +5,6 @@ my class Code does Callable { # declared in BOOTSTRAP # has @!compstuff; # Place for the compiler to hang stuff multi method ACCEPTS(Code:D $self: Mu $topic is raw) { - nqp::say("Code::ACCEPTS??"); $self.count ?? $self($topic) !! $self() } diff --git a/src/core/IO/Socket/Async.pm6 b/src/core/IO/Socket/Async.pm6 index e13cad7cecc..ce4f62fb01d 100644 --- a/src/core/IO/Socket/Async.pm6 +++ b/src/core/IO/Socket/Async.pm6 @@ -8,10 +8,7 @@ my class IO::Socket::Async { has $!close-promise; has $!close-vow; - subset SS of Str where { True }; - subset Port-Number of Int where { nqp::say("REFINEE!"); !defined($_) or $_ ~~ ^65536 }; - - has SS $.foo; + subset Port-Number of Int where { !defined($_) or $_ ~~ ^65536 }; has Str $.peer-host; has Port-Number $.peer-port; diff --git a/src/core/Mu.pm6 b/src/core/Mu.pm6 index 468cca15713..bd11bdf35bb 100644 --- a/src/core/Mu.pm6 +++ b/src/core/Mu.pm6 @@ -12,33 +12,14 @@ my class Mu { # declared in BOOTSTRAP method sink(--> Nil) { } - proto method ACCEPTS(|c) {*} + proto method ACCEPTS(|) {*} multi method ACCEPTS(Mu:U: Any \topic) { - nqp::say("Mu::ACCEPTS(Any): " ~ topic.^name); nqp::hllbool(nqp::istype(topic, self)) } multi method ACCEPTS(Mu:U: Mu:U \topic) { - nqp::say("Mu::ACCEPTS(Mu:U): " ~ topic.^name); nqp::hllbool(nqp::istype(topic, self)) } - method arep { - nqp::say( "--arep-- " ~ ($*W ?? "compile time" !! "no compiler") ~ " on " ~ self.^name); - my $am = self.^find_method('ACCEPTS'); - sub report_candidates ($m) { - nqp::say( ">------------------- " ~ $m.WHICH); - nqp::say($m.package.^name ~ "::" ~ $m.name); - nqp::say("is_dispatcher: " ~ nqp::istrue($m.is_dispatcher)); - nqp::say("candidates: " ~ $m.candidates.elems); - for $m.candidates -> \c { - nqp::say(c.^name ~ " " ~ (c.defined ?? "defined" !! "undefined") ~ " " ~ c.package.^name ~ "::" ~ c.name); - } - nqp::say( "<-------------------" ); - } - report_candidates($am); - report_candidates(Mu.^find_method('ACCEPTS')); - } - method WHERE() { nqp::p6box_i(nqp::where(self)) } diff --git a/src/core/Routine.pm6 b/src/core/Routine.pm6 index 7c8899d1cb6..af67b8142f3 100644 --- a/src/core/Routine.pm6 +++ b/src/core/Routine.pm6 @@ -29,7 +29,6 @@ my class Routine { # declared in BOOTSTRAP } method cando(Capture:D $c) { - nqp::say("Routine::cando"); my $disp; if self.is_dispatcher { $disp := self; diff --git a/src/core/Signature.pm6 b/src/core/Signature.pm6 index c2068a32678..596b83835c3 100644 --- a/src/core/Signature.pm6 +++ b/src/core/Signature.pm6 @@ -26,15 +26,12 @@ my class Signature { # declared in BOOTSTRAP } multi method ACCEPTS(Signature:D: Mu \topic) { - nqp::say("Signature::ACCEPTS(Mu)"); nqp::hllbool(nqp::istrue(try self.ACCEPTS: topic.Capture)) } multi method ACCEPTS(Signature:D: Capture $topic) { - nqp::say("Signature::ACCEPTS(Capture)"); nqp::hllbool(nqp::p6isbindable(self, nqp::decont($topic))); } multi method ACCEPTS(Signature:D: Signature:D $topic) { - nqp::say("Signature::ACCEPTS(Signature)"); my $sclass = self.params.classify({.named}); my $tclass = $topic.params.classify({.named}); my @spos := $sclass{False} // (); From 631a5e985bcc683d6eaeecb2dbee30c559f49433 Mon Sep 17 00:00:00 2001 From: Vadim Belman Date: Fri, 22 Mar 2019 14:02:00 -0400 Subject: [PATCH 005/160] Remove debug leftovers --- src/Perl6/Metamodel/BOOTSTRAP.nqp | 6 ------ 1 file changed, 6 deletions(-) diff --git a/src/Perl6/Metamodel/BOOTSTRAP.nqp b/src/Perl6/Metamodel/BOOTSTRAP.nqp index 0480dfd18fd..19aaf138390 100644 --- a/src/Perl6/Metamodel/BOOTSTRAP.nqp +++ b/src/Perl6/Metamodel/BOOTSTRAP.nqp @@ -2209,9 +2209,6 @@ BEGIN { })); Routine.HOW.add_method(Routine, 'add_dispatchee', nqp::getstaticcode(sub ($self, $dispatchee) { my $dc_self := nqp::decont($self); - - my $pkg := nqp::getattr($dc_self, Routine, '$!package'); - my $disp_list := nqp::getattr($dc_self, Routine, '@!dispatchees'); if nqp::defined($disp_list) { $disp_list.push($dispatchee); @@ -2233,7 +2230,6 @@ BEGIN { my $clone := $self.clone(); nqp::bindattr($clone, Routine, '@!dispatchees', nqp::clone(nqp::getattr($self, Routine, '@!dispatchees'))); - nqp::bindattr($clone, Routine, '$!package', $*PACKAGE); $clone })); Routine.HOW.add_method(Routine, 'dispatcher', nqp::getstaticcode(sub ($self) { @@ -2373,7 +2369,6 @@ BEGIN { # Create a node for each candidate in the graph. my @graph; - my $ccnt := 0; for @candidates -> $candidate { # Get hold of signature. my $sig := nqp::getattr($candidate, Code, '$!signature'); @@ -2612,7 +2607,6 @@ BEGIN { # Get list and number of candidates, triggering a sort if there are none. my $dcself := nqp::decont($self); - my $pkg := nqp::getattr($dcself, Routine, '$!package'); my @candidates := nqp::getattr($dcself, Routine, '@!dispatch_order'); if nqp::isnull(@candidates) { nqp::scwbdisable(); From bc093fabc5a3773d9617576418829eb92a432a49 Mon Sep 17 00:00:00 2001 From: Vadim Belman Date: Sat, 1 Jun 2019 20:58:13 -0400 Subject: [PATCH 006/160] Activate nominalization for 6.e --- src/Perl6/World.nqp | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/Perl6/World.nqp b/src/Perl6/World.nqp index 49d7f62a3c0..f75603913f1 100644 --- a/src/Perl6/World.nqp +++ b/src/Perl6/World.nqp @@ -1985,9 +1985,9 @@ class Perl6::World is HLL::World { } method maybe-nominalize($v) { - # if $*W.lang-ver-before('e') { - # return self.maybe-definite-how-base($v); - # } + if $*W.lang-ver-before('e') { + return self.maybe-definite-how-base($v); + } $v.HOW.archetypes.nominalizable ?? $v.HOW.nominalize($v) !! $v } From 995c6424faad418250595af21b119ddfa178cf8e Mon Sep 17 00:00:00 2001 From: Vadim Belman Date: Tue, 4 Jun 2019 17:32:49 -0400 Subject: [PATCH 007/160] Nearly final implementation for 6.e perl6/problem-solving#3 --- src/Perl6/Actions.nqp | 32 +++++++++++++++++++++++++++----- src/Perl6/World.nqp | 20 ++++++++++---------- src/core/Exception.pm6 | 6 ++++-- 3 files changed, 41 insertions(+), 17 deletions(-) diff --git a/src/Perl6/Actions.nqp b/src/Perl6/Actions.nqp index fe4b45ca0dc..fe7652170f0 100644 --- a/src/Perl6/Actions.nqp +++ b/src/Perl6/Actions.nqp @@ -3361,7 +3361,8 @@ class Perl6::Actions is HLL::Actions does STDActions { } elsif $ eq '.=' { my $type := nqp::defined($*OFTYPE) - ?? $*W.maybe-definite-how-base($*OFTYPE.ast) !! $*W.find_symbol: ['Any']; + ?? $*W.maybe-nominalize($*OFTYPE.ast) !! $*W.find_symbol: ['Any']; + # ?? $*W.maybe-definite-how-base($*OFTYPE.ast) !! $*W.find_symbol: ['Any']; my $dot_equals := $initast; $dot_equals.unshift(QAST::WVal.new(:value($type))); $dot_equals.returns($type); @@ -3522,7 +3523,8 @@ class Perl6::Actions is HLL::Actions does STDActions { $init-qast.unshift: QAST::WVal.new: value => nqp::defined($*OFTYPE) - ?? $*W.maybe-definite-how-base($*OFTYPE.ast) !! $*W.find_symbol: ['Mu'] + ?? $*W.maybe-nominalize($*OFTYPE.ast) !! $*W.find_symbol: ['Mu'] + # ?? $*W.maybe-definite-how-base($*OFTYPE.ast) !! $*W.find_symbol: ['Mu'] if $ eq '.='; my $qast; @@ -3557,9 +3559,28 @@ class Perl6::Actions is HLL::Actions does STDActions { } sub check_default_value_type($/, $descriptor, $bind_constraint, $what) { - unless nqp::istype($descriptor.default, $bind_constraint) { - $*W.throw($/, 'X::Syntax::Variable::MissingInitializer', + my $matches; + my $maybe := 0; + note("TRY check_default_value_type") if nqp::getenvhash; + try { + $matches := nqp::istype($descriptor.default, $bind_constraint); + CATCH { + note("IN CATCH") if nqp::getenvhash; + $maybe := 1; + my $pl := nqp::getpayload($_); + if nqp::istype($pl, $*W.find_symbol(['Exception'])) { + @*SORROWS.push($pl); # XXX Perhaps a method on Grammer similar to typed_sorry but which accepts an exception? + } else { + # Don't be too verbose, report only the actual line with the error. + $/.sorry(nqp::getmessage($_), "\n", nqp::shift(nqp::backtracestrings($_))); + } + } + } + unless $matches { + note("NO MATCH $maybe") if nqp::getenvhash; + $/.typed_sorry('X::Syntax::Variable::MissingInitializer', type => nqp::how($bind_constraint).name($bind_constraint), + :$maybe, implicit => !nqp::istype($*OFTYPE, NQPMatch) || !$*OFTYPE || $*OFTYPE && !$*OFTYPE.ast && !$*OFTYPE.ast ?? ':' ~ $/.pragma($what) ~ ' by pragma' !! 0 @@ -5142,7 +5163,8 @@ class Perl6::Actions is HLL::Actions does STDActions { my $Mu := $W.find_symbol: ['Mu']; my $type := nqp::defined($*OFTYPE) ?? $*OFTYPE.ast !! $Mu; if $ eq '.=' { - my $init-type := $*W.maybe-definite-how-base: $type; + #my $init-type := $*W.maybe-definite-how-base: $type; + my $init-type := $*W.maybe-nominalize: $type; $value_ast.unshift: QAST::WVal.new: :value($init-type); $value_ast.returns: $init-type; } diff --git a/src/Perl6/World.nqp b/src/Perl6/World.nqp index f75603913f1..fa72c3c5d2e 100644 --- a/src/Perl6/World.nqp +++ b/src/Perl6/World.nqp @@ -1976,18 +1976,18 @@ class Perl6::World is HLL::World { %info } - method maybe-definite-how-base($v) { - # returns the value itself, unless it's a DefiniteHOW, in which case, - # it returns its base type. Behaviour available in 6.d and later only. - ! $*W.lang-ver-before('d') && nqp::eqaddr($v.HOW, - $*W.find_symbol: ['Metamodel','DefiniteHOW'], :setting-only - ) ?? $v.HOW.base_type: $v !! $v - } + # method maybe-definite-how-base($v) { + # # returns the value itself, unless it's a DefiniteHOW, in which case, + # # it returns its base type. Behaviour available in 6.d and later only. + # ! $*W.lang-ver-before('d') && nqp::eqaddr($v.HOW, + # $*W.find_symbol: ['Metamodel','DefiniteHOW'], :setting-only + # ) ?? $v.HOW.base_type: $v !! $v + # } method maybe-nominalize($v) { - if $*W.lang-ver-before('e') { - return self.maybe-definite-how-base($v); - } + # if $*W.lang-ver-before('e') { + # return self.maybe-definite-how-base($v); + # } $v.HOW.archetypes.nominalizable ?? $v.HOW.nominalize($v) !! $v } diff --git a/src/core/Exception.pm6 b/src/core/Exception.pm6 index 0d2ab03212b..b156762e4e5 100644 --- a/src/core/Exception.pm6 +++ b/src/core/Exception.pm6 @@ -1802,10 +1802,12 @@ my class X::Syntax::Term::MissingInitializer does X::Syntax { my class X::Syntax::Variable::MissingInitializer does X::Syntax { has $.type; has $.implicit; + has $.maybe; method message { + my $modality = $.maybe ?? "may need" !! "requires"; $.implicit ?? - "Variable definition of type $.type (implicit $.implicit) requires an initializer" !! - "Variable definition of type $.type requires an initializer" + "Variable definition of type $.type (implicit $.implicit) $modality an initializer" !! + "Variable definition of type $.type $modality an initializer" } } From 51f2f13b3bc415b46aff872ef84c5f2a5c6c7091 Mon Sep 17 00:00:00 2001 From: Vadim Belman Date: Tue, 4 Jun 2019 18:59:51 -0400 Subject: [PATCH 008/160] Clean up --- src/Perl6/Actions.nqp | 2 +- src/Perl6/World.nqp | 14 +++++++------- 2 files changed, 8 insertions(+), 8 deletions(-) diff --git a/src/Perl6/Actions.nqp b/src/Perl6/Actions.nqp index fe7652170f0..fc99b660808 100644 --- a/src/Perl6/Actions.nqp +++ b/src/Perl6/Actions.nqp @@ -5163,8 +5163,8 @@ class Perl6::Actions is HLL::Actions does STDActions { my $Mu := $W.find_symbol: ['Mu']; my $type := nqp::defined($*OFTYPE) ?? $*OFTYPE.ast !! $Mu; if $ eq '.=' { - #my $init-type := $*W.maybe-definite-how-base: $type; my $init-type := $*W.maybe-nominalize: $type; + # my $init-type := $*W.maybe-definite-how-base: $type; $value_ast.unshift: QAST::WVal.new: :value($init-type); $value_ast.returns: $init-type; } diff --git a/src/Perl6/World.nqp b/src/Perl6/World.nqp index fa72c3c5d2e..60d33cb1317 100644 --- a/src/Perl6/World.nqp +++ b/src/Perl6/World.nqp @@ -1976,13 +1976,13 @@ class Perl6::World is HLL::World { %info } - # method maybe-definite-how-base($v) { - # # returns the value itself, unless it's a DefiniteHOW, in which case, - # # it returns its base type. Behaviour available in 6.d and later only. - # ! $*W.lang-ver-before('d') && nqp::eqaddr($v.HOW, - # $*W.find_symbol: ['Metamodel','DefiniteHOW'], :setting-only - # ) ?? $v.HOW.base_type: $v !! $v - # } + method maybe-definite-how-base($v) { + # returns the value itself, unless it's a DefiniteHOW, in which case, + # it returns its base type. Behaviour available in 6.d and later only. + ! $*W.lang-ver-before('d') && nqp::eqaddr($v.HOW, + $*W.find_symbol: ['Metamodel','DefiniteHOW'], :setting-only + ) ?? $v.HOW.base_type: $v !! $v + } method maybe-nominalize($v) { # if $*W.lang-ver-before('e') { From f1512e9f976b4f57f39db809bf69bc068a70e7e5 Mon Sep 17 00:00:00 2001 From: Vadim Belman Date: Fri, 21 Jun 2019 18:38:53 -0400 Subject: [PATCH 009/160] Do correct assignment to SetHash Fix for rakudo/rakudo#1203 --- src/core/Any-iterable-methods.pm6 | 2 +- src/core/SetHash.pm6 | 11 +++++++++-- 2 files changed, 10 insertions(+), 3 deletions(-) diff --git a/src/core/Any-iterable-methods.pm6 b/src/core/Any-iterable-methods.pm6 index 22f7dc66f98..1f8bbe2c10e 100644 --- a/src/core/Any-iterable-methods.pm6 +++ b/src/core/Any-iterable-methods.pm6 @@ -23,7 +23,7 @@ augment class Any { X::Cannot::Map.new( what => self.^name, using => "a {iterable.^name}", - suggestion => + suggestion => "Did a * (Whatever) get absorbed by a comma, range, series, or list repetition? Consider using a block if any of these are necessary for your mapping code." ).throw; diff --git a/src/core/SetHash.pm6 b/src/core/SetHash.pm6 index dcfadf98f9f..288889b7cc4 100644 --- a/src/core/SetHash.pm6 +++ b/src/core/SetHash.pm6 @@ -1,8 +1,8 @@ my class SetHash does Setty { - method ^parameterize(Mu \base, Mu \type) { + method ^parameterize(Mu \base, Mu \type) { Rakudo::Internals.PARAMETERIZE-KEYOF(base,type) - } + } #--- selector methods @@ -203,6 +203,13 @@ my class SetHash does Setty { multi method Mixy (SetHash:D:) { self.MixHash } #--- interface methods + multi method STORE(SetHash:D: Setty:D \set --> SetHash:D) { + self.SET-SELF( + Rakudo::QuantHash.ADD-PAIRS-TO-SET( + nqp::create(Rakudo::Internals::IterationSet),set.iterator,self.keyof + ) + ) + } multi method STORE(SetHash:D: *@pairs --> SetHash:D) { nqp::if( (my \iterator := @pairs.iterator).is-lazy, From 8b9c7f70977bd4d37784d738f3d1d4f161acc658 Mon Sep 17 00:00:00 2001 From: Vadim Belman Date: Fri, 21 Jun 2019 22:11:26 -0400 Subject: [PATCH 010/160] Revert "Decontainerize non-scalar symbols upon import" This reverts commit 3af3bde70eaed13b235bc55c54cf0ca604be6fcf. --- src/Perl6/World.nqp | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/src/Perl6/World.nqp b/src/Perl6/World.nqp index dca38a411ee..e8e195ea10f 100644 --- a/src/Perl6/World.nqp +++ b/src/Perl6/World.nqp @@ -1488,8 +1488,7 @@ class Perl6::World is HLL::World { my @clash; my @clash_onlystar; for sorted_keys(%stash) -> $key { - # Prevent exported scalars from deconting. All other symbols are to be unwrapped. - my $value := nqp::iseq_s(nqp::substr($key,0,1),'$') ?? %stash{$key} !! nqp::decont(%stash{$key}); + my $value := %stash{$key}; if $target.symbol($key) -> %sym { # There's already a symbol. However, we may be able to merge # if both are multis and have onlystar dispatchers. From 0c8f960e87f8e52e16179c6f45f14445839b1096 Mon Sep 17 00:00:00 2001 From: Elizabeth Mattijsen Date: Sat, 22 Jun 2019 13:16:58 +0200 Subject: [PATCH 011/160] Revert "Do correct assignment to SetHash" This reverts commit f1512e9f976b4f57f39db809bf69bc068a70e7e5. - changes current semantics on which code may rely - so should probably be version based - doesn't fix the same issue that Set.STORE has - doesn't fix more generally issue that QuantHash.STORE(QuantHash) may have - is for a ticket that is more than 1.5 years old - so there is no urgency to fix this now just before a release that is already 2 months overdue --- src/core/Any-iterable-methods.pm6 | 2 +- src/core/SetHash.pm6 | 11 ++--------- 2 files changed, 3 insertions(+), 10 deletions(-) diff --git a/src/core/Any-iterable-methods.pm6 b/src/core/Any-iterable-methods.pm6 index 1f8bbe2c10e..22f7dc66f98 100644 --- a/src/core/Any-iterable-methods.pm6 +++ b/src/core/Any-iterable-methods.pm6 @@ -23,7 +23,7 @@ augment class Any { X::Cannot::Map.new( what => self.^name, using => "a {iterable.^name}", - suggestion => + suggestion => "Did a * (Whatever) get absorbed by a comma, range, series, or list repetition? Consider using a block if any of these are necessary for your mapping code." ).throw; diff --git a/src/core/SetHash.pm6 b/src/core/SetHash.pm6 index 288889b7cc4..dcfadf98f9f 100644 --- a/src/core/SetHash.pm6 +++ b/src/core/SetHash.pm6 @@ -1,8 +1,8 @@ my class SetHash does Setty { - method ^parameterize(Mu \base, Mu \type) { + method ^parameterize(Mu \base, Mu \type) { Rakudo::Internals.PARAMETERIZE-KEYOF(base,type) - } + } #--- selector methods @@ -203,13 +203,6 @@ my class SetHash does Setty { multi method Mixy (SetHash:D:) { self.MixHash } #--- interface methods - multi method STORE(SetHash:D: Setty:D \set --> SetHash:D) { - self.SET-SELF( - Rakudo::QuantHash.ADD-PAIRS-TO-SET( - nqp::create(Rakudo::Internals::IterationSet),set.iterator,self.keyof - ) - ) - } multi method STORE(SetHash:D: *@pairs --> SetHash:D) { nqp::if( (my \iterator := @pairs.iterator).is-lazy, From 93f20871e0a3d032121cfc460932500279e79ba3 Mon Sep 17 00:00:00 2001 From: Vadim Belman Date: Sat, 22 Jun 2019 14:56:32 -0400 Subject: [PATCH 012/160] Implement more fine-grained deconting of exported symbols The problem with containerized exports has been narrowed down to EXPORT sub using hash for declaring exports where all values are getting wrapped into Scalars. To fix that method import on World got a named parameter :need-decont which signals that imported symbols need to be checked for their sigils. Unless a sigil is $ or & the symbol value is nqp::decont'ed. This commit works for both rakudo/rakudo#2979 and rakudo/rakudo#3012. --- src/Perl6/World.nqp | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) diff --git a/src/Perl6/World.nqp b/src/Perl6/World.nqp index e8e195ea10f..92a3a7e3011 100644 --- a/src/Perl6/World.nqp +++ b/src/Perl6/World.nqp @@ -1068,7 +1068,7 @@ class Perl6::World is HLL::World { my $Map := self.find_symbol(['Map'], :setting-only); if nqp::istype($result, $Map) { my $storage := $result.hash.FLATTENABLE_HASH(); - self.import($/, $storage, $package_source_name); + self.import($/, $storage, $package_source_name, :need-decont); # $/.check_LANG_oopsies("do_import"); } else { @@ -1478,7 +1478,7 @@ class Perl6::World is HLL::World { } # Imports symbols from the specified stash into the current lexical scope. - method import($/, %stash, $source_package_name) { + method import($/, %stash, $source_package_name, :$need-decont = 0) { # What follows is a two-pass thing for historical reasons. my $target := self.cur_lexpad(); @@ -1489,6 +1489,9 @@ class Perl6::World is HLL::World { my @clash_onlystar; for sorted_keys(%stash) -> $key { my $value := %stash{$key}; + if $need-decont && nqp::islt_i(nqp::index('$&', nqp::substr($key,0,1)),0) { + $value := nqp::decont($value); + } if $target.symbol($key) -> %sym { # There's already a symbol. However, we may be able to merge # if both are multis and have onlystar dispatchers. From 0b9762642c0f1c4b90ec80d60babbb4e6dbef9e7 Mon Sep 17 00:00:00 2001 From: Elizabeth Mattijsen Date: Sat, 22 Jun 2019 21:32:54 +0200 Subject: [PATCH 013/160] Revert "Don't allow junctions as keys for Hash/Map initializations" This reverts commit 358d59fdae47edbe788fc8fea9afc27148896330. This appears to be needing a little more thought on maybe a deprecation cycle / version dependency. --- src/core/Hash.pm6 | 15 +-------------- src/core/Map.pm6 | 19 ++++--------------- 2 files changed, 5 insertions(+), 29 deletions(-) diff --git a/src/core/Hash.pm6 b/src/core/Hash.pm6 index ccd484f05eb..110e5016c35 100644 --- a/src/core/Hash.pm6 +++ b/src/core/Hash.pm6 @@ -46,12 +46,6 @@ my class Hash { # declared in BOOTSTRAP } proto method STORE_AT_KEY(|) {*} - multi method STORE_AT_KEY(Junction:D \key, Mu \x --> Nil) { - X::Cannot::Junction.new( - junction => key.gist, - for => 'as a key to initialize a Hash' - ).throw; - } multi method STORE_AT_KEY(Str:D \key, Mu \x --> Nil) { nqp::bindkey( nqp::getattr(self,Map,'$!storage'), @@ -499,14 +493,7 @@ my class Hash { # declared in BOOTSTRAP ) } - proto method STORE_AT_KEY(|) {*} - multi method STORE_AT_KEY(::?CLASS:D: Junction:D \key, Mu \x --> Nil) { - X::Cannot::Junction.new( - junction => key.gist, - for => 'as a key to initialize an object Hash' - ).throw; - } - multi method STORE_AT_KEY(::?CLASS:D: TKey \key, Mu \value --> Nil) { + method STORE_AT_KEY(::?CLASS:D: TKey \key, Mu \value --> Nil) { nqp::bindkey( nqp::getattr(self,Map,'$!storage'), nqp::unbox_s(key.WHICH), diff --git a/src/core/Map.pm6 b/src/core/Map.pm6 index 6fbe57ce0c9..eb06e51d855 100644 --- a/src/core/Map.pm6 +++ b/src/core/Map.pm6 @@ -1,5 +1,4 @@ my class X::Hash::Store::OddNumber { ... } -my class X::Cannot::Junction { ... } my class Map does Iterable does Associative { # declared in BOOTSTRAP # my class Map is Iterable is Cool @@ -391,20 +390,10 @@ my class Map does Iterable does Associative { # declared in BOOTSTRAP nqp::eqaddr((my Mu $x := iter.pull-one),IterationEnd), nqp::if( nqp::istype($x,Pair), - nqp::if( - nqp::istype( - (my \key := nqp::getattr(nqp::decont($x),Pair,'$!key')), - Junction - ), - X::Cannot::Junction.new( - junction => key.gist, - for => 'as a key to initialize a Map' - ).throw, - nqp::bindkey( - $!storage, - key.Str, - nqp::decont(nqp::getattr(nqp::decont($x),Pair,'$!value')) - ) + nqp::bindkey( + $!storage, + nqp::getattr(nqp::decont($x),Pair,'$!key').Str, + nqp::decont(nqp::getattr(nqp::decont($x),Pair,'$!value')) ), nqp::if( (nqp::istype($x,Map) && nqp::not_i(nqp::iscont($x))), From 090f3f1b45c1af1e3550eaf32159fe88b7a43c04 Mon Sep 17 00:00:00 2001 From: Elizabeth Mattijsen Date: Sat, 22 Jun 2019 22:37:59 +0200 Subject: [PATCH 014/160] Revert 7af0fb1 94ba19f 9107215 We need to look into this deeper. --- src/core/Iterator.pm6 | 8 -------- src/core/Rakudo/Iterator.pm6 | 10 ++-------- src/core/Seq.pm6 | 8 +------- src/core/Sequence.pm6 | 2 +- 4 files changed, 4 insertions(+), 24 deletions(-) diff --git a/src/core/Iterator.pm6 b/src/core/Iterator.pm6 index 4b65eb4491f..339b2835cbb 100644 --- a/src/core/Iterator.pm6 +++ b/src/core/Iterator.pm6 @@ -131,12 +131,4 @@ my role PredictiveIterator does Iterator { method bool-only(--> Bool:D) { self.count-only.Bool } } -# The CachedIterator role is a refinement of the PredictiveIterator role for -# those cases when all values have been generated already. It prevents the -# already generated values from being cached yet again for a Sequence. -my role CachedIterator does PredictiveIterator { - # The "cache" method should return a List of the already generated values. - method cache(--> List:D) { ... } -} - # vim: ft=perl6 expandtab sw=4 diff --git a/src/core/Rakudo/Iterator.pm6 b/src/core/Rakudo/Iterator.pm6 index 00c6baf7ed1..56e9968ee7e 100644 --- a/src/core/Rakudo/Iterator.pm6 +++ b/src/core/Rakudo/Iterator.pm6 @@ -2612,7 +2612,7 @@ class Rakudo::Iterator { # Return an iterator for an Array that has been completely reified # already. Returns a assignable container for elements don't exist # before the end of the reified array. - my class ReifiedArrayIterator does CachedIterator { + my class ReifiedArrayIterator does PredictiveIterator { has $!reified; has $!descriptor; has int $!i; @@ -2701,9 +2701,6 @@ class Rakudo::Iterator { - nqp::islt_i($!i,nqp::elems($!reified)) ) } - method cache(--> List:D) { - nqp::p6bindattrinvres(nqp::create(List),List,'$!reified',$!reified) - } method sink-all(--> IterationEnd) { $!i = nqp::elems($!reified) } } method ReifiedArray(\array, Mu \descriptor) { @@ -2713,7 +2710,7 @@ class Rakudo::Iterator { # Return an iterator for a List that has been completely reified # already. Returns an nqp::null for elements that don't exist # before the end of the reified list. - my class ReifiedListIterator does CachedIterator { + my class ReifiedListIterator does Iterator { has $!reified; has int $!i; @@ -2794,9 +2791,6 @@ class Rakudo::Iterator { - nqp::islt_i($!i,nqp::elems($!reified)) ) } - method cache(--> List:D) { - nqp::p6bindattrinvres(nqp::create(List),List,'$!reified',$!reified) - } method sink-all(--> IterationEnd) { $!i = nqp::elems($!reified) } } method ReifiedList(\list) { diff --git a/src/core/Seq.pm6 b/src/core/Seq.pm6 index dbbb0e04149..f95e231c8b5 100644 --- a/src/core/Seq.pm6 +++ b/src/core/Seq.pm6 @@ -19,13 +19,7 @@ my class Seq is Cool does Iterable does Sequence { nqp::if( nqp::isconcrete(my \iter = $!iter), nqp::stmts( - ($!iter := Iterator), # allow usage only once - nqp::if( - nqp::istype(iter,CachedIterator), - nqp::bindattr( # can set up cache now - self,::?CLASS,'$!list',nqp::decont(iter.cache) - ) - ), + ($!iter := Iterator), iter ), nqp::if( diff --git a/src/core/Sequence.pm6 b/src/core/Sequence.pm6 index 6f77cc78c72..c0a9c563060 100644 --- a/src/core/Sequence.pm6 +++ b/src/core/Sequence.pm6 @@ -29,7 +29,7 @@ my role PositionalBindFailover { ) } multi method list(::?CLASS:D:) { - self.cache + List.from-iterator(self.iterator) } method iterator() { ... } From 865238697405b2b3dadffbde5b9141f6a5fc6ad8 Mon Sep 17 00:00:00 2001 From: Elizabeth Mattijsen Date: Sat, 22 Jun 2019 23:56:04 +0200 Subject: [PATCH 015/160] Handle Junctions in Bool context within grep Fixes R#2975 --- src/core/Any-iterable-methods.pm6 | 21 +++++++++++---------- 1 file changed, 11 insertions(+), 10 deletions(-) diff --git a/src/core/Any-iterable-methods.pm6 b/src/core/Any-iterable-methods.pm6 index 22f7dc66f98..5f900d3e5cb 100644 --- a/src/core/Any-iterable-methods.pm6 +++ b/src/core/Any-iterable-methods.pm6 @@ -962,13 +962,13 @@ Consider using a block if any of these are necessary for your mapping code." sequential-map( self.iterator, { - my \result := $test($_); - nqp::if( - nqp::istype(result, Regex) || nqp::istype(result, Junction) - ?? result.ACCEPTS($_) - !! result, - $_, - Empty) + (nqp::istype((my \result := $test($_)),Regex) + ?? result.ACCEPTS($_) + !! nqp::istype(result,Junction) + ?? result.Bool + !! result + ) ?? $_ + !! Empty }, Any) , @@ -1144,9 +1144,10 @@ Consider using a block if any of these are necessary for your mapping code." method !wrap-callable-for-grep($test) { ({ - my \result := $test($_); - nqp::istype(result, Regex) || nqp::istype(result, Junction) - ?? result.ACCEPTS($_) + nqp::istype((my \result := $test($_)),Regex) + ?? result.ACCEPTS($_) + !! nqp::istype(result,Junction) + ?? result.Bool !! result }) } From 28d8eb032c1ce6aeab99e4850a561e69af60c0ad Mon Sep 17 00:00:00 2001 From: Vadim Belman Date: Sun, 23 Jun 2019 20:41:45 -0400 Subject: [PATCH 016/160] Small optimization Don't decont if &EXPORT returned a pure Map. It already contains deconted values. --- src/Perl6/World.nqp | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Perl6/World.nqp b/src/Perl6/World.nqp index 92a3a7e3011..73b47faa882 100644 --- a/src/Perl6/World.nqp +++ b/src/Perl6/World.nqp @@ -1068,7 +1068,7 @@ class Perl6::World is HLL::World { my $Map := self.find_symbol(['Map'], :setting-only); if nqp::istype($result, $Map) { my $storage := $result.hash.FLATTENABLE_HASH(); - self.import($/, $storage, $package_source_name, :need-decont); + self.import($/, $storage, $package_source_name, :need-decont(!($result =:= $Map))); # $/.check_LANG_oopsies("do_import"); } else { From f62cf1bf4f4d138adb855b4e0edd1a715f08d923 Mon Sep 17 00:00:00 2001 From: Vadim Belman Date: Mon, 24 Jun 2019 10:26:45 -0400 Subject: [PATCH 017/160] Typecheck against nqp::what() not the object itself. --- src/Perl6/World.nqp | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Perl6/World.nqp b/src/Perl6/World.nqp index 73b47faa882..f8652def6df 100644 --- a/src/Perl6/World.nqp +++ b/src/Perl6/World.nqp @@ -1068,7 +1068,7 @@ class Perl6::World is HLL::World { my $Map := self.find_symbol(['Map'], :setting-only); if nqp::istype($result, $Map) { my $storage := $result.hash.FLATTENABLE_HASH(); - self.import($/, $storage, $package_source_name, :need-decont(!($result =:= $Map))); + self.import($/, $storage, $package_source_name, :need-decont(!(nqp::what($result) =:= $Map))); # $/.check_LANG_oopsies("do_import"); } else { From 66d92c621931dd688d868ce5a6d7abe21b0bea76 Mon Sep 17 00:00:00 2001 From: Ben Davies Date: Mon, 24 Jun 2019 13:51:32 -0300 Subject: [PATCH 018/160] Fix PseudoStash.WHICH's signature It included PseudoStash:D as an argument when it's supposed to be the type of the object itself. Fixes #3018 --- src/core/PseudoStash.pm6 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/core/PseudoStash.pm6 b/src/core/PseudoStash.pm6 index 080500f3463..c744f0887aa 100644 --- a/src/core/PseudoStash.pm6 +++ b/src/core/PseudoStash.pm6 @@ -20,7 +20,7 @@ my class PseudoStash is Map { $obj } - multi method WHICH(PseudoStash:D --> ObjAt:D) { self.Mu::WHICH } + multi method WHICH(PseudoStash:D: --> ObjAt:D) { self.Mu::WHICH } my $pseudoers := nqp::hash( 'MY', sub ($cur) { @@ -252,7 +252,7 @@ my class PseudoStash is Map { ) } - # for some reason we get a ambiguous dispatch error by making this a multi + # for some reason we get an ambiguous dispatch error by making this a multi method EXISTS-KEY(PseudoStash:D: Str() $key) { nqp::unless( nqp::existskey($pseudoers,$key), From 8969399b31642302d017a6ae051ea85163b26fc0 Mon Sep 17 00:00:00 2001 From: Elizabeth Mattijsen Date: Mon, 24 Jun 2019 21:23:59 +0200 Subject: [PATCH 019/160] Add a few missing colons, spotted by dogbert++ There were no issues because of this, as the Any variant did the right thing, albeit much less efficiently --- src/core/Bag.pm6 | 4 ++-- src/core/Mix.pm6 | 2 +- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/src/core/Bag.pm6 b/src/core/Bag.pm6 index cfea2271079..be08903586c 100644 --- a/src/core/Bag.pm6 +++ b/src/core/Bag.pm6 @@ -68,7 +68,7 @@ my class Bag does Baggy { #--- coercion methods multi method Bag(Bag:D:) { self } - multi method BagHash(Bag:D) { + multi method BagHash(Bag:D:) { nqp::if( $!elems && nqp::elems($!elems), nqp::create(BagHash).SET-SELF(Rakudo::QuantHash.BAGGY-CLONE($!elems)), @@ -82,7 +82,7 @@ my class Bag does Baggy { mix() ) } - multi method MixHash(Bag:D) { + multi method MixHash(Bag:D:) { nqp::if( $!elems && nqp::elems($!elems), nqp::create(MixHash).SET-SELF(Rakudo::QuantHash.BAGGY-CLONE($!elems)), diff --git a/src/core/Mix.pm6 b/src/core/Mix.pm6 index cc51e8b9b62..7d62ae0f8a0 100644 --- a/src/core/Mix.pm6 +++ b/src/core/Mix.pm6 @@ -78,7 +78,7 @@ my class Mix does Mixy { #--- coercion methods multi method Mix(Mix:D:) { self } - multi method MixHash(Mix:D) { + multi method MixHash(Mix:D:) { nqp::if( $!elems && nqp::elems($!elems), nqp::create(MixHash).SET-SELF(Rakudo::QuantHash.BAGGY-CLONE($!elems)), From 9b639961c03e45b3a6302fe802ba52bca3cf6695 Mon Sep 17 00:00:00 2001 From: Elizabeth Mattijsen Date: Mon, 24 Jun 2019 21:32:45 +0200 Subject: [PATCH 020/160] Another missing colon, spotted by dogbert++ --- src/core/Set.pm6 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/core/Set.pm6 b/src/core/Set.pm6 index 3f0143eb5ca..f799b400f69 100644 --- a/src/core/Set.pm6 +++ b/src/core/Set.pm6 @@ -72,7 +72,7 @@ my class Set does Setty { multi method grab(Set:D: $count?) { X::Immutable.new( method => 'grab', typename => self.^name ).throw; } - multi method grabpairs(Set:D $count?) { + multi method grabpairs(Set:D: $count?) { X::Immutable.new( method => 'grabpairs', typename => self.^name ).throw; } From 16607d3f5af3366809847688ef97f6628c78ba91 Mon Sep 17 00:00:00 2001 From: Ben Davies Date: Fri, 21 Jun 2019 07:08:20 +0000 Subject: [PATCH 021/160] Make socket family handling portable MoarVM and the JVM now take a separate family parameter from the port; update use of the nqp::bind_sk and nqp::connect_sk ops accordingly and use the same socket family constants used by MoarVM and the JVM. Related to https://github.com/rakudo/rakudo/issues/3007 --- src/core/IO/Socket/INET.pm6 | 50 +++++++++++++++++++------------------ 1 file changed, 26 insertions(+), 24 deletions(-) diff --git a/src/core/IO/Socket/INET.pm6 b/src/core/IO/Socket/INET.pm6 index 2b5f466f800..d47ac3e1421 100644 --- a/src/core/IO/Socket/INET.pm6 +++ b/src/core/IO/Socket/INET.pm6 @@ -1,9 +1,9 @@ my class IO::Socket::INET does IO::Socket { my module PIO { - constant PF_LOCAL = 0; - constant PF_UNIX = 1; - constant PF_INET = 2; - constant PF_INET6 = 3; + constant PF_INET = 1; + constant PF_INET6 = 2; + constant PF_LOCAL = 3; + constant PF_UNIX = 3; constant PF_MAX = 4; constant SOCK_PACKET = 0; constant SOCK_STREAM = 1; @@ -18,15 +18,15 @@ my class IO::Socket::INET does IO::Socket { constant MAX_PORT = 65_535; # RFC 793: TCP/UDP port limit } - has Str $.host; - has Int $.port; - has Str $.localhost; - has Int $.localport; - has Int $.backlog; + has Str $.host; + has Int $.port; + has Str $.localhost; + has Int $.localport; + has Int $.backlog; has Bool $.listening; - has $.family = PIO::PF_INET; - has $.proto = PIO::PROTO_TCP; - has $.type = PIO::SOCK_STREAM; + has $.family = PIO::PF_INET; + has $.proto = PIO::PROTO_TCP; + has $.type = PIO::SOCK_STREAM; my sub split-host-port(:$host is copy, :$port is copy, :$family) { if ($host) { @@ -98,7 +98,7 @@ my class IO::Socket::INET does IO::Socket { :$family, ); - #TODO: Learn what protocols map to which socket types and then determine which is needed. + # TODO: Learn what protocols map to which socket types and then determine which is needed. self.bless( :$host, :$port, @@ -114,22 +114,24 @@ my class IO::Socket::INET does IO::Socket { } method !initialize() { - my $PIO := nqp::socket($.listening ?? 10 !! 0); - #Quoting perl5's SIO::INET: - #If Listen is defined then a listen socket is created, else if the socket type, - #which is derived from the protocol, is SOCK_STREAM then connect() is called. - if $.listening || $.localhost || $.localport { - nqp::bindsock($PIO, nqp::unbox_s($.localhost || "0.0.0.0"), - nqp::unbox_i($.localport || 0), nqp::unbox_i($.backlog || 128)); + my $PIO := nqp::socket($!listening ?? 10 !! 0); + + # Quoting perl5's SIO::INET: + # If Listen is defined then a listen socket is created, else if the socket type, + # which is derived from the protocol, is SOCK_STREAM then connect() is called. + if $!listening || $!localhost || $!localport { + nqp::bindsock($PIO, nqp::unbox_s($!localhost || "0.0.0.0"), + nqp::unbox_i($!localport || 0), nqp::unbox_i($!family), + nqp::unbox_i($!backlog || 128)); } - if $.listening { + if $!listening { #?if !js $!localport = nqp::getport($PIO) if !$!localport; #?endif } - elsif $.type == PIO::SOCK_STREAM { - nqp::connect($PIO, nqp::unbox_s($.host), nqp::unbox_i($.port)); + elsif $!type == PIO::SOCK_STREAM { + nqp::connect($PIO, nqp::unbox_s($!host), nqp::unbox_i($!port), nqp::unbox_i($!family)); } nqp::bindattr(self, $?CLASS, '$!PIO', $PIO); @@ -145,7 +147,7 @@ my class IO::Socket::INET does IO::Socket { } method accept() { - ## A solution as proposed by moritz + # A solution as proposed by moritz my $new_sock := $?CLASS.bless(:$!family, :$!proto, :$!type, :$!nl-in); nqp::bindattr($new_sock, $?CLASS, '$!PIO', nqp::accept(nqp::getattr(self, $?CLASS, '$!PIO')) From 17f6603945fc583d178d92d6c0ef8c165bdd4a2a Mon Sep 17 00:00:00 2001 From: Ben Davies Date: Tue, 25 Jun 2019 20:10:43 -0300 Subject: [PATCH 022/160] Use nqp::const for socket family constants --- src/core/IO/Socket/INET.pm6 | 11 ++++++----- 1 file changed, 6 insertions(+), 5 deletions(-) diff --git a/src/core/IO/Socket/INET.pm6 b/src/core/IO/Socket/INET.pm6 index d47ac3e1421..f60480abe71 100644 --- a/src/core/IO/Socket/INET.pm6 +++ b/src/core/IO/Socket/INET.pm6 @@ -1,10 +1,11 @@ my class IO::Socket::INET does IO::Socket { my module PIO { - constant PF_INET = 1; - constant PF_INET6 = 2; - constant PF_LOCAL = 3; - constant PF_UNIX = 3; - constant PF_MAX = 4; + constant PF_UNSPEC = nqp::const::SOCKET_FAMILY_UNSPEC; + constant PF_INET = nqp::const::SOCKET_FAMILY_INET; + constant PF_INET6 = nqp::const::SOCKET_FAMILY_INET6; + constant PF_LOCAL = nqp::const::SOCKET_FAMILY_UNIX; + constant PF_UNIX = nqp::const::SOCKET_FAMILY_UNIX; + constant PF_MAX = nqp::const::SOCKET_FAMILY_UNIX + 1; constant SOCK_PACKET = 0; constant SOCK_STREAM = 1; constant SOCK_DGRAM = 2; From 39b04dc9f2e36cc450411511e09c2bbe8186975f Mon Sep 17 00:00:00 2001 From: Ben Davies Date: Tue, 25 Jun 2019 20:46:40 -0300 Subject: [PATCH 023/160] Use the correct socket family enum values in IO's ProtocolFamily --- src/core/IO.pm6 | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/src/core/IO.pm6 b/src/core/IO.pm6 index 46eb0cfe7d7..c5113a9daf5 100644 --- a/src/core/IO.pm6 +++ b/src/core/IO.pm6 @@ -9,11 +9,11 @@ enum SeekType ( :SeekFromEnd(2), ); enum ProtocolFamily ( - :PF_LOCAL(0), - :PF_UNIX(1), - :PF_INET(2), - :PF_INET6(3), - :PF_MAX(4), + :PF_INET(nqp::p6box_i(nqp::const::SOCKET_FAMILY_INET)), + :PF_INET6(nqp::p6box_i(nqp::const::SOCKET_FAMILY_INET6)), + :PF_LOCAL(nqp::p6box_i(nqp::const::SOCKET_FAMILY_UNIX)), + :PF_UNIX(nqp::p6box_i(nqp::const::SOCKET_FAMILY_UNIX)), + :PF_MAX(nqp::p6box_i(nqp::const::SOCKET_FAMILY_UNIX + 1)), ); enum SocketType ( :SOCK_PACKET(0), From ea7957101d4cf72723ceff9a928c8a0435a5c52e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Pawe=C5=82=20Murias?= Date: Thu, 27 Jun 2019 14:43:17 +0200 Subject: [PATCH 024/160] [js] Fix the js build after recent build system changes --- tools/build/gen-js-makefile.nqp | 21 ++++++++++++++++----- tools/templates/6.d/js_core_sources | 3 --- tools/templates/NQP_REVISION | 2 +- tools/templates/core_sources | 14 ++++++++++++-- 4 files changed, 29 insertions(+), 11 deletions(-) delete mode 100644 tools/templates/6.d/js_core_sources diff --git a/tools/build/gen-js-makefile.nqp b/tools/build/gen-js-makefile.nqp index f2c28cf337b..4082dcaa95a 100644 --- a/tools/build/gen-js-makefile.nqp +++ b/tools/build/gen-js-makefile.nqp @@ -34,6 +34,15 @@ sub rule($target, $source, *@actions) { $target; } +say("JS_CORE_SOURCES = @insert_filelist(core_sources)@ +@for_specs( +JS_CORE_@ucspec@_SOURCES = \\ + @insert_filelist(rev_core_sources)@ +)@"); +say(" +JS_BUILD_DIR = @nfp(js/moar)@ +"); + constant('JS_BLIB', '@js_blib@'); constant('JS_BUILD_DIR', '@js_build_dir@'); constant('JS_NQP', '@js_nqp@'); @@ -120,17 +129,19 @@ rule($Metamodel-combined, '$(COMMON_BOOTSTRAP_SOURCES)', my $Bootstrap-combined := combine(:sources('$(BOOTSTRAP_SOURCES)'), :file); my $CORE-combined := $build_dir ~ "/CORE.setting"; -rule($CORE-combined, '@js_core_sources@', +rule($CORE-combined, '$(JS_CORE_SOURCES)', '@echo "The following step can take a very long time, please be patient."', - "\$(JS_NQP) \@script(gen-cat.nqp)@ js -f \@ctx_template(core_sources)@ > {nfp($CORE-combined)}" - + '$(CONFIGURE) --expand @shquot(@template(core_sources)@)@ \\', + '--out @nfpq($(JS_BUILD_DIR)/core_sources)@ \\', + '--set-var=backend=@backend@', + "\$(JS_NQP) \@script(gen-cat.nqp)\@ js -f \@nfpq(\$(JS_BUILD_DIR)/core_sources)\@ > {nfp($CORE-combined)}" ); say('@for_specs('); my $CORE-spec-combined := $build_dir ~ "/CORE.@lcspec@.setting"; -rule($CORE-spec-combined, '@ctx_template(js_core_sources)@', +rule($CORE-spec-combined, '$(JS_CORE_@ucspec@_SOURCES)', '@echo "The following step can take a very long time, please be patient."', - "\$(JS_NQP) \@script(gen-cat.nqp)@ js -f \@ctx_template(js_core_sources)@ > {nfp($CORE-spec-combined)}" + "\$(JS_NQP) \@script(gen-cat.nqp)@ js \$(JS_CORE_\@ucspec\@_SOURCES) > {nfp($CORE-spec-combined)}" ); say("\n)@"); diff --git a/tools/templates/6.d/js_core_sources b/tools/templates/6.d/js_core_sources deleted file mode 100644 index 76d82671fc9..00000000000 --- a/tools/templates/6.d/js_core_sources +++ /dev/null @@ -1,3 +0,0 @@ -src/core.d/core_prologue.pm6 -src/core.d/await.pm6 -src/core.d/operators.pm6 diff --git a/tools/templates/NQP_REVISION b/tools/templates/NQP_REVISION index 5600bc7a1d4..a466aff2bcf 100644 --- a/tools/templates/NQP_REVISION +++ b/tools/templates/NQP_REVISION @@ -1 +1 @@ -2019.03-253-g5190ce935 +2019.03-258-g0784193e2 diff --git a/tools/templates/core_sources b/tools/templates/core_sources index 7c5c29ab8b6..c4697d9a701 100644 --- a/tools/templates/core_sources +++ b/tools/templates/core_sources @@ -42,7 +42,7 @@ src/core/Bool.pm6 src/core/Order.pm6 src/core/Num.pm6 src/core/Buf.pm6 -@if(backend==moar +@if(backend!=jvm src/core/Uni.pm6 src/core/Collation.pm6)@ src/core/Encoding/Decoder.pm6 @@ -165,7 +165,10 @@ src/core/Awaitable.pm6 src/core/Awaiter.pm6 src/core/Scheduler.pm6 src/core/Env.pm6 -src/core/ThreadPoolScheduler.pm6 +@if(backend!=js +src/core/ThreadPoolScheduler.pm6)@ +@if(backend==js +src/core/JavaScriptScheduler.pm6)@ src/core/CurrentThreadScheduler.pm6 src/core/Promise.pm6 src/core/Channel.pm6 @@ -175,6 +178,8 @@ src/core/IO/Socket.pm6 src/core/IO/Socket/INET.pm6 src/core/IO/Socket/Async.pm6 src/core/Proc.pm6 +@if(backend==js +src/vm/js/FakeRun.pm6)@ src/core/signals.pm6 src/core/Proc/Async.pm6 src/core/Systemic.pm6 @@ -209,10 +214,15 @@ src/core/CompUnit/Repository/Unknown.pm6 @if(backend==jvm src/vm/jvm/CompUnit/Repository/Java.pm6 src/vm/jvm/CompUnit/Repository/JavaRuntime.pm6)@ +@if(backend==js +src/vm/js/CompUnit/Repository/FileSystemWithRecording.pm6 +src/vm/js/CompUnit/Repository/NodeJs.pm6)@ src/core/Argfiles.pm6 src/core/Process.pm6 src/core/Slang.pm6 src/core/Metamodel/Primitives.pm6 src/core/REPL.pm6 +@if(backend==js +src/core/WrappedJSObject.pm6)@ src/core/Rakudo/Metaops.pm6 src/core/core_epilogue.pm6 From a362fac5bbba2c3b0de0fe78a2c70bdbc2be3f37 Mon Sep 17 00:00:00 2001 From: Coke Date: Thu, 27 Jun 2019 10:08:29 -0400 Subject: [PATCH 025/160] Clean up diagnostic output For #1860 --- lib/Test.pm6 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/lib/Test.pm6 b/lib/Test.pm6 index f80249ca2ee..070fb06ff40 100644 --- a/lib/Test.pm6 +++ b/lib/Test.pm6 @@ -754,12 +754,12 @@ sub done-testing() is export { } # Wrong quantity of tests - _diag("Looks like you planned $num_of_tests_planned test" + _diag("You planned $num_of_tests_planned test" ~ ($num_of_tests_planned == 1 ?? '' !! 's') ~ ", but ran $num_of_tests_run" ) if ($num_of_tests_planned or $num_of_tests_run) && ($num_of_tests_planned != $num_of_tests_run); - _diag("Looks like you failed $num_of_tests_failed test" + _diag("You failed $num_of_tests_failed test" ~ ($num_of_tests_failed == 1 ?? '' !! 's') ~ " of $num_of_tests_run" ) if $num_of_tests_failed && ! $subtest_todo_reason; From 2dc68c9224aa80918d07f3d7e36ca92df979e5e5 Mon Sep 17 00:00:00 2001 From: Elizabeth Mattijsen Date: Thu, 27 Jun 2019 18:43:34 +0200 Subject: [PATCH 026/160] Bump NQP to get profiler fixes --- tools/templates/NQP_REVISION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tools/templates/NQP_REVISION b/tools/templates/NQP_REVISION index a466aff2bcf..d35981a43ac 100644 --- a/tools/templates/NQP_REVISION +++ b/tools/templates/NQP_REVISION @@ -1 +1 @@ -2019.03-258-g0784193e2 +2019.03-259-g4300d4213 From c227693a660200cd2bda42dd28a3946a7d812b01 Mon Sep 17 00:00:00 2001 From: Elizabeth Mattijsen Date: Sat, 29 Jun 2019 18:06:17 +0200 Subject: [PATCH 027/160] Probably temporary fix for R#3000 Somehow the empty outer () or [] is being included when it shouldn't. Instead of assuming some internal problem, just assume we're done. --- src/Perl6/Actions.nqp | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/src/Perl6/Actions.nqp b/src/Perl6/Actions.nqp index 7be5a6c2c3d..de0a2197226 100644 --- a/src/Perl6/Actions.nqp +++ b/src/Perl6/Actions.nqp @@ -6631,8 +6631,8 @@ class Perl6::Actions is HLL::Actions does STDActions { } my $semi := 0; repeat until $semi >= $numsemis { - my $EXPR := $[$semi] // - nqp::die("internal problem: parser did not give circumfix an EXPR"); + my $EXPR := $[$semi] // last; +# nqp::die("internal problem: parser did not give circumfix an () EXPR"); if $EXPR { # might start with a colonpair my @fan := nqp::list($EXPR.ast); migrate_colonpairs($/, @fan); @@ -6880,8 +6880,8 @@ class Perl6::Actions is HLL::Actions does STDActions { } my $semi := 0; repeat until $semi >= $numsemis { - my $EXPR := $[$semi] // - nqp::die("internal problem: parser did not give circumfix an EXPR"); + my $EXPR := $[$semi] // last; +# nqp::die("internal problem: parser did not give circumfix an [] EXPR"); if $EXPR { # might start with a colonpair my @fan := nqp::list($EXPR.ast); migrate_colonpairs($/, @fan); From a26e95bab41e7b787c8283f7ae24ae3859727cfe Mon Sep 17 00:00:00 2001 From: Elizabeth Mattijsen Date: Sat, 29 Jun 2019 23:37:57 +0200 Subject: [PATCH 028/160] A more complete solution to #3000 - pre-check EXPRessions, filter out the undefined ones - refactor circumfix() and circumfix[] code into single sub - remove dead code --- src/Perl6/Actions.nqp | 96 +++++++++++++++---------------------------- 1 file changed, 32 insertions(+), 64 deletions(-) diff --git a/src/Perl6/Actions.nqp b/src/Perl6/Actions.nqp index de0a2197226..5f1f230b705 100644 --- a/src/Perl6/Actions.nqp +++ b/src/Perl6/Actions.nqp @@ -6613,10 +6613,7 @@ class Perl6::Actions is HLL::Actions does STDActions { method term:sym($/) { make $.ast; } - method circumfix:sym<( )>($/) { - my $Pair := $*W.find_symbol(['Pair']); - my $past := $.ast; - + sub handle-list-semis($/, $past) { if !+$past.list { $past := QAST::Stmts.new( :node($/) ); $past.push(QAST::Op.new( :op('call'), :name('&infix:<,>'), :node($/))); @@ -6624,15 +6621,27 @@ class Perl6::Actions is HLL::Actions does STDActions { # Look for any chained adverb pairs and relocate them. # Try to reuse existing QAST where possible. elsif $*FAKE_INFIX_FOUND { - my $numsemis := +$; + my @EXPR; + my $semis := $; + my $numsemis := +$semis; + + my $i := -1; + while ++$i < $numsemis { + my $EXPR := $semis[$i]; + if nqp::defined($EXPR) { + @EXPR.push($EXPR); + } + } + $numsemis := +@EXPR; + if $numsemis > 1 { $past := QAST::Stmts.new( :node($/) ); $past.push(QAST::Op.new( :op('call'), :name('&infix:<,>'), :node($/))); } - my $semi := 0; - repeat until $semi >= $numsemis { - my $EXPR := $[$semi] // last; -# nqp::die("internal problem: parser did not give circumfix an () EXPR"); + + my $semi := -1; + while ++$semi < $numsemis { + my $EXPR := @EXPR[$semi]; if $EXPR { # might start with a colonpair my @fan := nqp::list($EXPR.ast); migrate_colonpairs($/, @fan); @@ -6657,11 +6666,23 @@ class Perl6::Actions is HLL::Actions does STDActions { $past[0].push($EXPR.ast); } } - $semi++; } $past := wanted($past, 'circumfix()/pair'); } - make $past; + $past + } + + method circumfix:sym<( )>($/) { + make handle-list-semis($/, $.ast) + } + + method circumfix:sym<[ ]>($/) { + make QAST::Op.new( + :op('call'), + :name('&circumfix:<[ ]>'), + handle-list-semis($/, $.ast), + :node($/) + ) } method circumfix:sym($/) { @@ -6861,59 +6882,6 @@ class Perl6::Actions is HLL::Actions does STDActions { } } - method circumfix:sym<[ ]>($/) { - - my $Pair := $*W.find_symbol(['Pair']); - my $past := $.ast; - - if !+$past.list { - $past := QAST::Stmts.new( :node($/) ); - $past.push(QAST::Op.new( :op('call'), :name('&infix:<,>'), :node($/))); - } - # Look for any chained adverb pairs and relocate them. - # Try to reuse existing QAST where possible. - elsif $*FAKE_INFIX_FOUND { - my $numsemis := +$; - if $numsemis > 1 { - $past := QAST::Stmts.new( :node($/) ); - $past.push(QAST::Op.new( :op('call'), :name('&infix:<,>'), :node($/))); - } - my $semi := 0; - repeat until $semi >= $numsemis { - my $EXPR := $[$semi] // last; -# nqp::die("internal problem: parser did not give circumfix an [] EXPR"); - if $EXPR { # might start with a colonpair - my @fan := nqp::list($EXPR.ast); - migrate_colonpairs($/, @fan); - if (+@fan > 1) { - my $comma := QAST::Op.new( :op('call'), :name('&infix:<,>'), :node($/)); - for @fan { $comma.push($_) } - if ($numsemis == 1) { - $past := QAST::Stmts.new( :node($/) ); - $past.push($comma); - } - else { - $past[0].push($comma); - } - } - elsif ($numsemis > 1) { - $past[0].push($EXPR.ast); - } - } - else { - migrate_colonpairs($/, $EXPR.ast.list); - if ($numsemis > 1) { - $past[0].push($EXPR.ast); - } - } - $semi++; - } - $past := wanted($past, 'circumfix[]/pair'); - } - - make QAST::Op.new( :op('call'), :name('&circumfix:<[ ]>'), $past, :node($/) ); - } - ## Expressions my %specials := nqp::hash( '==>', -> $/, $sym { make_feed($/) }, From d4ceb97e06cd01babdd34356140b5a26b317fa88 Mon Sep 17 00:00:00 2001 From: Elizabeth Mattijsen Date: Mon, 1 Jul 2019 21:15:05 +0200 Subject: [PATCH 029/160] Add/Remove space, fix comma - pretty JSON had lost its space after the colon, now it has one again - unpretty JSON still had a space, now gone - unpretty JSON should just have a ",", not a ",\n" Follows JSON::Fast fixes for version 0.9.16 --- src/core/Rakudo/Internals/JSON.pm6 | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/core/Rakudo/Internals/JSON.pm6 b/src/core/Rakudo/Internals/JSON.pm6 index 5ca654901fc..e32d3c3ffca 100644 --- a/src/core/Rakudo/Internals/JSON.pm6 +++ b/src/core/Rakudo/Internals/JSON.pm6 @@ -169,7 +169,7 @@ my class Rakudo::Internals::JSON { for pairs { jsonify(.key); - nqp::push_s($out,":"); + nqp::push_s($out,": "); jsonify(.value); nqp::push_s($out,$comma); } @@ -200,9 +200,9 @@ my class Rakudo::Internals::JSON { my int $before = nqp::elems($out); for pairs { jsonify(.key); - nqp::push_s($out,": "); + nqp::push_s($out,":"); jsonify(.value); - nqp::push_s($out,$comma); + nqp::push_s($out,","); } nqp::pop_s($out) if nqp::elems($out) > $before; # lose last comma nqp::push_s($out,'}'); From 290cd7924905c89d9cc5ae073c3caff2e75ae83c Mon Sep 17 00:00:00 2001 From: Daniel Green Date: Thu, 4 Jul 2019 16:56:37 +0100 Subject: [PATCH 030/160] Bump NQP for default-int --- tools/templates/NQP_REVISION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tools/templates/NQP_REVISION b/tools/templates/NQP_REVISION index d35981a43ac..7fe6419a3b0 100644 --- a/tools/templates/NQP_REVISION +++ b/tools/templates/NQP_REVISION @@ -1 +1 @@ -2019.03-259-g4300d4213 +2019.03-273-gebe9672a7 From 5876d38aa76110d8a811bf1a7bc46e078224db7a Mon Sep 17 00:00:00 2001 From: Daniel Green Date: Tue, 14 Aug 2018 21:01:24 -0400 Subject: [PATCH 031/160] Use num ops in NQP code --- src/Perl6/World.nqp | 36 ++++++++++++++++++------------------ 1 file changed, 18 insertions(+), 18 deletions(-) diff --git a/src/Perl6/World.nqp b/src/Perl6/World.nqp index f8652def6df..3e9c2911f49 100644 --- a/src/Perl6/World.nqp +++ b/src/Perl6/World.nqp @@ -97,37 +97,37 @@ sub levenshtein($a, $b) { my $achar := nqp::substr($a, $apos, 1); my $bchar := nqp::substr($b, $bpos, 1); - my $cost := changecost($achar, $bchar); + my num $cost := changecost($achar, $bchar); # hyphens and underscores cost half when adding/deleting. - my $addcost := 1; + my num $addcost := 1; $addcost := 0.5 if $bchar eq "-" || $bchar eq "_"; - my $delcost := 1; + my num $delcost := 1; $delcost := 0.5 if $achar eq "-" || $achar eq "_"; - my $ca := levenshtein_impl($apos+1, $bpos, $estimate+$delcost) + $delcost; # what if we remove the current letter from A? - my $cb := levenshtein_impl($apos, $bpos+1, $estimate+$addcost) + $addcost; # what if we add the current letter from B? - my $cc := levenshtein_impl($apos+1, $bpos+1, $estimate+$cost) + $cost; # what if we change/keep the current letter? + my num $ca := nqp::add_n(levenshtein_impl($apos+1, $bpos, nqp::add_n($estimate, $delcost)), $delcost); # what if we remove the current letter from A? + my num $cb := nqp::add_n(levenshtein_impl($apos, $bpos+1, nqp::add_n($estimate, $addcost)), $addcost); # what if we add the current letter from B? + my num $cc := nqp::add_n(levenshtein_impl($apos+1, $bpos+1, nqp::add_n($estimate, $cost)), $cost); # what if we change/keep the current letter? # the result is the shortest of the three sub-tasks - my $distance; - $distance := $ca if $ca <= $cb && $ca <= $cc; - $distance := $cb if $cb <= $ca && $cb <= $cc; - $distance := $cc if $cc <= $ca && $cc <= $cb; + my num $distance; + $distance := $ca if nqp::isle_n($ca, $cb) && nqp::isle_n($ca, $cc); + $distance := $cb if nqp::isle_n($cb, $ca) && nqp::isle_n($cb, $cc); + $distance := $cc if nqp::isle_n($cc, $ca) && nqp::isle_n($cc, $cb); # switching two letters costs only 1 instead of 2. if $apos + 1 <= $alen && $bpos + 1 <= $blen && nqp::eqat($a, $bchar, $apos + 1) && nqp::eqat($b, $achar, $bpos + 1) { - my $cd := levenshtein_impl($apos+2, $bpos+2, $estimate+1) + 1; - $distance := $cd if $cd < $distance; + my num $cd := nqp::add_n(levenshtein_impl($apos+2, $bpos+2, nqp::add_n($estimate, 1)), 1); + $distance := $cd if nqp::islt_n($cd, $distance); } %memo{$key} := $distance; return $distance; } - my $result := levenshtein_impl(0, 0, 0); + my num $result := levenshtein_impl(0, 0, 0); return $result; } @@ -142,13 +142,13 @@ sub make_levenshtein_evaluator($orig_name, @candidates) { my $parlen := nqp::chars($orig_name); my $lendiff := nqp::chars($name) - $parlen; $lendiff := -$lendiff if $lendiff < 0; - return 1 if $lendiff >= $parlen * 0.3; + return 1 if nqp::isge_n($lendiff, nqp::mul_n($parlen, 0.3)); - my $dist := levenshtein($orig_name, $name) / $parlen; + my num $dist := nqp::div_n(levenshtein($orig_name, $name), $parlen); my $target := -1; - $target := @candidates[0] if $dist <= 0.1; - $target := @candidates[1] if 0.1 < $dist && $dist <= 0.2; - $target := @candidates[2] if 0.2 < $dist && $dist <= 0.35; + $target := @candidates[0] if nqp::isle_n($dist, 0.1); + $target := @candidates[1] if nqp::islt_n(0.1, $dist) && nqp::isle_n($dist, 0.2); + $target := @candidates[2] if nqp::islt_n(0.2, $dist) && nqp::isle_n($dist, 0.35); if $target != -1 { my $name-str := nqp::box_s($name, $Str-obj); nqp::push($target, $name-str); From 62e2555ee7c86f399c220ec0707367dc0842a73a Mon Sep 17 00:00:00 2001 From: Daniel Green Date: Fri, 24 Aug 2018 21:48:20 -0400 Subject: [PATCH 032/160] Fix for bare_complex_number --- src/Perl6/Actions.nqp | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/Perl6/Actions.nqp b/src/Perl6/Actions.nqp index 5f1f230b705..dcb46e85f10 100644 --- a/src/Perl6/Actions.nqp +++ b/src/Perl6/Actions.nqp @@ -8284,12 +8284,12 @@ class Perl6::Actions is HLL::Actions does STDActions { my $ast := $*W.add_constant: 'Complex', 'type_new', :nocache(1), $*W.add_constant('Num', 'num', $ eq '-' || $ eq '−' - ?? -$.ast.compile_time_value.Num + ?? nqp::neg_n($.ast.compile_time_value).Num !! $.ast.compile_time_value.Num ).compile_time_value, $*W.add_constant('Num', 'num', $ eq '-' || $ eq '−' - ?? -$.ast.compile_time_value.Num + ?? nqp::neg_n($.ast.compile_time_value).Num !! $.ast.compile_time_value.Num ).compile_time_value; $ast.node($/); From 1e4d3ac468f455282e3d4029d864614293511e1c Mon Sep 17 00:00:00 2001 From: Daniel Green Date: Thu, 4 Jul 2019 16:29:44 +0100 Subject: [PATCH 033/160] More fixes for default-int behavior --- src/Perl6/Actions.nqp | 12 ++++++------ src/Perl6/Optimizer.nqp | 4 ++-- src/core/Exception.pm6 | 2 +- 3 files changed, 9 insertions(+), 9 deletions(-) diff --git a/src/Perl6/Actions.nqp b/src/Perl6/Actions.nqp index dcb46e85f10..d69d52d5fd3 100644 --- a/src/Perl6/Actions.nqp +++ b/src/Perl6/Actions.nqp @@ -8149,7 +8149,7 @@ class Perl6::Actions is HLL::Actions does STDActions { make $*W.add_numeric_constant($/, 'Num', nqp::inf); } else { - make $*W.add_numeric_constant($/, 'Num', +$/); + make $*W.add_numeric_constant($/, 'Num', nqp::numify($/)); } } @@ -8161,7 +8161,7 @@ class Perl6::Actions is HLL::Actions does STDActions { method dec_number($/) { if $ { # wants a Num - make $*W.add_numeric_constant: $/, 'Num', ~$/; + make $*W.add_numeric_constant: $/, 'Num', nqp::numify($/); } else { # wants a Rat my $Int := $*W.find_symbol(['Int']); my $parti; @@ -8284,12 +8284,12 @@ class Perl6::Actions is HLL::Actions does STDActions { my $ast := $*W.add_constant: 'Complex', 'type_new', :nocache(1), $*W.add_constant('Num', 'num', $ eq '-' || $ eq '−' - ?? nqp::neg_n($.ast.compile_time_value).Num + ?? nqp::neg_n($.ast.compile_time_value) !! $.ast.compile_time_value.Num ).compile_time_value, $*W.add_constant('Num', 'num', $ eq '-' || $ eq '−' - ?? nqp::neg_n($.ast.compile_time_value).Num + ?? nqp::neg_n($.ast.compile_time_value) !! $.ast.compile_time_value.Num ).compile_time_value; $ast.node($/); @@ -11132,7 +11132,7 @@ class Perl6::P5RegexActions is QRegex::P5Regex::Actions does STDActions { QAST::IVal.new( :value(%*RX ?? 1 !! 0) ), QAST::IVal.new( :value(monkey_see_no_eval($/)) ), QAST::IVal.new( :value($*SEQ ?? 1 !! 0) ), - QAST::IVal.new( :value($*INTERPOLATION) ), + QAST::IVal.new( :value($*INTERPOLATION ?? 1 !! 0) ), QAST::Op.new( :op, :name, QAST::WVal.new( :value($*W.find_symbol(['PseudoStash']))), ), @@ -11148,7 +11148,7 @@ class Perl6::P5RegexActions is QRegex::P5Regex::Actions does STDActions { QAST::IVal.new( :value(%*RX ?? 1 !! 0) ), QAST::IVal.new( :value(monkey_see_no_eval($/)) ), QAST::IVal.new( :value($*SEQ ?? 1 !! 0) ), - QAST::IVal.new( :value($*INTERPOLATION) ), + QAST::IVal.new( :value($*INTERPOLATION ?? 1 !! 0) ), QAST::Op.new( :op, :name, QAST::WVal.new( :value($*W.find_symbol(['PseudoStash']))), ), diff --git a/src/Perl6/Optimizer.nqp b/src/Perl6/Optimizer.nqp index 6f40355d5b0..8dcd45daf99 100644 --- a/src/Perl6/Optimizer.nqp +++ b/src/Perl6/Optimizer.nqp @@ -2127,7 +2127,7 @@ class Perl6::Optimizer { } } elsif $primspec == 2 { # native num - my $one := QAST::NVal.new: :value(1); + my $one := QAST::NVal.new: :value(1.0); if $!void_context || nqp::eqat($op.name, '&pre', 0) { # we can just use (or ignore) the result return QAST::Op.new: :op, :$node, :$returns, $var, @@ -3142,7 +3142,7 @@ class Perl6::Optimizer { # Looks through positional args for any lexicalref or attributeref, and # if we find them check if the expectation is for an non-rw argument. method simplify_refs($call, $sig) { - if $sig.arity == $sig.count { + if nqp::iseq_n($sig.arity, $sig.count) { my @args := $call.list; my int $i := $call.name eq '' ?? 1 !! 0; my int $n := nqp::elems(@args); diff --git a/src/core/Exception.pm6 b/src/core/Exception.pm6 index 0d2ab03212b..9c96594a04b 100644 --- a/src/core/Exception.pm6 +++ b/src/core/Exception.pm6 @@ -2089,7 +2089,7 @@ my class X::Str::Trans::InvalidArg is Exception { my class X::Str::Sprintf::Directives::Count is Exception { has int $.args-used; - has num $.args-have; + has int $.args-have; method message() { "Your printf-style directives specify " ~ ($.args-used == 1 ?? "1 argument, but " From cf6f6d926f271c377f35666f1fbbd06ae797753a Mon Sep 17 00:00:00 2001 From: Daniel Green Date: Fri, 5 Jul 2019 11:29:15 +0100 Subject: [PATCH 034/160] Default-int fixes for zef and Inline::Perl5 --- lib/NativeCall.pm6 | 2 +- src/Perl6/Actions.nqp | 10 +++++----- src/Perl6/World.nqp | 2 +- 3 files changed, 7 insertions(+), 7 deletions(-) diff --git a/lib/NativeCall.pm6 b/lib/NativeCall.pm6 index 337609463de..bb553f75d0d 100644 --- a/lib/NativeCall.pm6 +++ b/lib/NativeCall.pm6 @@ -389,7 +389,7 @@ our role Native[Routine $r, $libname where Str|Callable|List|IO::Path|Distributi QAST::Var.new(:scope, :name($lowered_name)), $_.type ~~ Str ?? Str !! $_.type ~~ Int ?? QAST::IVal.new(:value(0)) - !! $_.type ~~ Num ?? QAST::NVal.new(:value(0)) + !! $_.type ~~ Num ?? QAST::NVal.new(:value(0e0)) !! QAST::IVal.new(:value(0)) ), ); diff --git a/src/Perl6/Actions.nqp b/src/Perl6/Actions.nqp index d69d52d5fd3..ae0b50b4984 100644 --- a/src/Perl6/Actions.nqp +++ b/src/Perl6/Actions.nqp @@ -10914,7 +10914,7 @@ class Perl6::RegexActions is QRegex::P6Regex::Actions does STDActions { QAST::SVal.new( :value('INTERPOLATE') ), $varast, QAST::IVal.new( :value(%*RX && %*RX ?? 3 !! %*RX ?? 2 !! %*RX ?? 1 !! 0) ), - QAST::IVal.new( :value(monkey_see_no_eval($/)) ), + QAST::IVal.new( :value(monkey_see_no_eval($/) ?? 1 !! 0) ), QAST::IVal.new( :value($*SEQ ?? 1 !! 0) ), QAST::IVal.new( :value(0) ), QAST::Op.new( :op, :name, @@ -10930,7 +10930,7 @@ class Perl6::RegexActions is QRegex::P6Regex::Actions does STDActions { QAST::SVal.new( :value('INTERPOLATE_ASSERTION') ), $.ast, QAST::IVal.new( :value(%*RX && %*RX ?? 3 !! %*RX ?? 2 !! %*RX ?? 1 !! 0) ), - QAST::IVal.new( :value(monkey_see_no_eval($/)) ), + QAST::IVal.new( :value(monkey_see_no_eval($/) ?? 1 !! 0) ), QAST::IVal.new( :value($*SEQ ?? 1 !! 0) ), QAST::IVal.new( :value(1) ), QAST::Op.new( :op, :name, @@ -10968,7 +10968,7 @@ class Perl6::RegexActions is QRegex::P6Regex::Actions does STDActions { QAST::SVal.new( :value('INTERPOLATE_ASSERTION') ), wanted($.ast, 'assertvar2'), QAST::IVal.new( :value(%*RX && %*RX ?? 3 !! %*RX ?? 2 !! %*RX ?? 1 !! 0) ), - QAST::IVal.new( :value(monkey_see_no_eval($/)) ), + QAST::IVal.new( :value(monkey_see_no_eval($/) ?? 1 !! 0) ), QAST::IVal.new( :value($*SEQ ?? 1 !! 0) ), QAST::IVal.new( :value(1) ), QAST::Op.new( :op, :name, @@ -11130,7 +11130,7 @@ class Perl6::P5RegexActions is QRegex::P5Regex::Actions does STDActions { QAST::SVal.new( :value($*INTERPOLATION ?? 'INTERPOLATE_ASSERTION' !! 'INTERPOLATE') ), $.ast, QAST::IVal.new( :value(%*RX ?? 1 !! 0) ), - QAST::IVal.new( :value(monkey_see_no_eval($/)) ), + QAST::IVal.new( :value(monkey_see_no_eval($/) ?? 1 !! 0) ), QAST::IVal.new( :value($*SEQ ?? 1 !! 0) ), QAST::IVal.new( :value($*INTERPOLATION ?? 1 !! 0) ), QAST::Op.new( :op, :name, @@ -11146,7 +11146,7 @@ class Perl6::P5RegexActions is QRegex::P5Regex::Actions does STDActions { QAST::SVal.new( :value($*INTERPOLATION ?? 'INTERPOLATE_ASSERTION' !! 'INTERPOLATE') ), wanted($.ast, 'p5var'), QAST::IVal.new( :value(%*RX ?? 1 !! 0) ), - QAST::IVal.new( :value(monkey_see_no_eval($/)) ), + QAST::IVal.new( :value(monkey_see_no_eval($/) ?? 1 !! 0) ), QAST::IVal.new( :value($*SEQ ?? 1 !! 0) ), QAST::IVal.new( :value($*INTERPOLATION ?? 1 !! 0) ), QAST::Op.new( :op, :name, diff --git a/src/Perl6/World.nqp b/src/Perl6/World.nqp index 3e9c2911f49..fe5957a9a1c 100644 --- a/src/Perl6/World.nqp +++ b/src/Perl6/World.nqp @@ -3051,7 +3051,7 @@ class Perl6::World is HLL::World { QAST::SVal.new( :value($r) ) } elsif nqp::isint($r) { - QAST::IVal.new( :value($r) ) + QAST::IVal.new( :value(nqp::isconcrete($r) ?? $r !! 0) ) } else { self.add_object_if_no_sc($r); From f753efe15f0b4b825c311b368429951689b8dccd Mon Sep 17 00:00:00 2001 From: Vadim Belman Date: Sat, 6 Jul 2019 16:57:42 -0400 Subject: [PATCH 035/160] Intermediate state commit So far: - CORE settings are loaded and handled correctly. - PseudoStash'es now iterate symbols in CORES. As a side-effect of working on PseudoStash it is now more feasible to implement various functionality currently fudged in S02-names/pseudo.t. In particular, implemented binding in chained pseudo-packages like DYNAMIC, CALLERS, or OUTERS. --- src/Perl6/Actions.nqp | 106 ++++++++---- src/Perl6/ModuleLoader.nqp | 22 ++- src/Perl6/Optimizer.nqp | 61 ++++--- src/Perl6/World.nqp | 79 ++++++++- src/core.d/core_prologue.pm6 | 4 +- src/core.e/core_prologue.pm6 | 4 +- src/core/ForeignCode.pm6 | 4 +- src/core/PseudoStash.pm6 | 320 +++++++++++++++++++++++++++-------- src/core/core_prologue.pm6 | 4 +- t/02-rakudo/14-revisions.t | 14 +- 10 files changed, 465 insertions(+), 153 deletions(-) diff --git a/src/Perl6/Actions.nqp b/src/Perl6/Actions.nqp index 5f1f230b705..56efc1a3afb 100644 --- a/src/Perl6/Actions.nqp +++ b/src/Perl6/Actions.nqp @@ -1288,9 +1288,7 @@ class Perl6::Actions is HLL::Actions does STDActions { $*W.add_phasers_handling_code($*DECLARAND, $*UNIT); } - # Checks. - $*W.assert_stubs_defined($/); - $*W.sort_protos(); + $*W.prep_comp_unit($/); # Get the block for the unit mainline code. my $unit := $*UNIT; @@ -1456,12 +1454,18 @@ class Perl6::Actions is HLL::Actions does STDActions { } method unitstart($/) { + note("--> SET_BLOCK_OUTER_CTX from unitstart") if nqp::getenvhash; # Use SET_BLOCK_OUTER_CTX (inherited from HLL::Actions) # to set dynamic outer lexical context and namespace details # for the compilation unit. self.SET_BLOCK_OUTER_CTX($*UNIT_OUTER); } + method lang-version($/) { + note("--> SET_BLOCK_OUTER_CTX from lang-version") if nqp::getenvhash; + self.SET_BLOCK_OUTER_CTX($*UNIT_OUTER); + } + method statementlist($/) { my $past := QAST::Stmts.new( :node($/) ); if $ { @@ -6613,7 +6617,10 @@ class Perl6::Actions is HLL::Actions does STDActions { method term:sym($/) { make $.ast; } - sub handle-list-semis($/, $past) { + method circumfix:sym<( )>($/) { + my $Pair := $*W.find_symbol(['Pair']); + my $past := $.ast; + if !+$past.list { $past := QAST::Stmts.new( :node($/) ); $past.push(QAST::Op.new( :op('call'), :name('&infix:<,>'), :node($/))); @@ -6621,27 +6628,15 @@ class Perl6::Actions is HLL::Actions does STDActions { # Look for any chained adverb pairs and relocate them. # Try to reuse existing QAST where possible. elsif $*FAKE_INFIX_FOUND { - my @EXPR; - my $semis := $; - my $numsemis := +$semis; - - my $i := -1; - while ++$i < $numsemis { - my $EXPR := $semis[$i]; - if nqp::defined($EXPR) { - @EXPR.push($EXPR); - } - } - $numsemis := +@EXPR; - + my $numsemis := +$; if $numsemis > 1 { $past := QAST::Stmts.new( :node($/) ); $past.push(QAST::Op.new( :op('call'), :name('&infix:<,>'), :node($/))); } - - my $semi := -1; - while ++$semi < $numsemis { - my $EXPR := @EXPR[$semi]; + my $semi := 0; + repeat until $semi >= $numsemis { + my $EXPR := $[$semi] // + nqp::die("internal problem: parser did not give circumfix an EXPR"); if $EXPR { # might start with a colonpair my @fan := nqp::list($EXPR.ast); migrate_colonpairs($/, @fan); @@ -6666,23 +6661,11 @@ class Perl6::Actions is HLL::Actions does STDActions { $past[0].push($EXPR.ast); } } + $semi++; } $past := wanted($past, 'circumfix()/pair'); } - $past - } - - method circumfix:sym<( )>($/) { - make handle-list-semis($/, $.ast) - } - - method circumfix:sym<[ ]>($/) { - make QAST::Op.new( - :op('call'), - :name('&circumfix:<[ ]>'), - handle-list-semis($/, $.ast), - :node($/) - ) + make $past; } method circumfix:sym($/) { @@ -6882,6 +6865,59 @@ class Perl6::Actions is HLL::Actions does STDActions { } } + method circumfix:sym<[ ]>($/) { + + my $Pair := $*W.find_symbol(['Pair']); + my $past := $.ast; + + if !+$past.list { + $past := QAST::Stmts.new( :node($/) ); + $past.push(QAST::Op.new( :op('call'), :name('&infix:<,>'), :node($/))); + } + # Look for any chained adverb pairs and relocate them. + # Try to reuse existing QAST where possible. + elsif $*FAKE_INFIX_FOUND { + my $numsemis := +$; + if $numsemis > 1 { + $past := QAST::Stmts.new( :node($/) ); + $past.push(QAST::Op.new( :op('call'), :name('&infix:<,>'), :node($/))); + } + my $semi := 0; + repeat until $semi >= $numsemis { + my $EXPR := $[$semi] // + nqp::die("internal problem: parser did not give circumfix an EXPR"); + if $EXPR { # might start with a colonpair + my @fan := nqp::list($EXPR.ast); + migrate_colonpairs($/, @fan); + if (+@fan > 1) { + my $comma := QAST::Op.new( :op('call'), :name('&infix:<,>'), :node($/)); + for @fan { $comma.push($_) } + if ($numsemis == 1) { + $past := QAST::Stmts.new( :node($/) ); + $past.push($comma); + } + else { + $past[0].push($comma); + } + } + elsif ($numsemis > 1) { + $past[0].push($EXPR.ast); + } + } + else { + migrate_colonpairs($/, $EXPR.ast.list); + if ($numsemis > 1) { + $past[0].push($EXPR.ast); + } + } + $semi++; + } + $past := wanted($past, 'circumfix[]/pair'); + } + + make QAST::Op.new( :op('call'), :name('&circumfix:<[ ]>'), $past, :node($/) ); + } + ## Expressions my %specials := nqp::hash( '==>', -> $/, $sym { make_feed($/) }, diff --git a/src/Perl6/ModuleLoader.nqp b/src/Perl6/ModuleLoader.nqp index bd82f602aa5..6362551f29f 100644 --- a/src/Perl6/ModuleLoader.nqp +++ b/src/Perl6/ModuleLoader.nqp @@ -214,8 +214,8 @@ class Perl6::ModuleLoader does Perl6::ModuleLoaderVMConfig { } # Transforms NULL. into CORE. - method transform_setting_name ($setting_name) { - my $m := $setting_name ~~ /NULL '.' ( <[c..z]> )/; + method previous_setting_name ($setting_name, :$base = 'CORE') { + my $m := $setting_name ~~ /$base '.' ( <[c..z]> )/; if $m { my $rev := ~nqp::atpos($m, 0); $setting_name := 'CORE' ~ ($rev le 'd' ?? '' !! '.' ~ nqp::chr(nqp::ord($rev) - 1)); @@ -223,29 +223,47 @@ class Perl6::ModuleLoader does Perl6::ModuleLoaderVMConfig { $setting_name } + method transform_setting_name ($setting_name) { + return self.previous_setting_name($setting_name, base => 'NULL'); + } + method load_setting($setting_name) { my $setting; if $setting_name ne 'NULL' { + DEBUG("Requested for settings $setting_name") if $DEBUG; # XXX TODO: see https://github.com/rakudo/rakudo/issues/2432 $setting_name := self.transform_setting_name($setting_name); + + # First, pre-load previous setting. + my $prev_setting_name := self.previous_setting_name($setting_name); + my $prev_setting; + # Don't do this for .c which is just CORE. + unless nqp::iseq_s($prev_setting_name, $setting_name) { + $prev_setting := self.load_setting($prev_setting_name); + } + # Unless we already did so, locate and load the setting. unless nqp::defined(%settings_loaded{$setting_name}) { DEBUG("Loading settings $setting_name") if $DEBUG; # Find it. my $path := self.find_setting($setting_name); + DEBUG("Found settings $setting_name") if $DEBUG; # Load it. my $*CTXSAVE := self; my $*MAIN_CTX; my $preserve_global := nqp::ifnull(nqp::gethllsym('perl6', 'GLOBAL'), NQPMu); nqp::scwbdisable(); + DEBUG("Loading bytecode from $path") if $DEBUG; nqp::loadbytecode($path); + DEBUG("Loaded bytecode from $path") if $DEBUG; nqp::scwbenable(); nqp::bindhllsym('perl6', 'GLOBAL', $preserve_global); unless nqp::defined($*MAIN_CTX) { nqp::die("Unable to load setting $setting_name; maybe it is missing a YOU_ARE_HERE?"); } + nqp::forceouterctx(nqp::ctxcode($*MAIN_CTX), $prev_setting) if nqp::defined($prev_setting); %settings_loaded{$setting_name} := $*MAIN_CTX; DEBUG("Settings $setting_name loaded") if $DEBUG; } diff --git a/src/Perl6/Optimizer.nqp b/src/Perl6/Optimizer.nqp index 6f40355d5b0..a9c629d5462 100644 --- a/src/Perl6/Optimizer.nqp +++ b/src/Perl6/Optimizer.nqp @@ -20,7 +20,7 @@ my class Symbols { # Some interesting scopes. has $!GLOBALish; has $!UNIT; - has $!SETTING; + # has $!SETTING; # Cached setting lookups. has %!SETTING_CACHE; @@ -260,28 +260,47 @@ my class Symbols { return 0; } + # method find_in_setting($symbol) { + # if !nqp::defined($!SETTING) { + # my int $i := +@!block_stack; + # while $i > 0 && !nqp::defined($!SETTING) { + # $i := $i - 1; + # my $block := @!block_stack[$i]; + # my %sym := $block.symbol("!CORE_MARKER"); + # if +%sym { + # $!SETTING := $block; + # } + # } + # if !nqp::defined($!SETTING) { + # nqp::die("Optimizer couldn't find CORE while looking for $symbol."); + # } + # } else { + # if nqp::existskey(%!SETTING_CACHE, $symbol) { + # return %!SETTING_CACHE{$symbol}; + # } + # } + # my %sym := $!SETTING.symbol($symbol); + # if +%sym { + # return %!SETTING_CACHE{$symbol} := self.force_value(%sym, $symbol, 1); + # } + # nqp::die("Optimizer couldn't find $symbol in SETTING."); + # } + method find_in_setting($symbol) { - if !nqp::defined($!SETTING) { - my int $i := +@!block_stack; - while $i > 0 && !nqp::defined($!SETTING) { - $i := $i - 1; - my $block := @!block_stack[$i]; - my %sym := $block.symbol("!CORE_MARKER"); - if +%sym { - $!SETTING := $block; - } - } - if !nqp::defined($!SETTING) { - nqp::die("Optimizer couldn't find CORE while looking for $symbol."); - } - } else { - if nqp::existskey(%!SETTING_CACHE, $symbol) { - return %!SETTING_CACHE{$symbol}; - } + if nqp::existskey(%!SETTING_CACHE, $symbol) { + return %!SETTING_CACHE{$symbol}; + } + my @settings := $*W.context().SETTINGS(); + unless +@settings { + nqp::die("Optimizer couldn't find CORE while looking for $symbol."); } - my %sym := $!SETTING.symbol($symbol); - if +%sym { - return %!SETTING_CACHE{$symbol} := self.force_value(%sym, $symbol, 1); + my int $i := +@settings; + while $i > 0 { + my $setting := @settings[--$i]; + my %sym := $setting.symbol($symbol); + if +%sym { + return %!SETTING_CACHE{$symbol} := self.force_value(%sym, $symbol, 1); + } } nqp::die("Optimizer couldn't find $symbol in SETTING."); } diff --git a/src/Perl6/World.nqp b/src/Perl6/World.nqp index f8652def6df..83138f20da9 100644 --- a/src/Perl6/World.nqp +++ b/src/Perl6/World.nqp @@ -180,6 +180,9 @@ sub levenshtein_candidate_heuristic(@candidates, $target) { # This builds upon the HLL::World to add the specifics needed by Rakudo Perl 6. class Perl6::World is HLL::World { + + has $!setting_fixup_task; + my class Perl6CompilationContext is HLL::World::CompilationContext { # The stack of lexical pads, actually as QAST::Block objects. The # outermost frame is at the bottom, the latest frame is on top. @@ -190,6 +193,8 @@ class Perl6::World is HLL::World { # The outermost block is at the bottom, the latest block is on top. has @!PADS_AND_THUNKS; + has @!SETTINGS; + # The stack of code objects; phasers get attached to the top one. has @!CODES; @@ -232,6 +237,7 @@ class Perl6::World is HLL::World { method BUILD(:$handle, :$description) { @!PADS := []; + @!SETTINGS := []; @!PADS_AND_THUNKS := []; @!CODES := []; @!stub_check := []; @@ -249,6 +255,10 @@ class Perl6::World is HLL::World { @!PADS } + method SETTINGS() { + @!SETTINGS + } + method create_block($/) { # Create pad, link to outer, annotate with creating statement. my $pad := QAST::Block.new( QAST::Stmts.new( :node($/) ) ); @@ -294,6 +304,11 @@ class Perl6::World is HLL::World { @!PADS_AND_THUNKS.pop(); } + method push_SETTING($s) { + note("+ PUSHING SETTING: ", nqp::what($s).HOW.name(nqp::what($s))) if nqp::getenvhash; + @!SETTINGS[+@!SETTINGS] := $s; + } + # Gets the top block or thunk. method cur_block_or_thunk() { @!PADS_AND_THUNKS[+@!PADS_AND_THUNKS - 1] @@ -561,6 +576,8 @@ class Perl6::World is HLL::World { $*MAIN := 'MAIN'; $*STRICT := 1 if $*begin_compunit; + note("load-lang-ver") if nqp::getenvhash; + my str $version := ~$ver-match; my @vparts := nqp::split('.', $version); my $vWhatever := nqp::isge_i(nqp::index($version, '*'), 0); @@ -657,15 +674,19 @@ class Perl6::World is HLL::World { # our setting. Otherwise, load one. my $have_outer := nqp::defined(%*COMPILING<%?OPTIONS>); if $have_outer { + note("We have outer ctx") if nqp::getenvhash; $setting_name := ''; $*UNIT.annotate('IN_DECL', 'eval'); $in_eval := 1; } else { $setting_name := %*COMPILING<%?OPTIONS> // 'CORE'; - $*COMPILING_CORE_SETTING := 1 if $setting_name eq 'NULL'; - $*SET_DEFAULT_LANG_VER := 0 - if nqp::eqat($setting_name, 'NULL', 0); + note("? SETTING: ", $setting_name) if nqp::getenvhash; + if nqp::eqat($setting_name, 'NULL', 0) { + $*COMPILING_CORE_SETTING := 1; + $*SET_DEFAULT_LANG_VER := 0; + self.context.push_SETTING($*UNIT); + } self.load_setting($/,$setting_name); $*UNIT.annotate('IN_DECL', 'mainline'); } @@ -898,17 +919,29 @@ class Perl6::World is HLL::World { } } + method prep_comp_unit ($/) { + note("!!! Preparing comp unit") if nqp::getenvhash; + self.add_load_dependency_task(:deserialize_ast($!setting_fixup_task), :fixup_ast($!setting_fixup_task)); + # Checks. + self.assert_stubs_defined($/); + self.sort_protos(); + } + # Loads a setting. method load_setting($/, $setting_name) { # Do nothing for the NULL setting. + note("> LOADING SETTING ", $setting_name) if nqp::getenvhash; if $setting_name ne 'NULL' { # XXX TODO: see https://github.com/rakudo/rakudo/issues/2432 $setting_name := Perl6::ModuleLoader.transform_setting_name($setting_name); + note("> TRANSFORMED SETTING NAME: ", $setting_name) if nqp::getenvhash; # Load it immediately, so the compile time info is available. # Once it's loaded, set it as the outer context of the code - # being compiled. - my $setting := %*COMPILING<%?OPTIONS> - := Perl6::ModuleLoader.load_setting($setting_name); + # being compiled unless being loaded as another core dependency. + my $setting := %*COMPILING<%?OPTIONS> := + Perl6::ModuleLoader.load_setting($setting_name); + + note("> LOADED: " ~ nqp::what($setting).HOW.name(nqp::what($setting)), " compunit? ", nqp::iscompunit($setting), ", contains ", nqp::elems($setting), " symbols") if nqp::getenvhash; # Add a fixup and deserialization task also. my $fixup := QAST::Stmt.new( @@ -926,7 +959,24 @@ class Perl6::World is HLL::World { ) ) ); - self.add_load_dependency_task(:deserialize_ast($fixup), :fixup_ast($fixup)); + $!setting_fixup_task := $fixup; + # self.add_load_dependency_task(:deserialize_ast($fixup), :fixup_ast($fixup)); + + # if nqp::getenvhash { + # my $any := nqp::iscompunit($*UNIT_OUTER); + # my $cobj := nqp::ctxcode($setting); + # my %cloc := nqp::getcodelocation($cobj); + # note("> IS COMP UNIT: ", $any, " or ", nqp::iscompunit($setting), " // ", + # " code object: ", $cobj.HOW.name($cobj), " // ", (nqp::defined($cobj) ?? "defined" !! "*undef*"), + # " code file: ", %cloc + # ); + # + # for %cloc { + # my $v := nqp::iterval($_); + # note("> CODE LOCATION: ", nqp::iterkey_s($_), " => ", $v.HOW.name($v)); + # } + # } + self.context().push_SETTING($*UNIT_OUTER); return nqp::ctxlexpad($setting); } @@ -4768,6 +4818,14 @@ class Perl6::World is HLL::World { # Make sure it's not an empty name. unless +@name { nqp::die("Cannot look up empty name"); } + note("Looking for ", nqp::join('::', @name), " in setting only? ", $setting-only) if nqp::getenvhash; + if nqp::getenvhash { + my @c := self.context.SETTINGS; + for @c -> $cctx { + note("CORE has ", nqp::elems($cctx.symtable), " elems"); + } + } + # GLOBAL is current view of global. if +@name == 1 && @name[0] eq 'GLOBAL' { return $*GLOBALish; @@ -4782,9 +4840,13 @@ class Perl6::World is HLL::World { # If it's a single-part name, look through the lexical # scopes and try the current package. + + note(" . Symbols at UNIT_OUTER ", nqp::elems($*UNIT_OUTER.symtable)) if nqp::getenvhash; + if +@name == 1 { my str $final_name := ~@name[0]; if $*WANTEDOUTERBLOCK { + note(" . in WANTEDOUTERBLOCK") if nqp::getenvhash; my $scope := $*WANTEDOUTERBLOCK; while $scope { my %sym := $scope.symbol($final_name); @@ -4799,11 +4861,13 @@ class Perl6::World is HLL::World { } } else { + note(" . not in WANTEDOUTERBLOCK") if nqp::getenvhash; my int $i := $start_scope; while $i > 0 { $i := $i - 1; my %sym := @BLOCKS[$i].symbol($final_name); if +%sym { + note("found $final_name") if nqp::getenvhash; my $value := self.force_value(%sym, $final_name, 1); if $upgrade_to_global { ($*GLOBALish.WHO){$final_name} := $value; @@ -4829,6 +4893,7 @@ class Perl6::World is HLL::World { my int $found := 0; while $i > 0 { $i := $i - 1; + note("Looking in block #$i") if nqp::getenvhash; my %sym := @BLOCKS[$i].symbol($first); if +%sym { $result := self.force_value(%sym, $first, 1); diff --git a/src/core.d/core_prologue.pm6 b/src/core.d/core_prologue.pm6 index 5992068a61f..b924bbb41eb 100644 --- a/src/core.d/core_prologue.pm6 +++ b/src/core.d/core_prologue.pm6 @@ -1,6 +1,6 @@ use nqp; -# This dynamic is purely for testing support. -PROCESS::<$CORE-SETTING-REV> := 'd'; +# This sub is only to support tests. +sub CORE-SETTING-REV { 'd' }; # vim: ft=perl6 expandtab sw=4 diff --git a/src/core.e/core_prologue.pm6 b/src/core.e/core_prologue.pm6 index 76b882e6b44..92375bfad15 100644 --- a/src/core.e/core_prologue.pm6 +++ b/src/core.e/core_prologue.pm6 @@ -1,6 +1,6 @@ use nqp; -# This dynamic is purely for testing support. -PROCESS::<$CORE-SETTING-REV> := 'e'; +# This sub is only to support tests. +sub CORE-SETTING-REV { 'e' } # vim: ft=perl6 expandtab sw=4 diff --git a/src/core/ForeignCode.pm6 b/src/core/ForeignCode.pm6 index 491a6ed3954..73484c1b21c 100644 --- a/src/core/ForeignCode.pm6 +++ b/src/core/ForeignCode.pm6 @@ -55,7 +55,9 @@ proto sub EVAL( my $*CTXSAVE; # make sure we don't use the EVAL's MAIN context for the # currently compiling compilation unit - my $LANG := $context<%?LANG> || CALLERS::<%?LANG>; + my $LANG := $context<%?LANG>:exists + ?? $context<%?LANG> + !! (CALLERS::<%?LANG>:exists ?? CALLERS::<%?LANG> !! Nil); my $*INSIDE-EVAL = 1; my $compiled := $compiler.compile: $code, diff --git a/src/core/PseudoStash.pm6 b/src/core/PseudoStash.pm6 index c744f0887aa..f56a55827a5 100644 --- a/src/core/PseudoStash.pm6 +++ b/src/core/PseudoStash.pm6 @@ -1,9 +1,11 @@ my class X::Bind { ... } my class X::Caller::NotDynamic { ... } +my class X::NoSuchSymbol { ... } my class PseudoStash is Map { has Mu $!ctx; has int $!mode; + has $!package; # Parent package, for which we serve as .WHO # Lookup modes. my int constant PICK_CHAIN_BY_NAME = 0; @@ -25,10 +27,8 @@ my class PseudoStash is Map { my $pseudoers := nqp::hash( 'MY', sub ($cur) { my $stash := nqp::clone($cur); - nqp::bindattr_i($stash, PseudoStash, '$!mode', PRECISE_SCOPE); - nqp::setwho( - Metamodel::ModuleHOW.new_type(:name('MY')), - $stash); + nqp::bindattr_i($stash, PseudoStash, '$!mode', STATIC_CHAIN +| DYNAMIC_CHAIN); + $stash.pseudo-package('MY'); }, 'CORE', sub ($cur) { my Mu $ctx := nqp::getattr(nqp::decont($cur), PseudoStash, '$!ctx'); @@ -42,10 +42,10 @@ my class PseudoStash is Map { (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::setwho( - Metamodel::ModuleHOW.new_type(:name('CORE')), - $stash))) + nqp::bindattr_i($stash, PseudoStash, '$!mode', STATIC_CHAIN), + $stash.pseudo-package('CORE') + ) + ) }, 'CALLER', sub ($cur) { nqp::if( @@ -58,13 +58,13 @@ my class PseudoStash is Map { 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::setwho( - Metamodel::ModuleHOW.new_type(:name('CALLER')), - $stash))) + $stash.pseudo-package('CALLER') + ) + ) }, - 'OUTER', sub ($cur) { + 'OUTER', sub ($cur) is raw { my Mu $ctx := nqp::ctxouterskipthunks( - nqp::getattr(nqp::decont($cur),PseudoStash,'$!ctx')); + nqp::getattr(nqp::decont($cur),PseudoStash,'$!ctx')); if nqp::isnull($ctx) { Nil @@ -74,17 +74,13 @@ my class PseudoStash is Map { nqp::bindattr($stash, Map, '$!storage', nqp::ctxlexpad($ctx)); nqp::bindattr($stash, PseudoStash, '$!ctx', $ctx); nqp::bindattr_i($stash, PseudoStash, '$!mode', PRECISE_SCOPE); - nqp::setwho( - Metamodel::ModuleHOW.new_type(:name('OUTER')), - $stash) + $stash.pseudo-package('OUTER') } }, 'LEXICAL', sub ($cur) { my $stash := nqp::clone($cur); nqp::bindattr_i($stash, PseudoStash, '$!mode', STATIC_CHAIN); - nqp::setwho( - Metamodel::ModuleHOW.new_type(:name('LEXICAL')), - $stash); + $stash.pseudo-package('LEXICAL') }, 'OUTERS', sub ($cur) { my Mu $ctx := nqp::ctxouterskipthunks( @@ -98,17 +94,13 @@ my class PseudoStash is Map { nqp::bindattr($stash, Map, '$!storage', nqp::ctxlexpad($ctx)); nqp::bindattr($stash, PseudoStash, '$!ctx', $ctx); nqp::bindattr_i($stash, PseudoStash, '$!mode', STATIC_CHAIN); - nqp::setwho( - Metamodel::ModuleHOW.new_type(:name('OUTERS')), - $stash) + $stash.pseudo-package('OUTERS') } }, 'DYNAMIC', sub ($cur) { my $stash := nqp::clone($cur); nqp::bindattr_i($stash, PseudoStash, '$!mode', DYNAMIC_CHAIN); - nqp::setwho( - Metamodel::ModuleHOW.new_type(:name('DYNAMIC')), - $stash); + $stash.pseudo-package('DYNAMIC'); }, 'CALLERS', sub ($cur) { nqp::if( @@ -121,9 +113,9 @@ my class PseudoStash is Map { 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::setwho( - Metamodel::ModuleHOW.new_type(:name('CALLERS')), - $stash))) + $stash.pseudo-package('CALLERS') + ) + ) }, 'UNIT', sub ($cur) { my Mu $ctx := nqp::getattr(nqp::decont($cur), PseudoStash, '$!ctx'); @@ -138,9 +130,9 @@ my class PseudoStash is Map { nqp::bindattr($stash, Map, '$!storage',nqp::ctxlexpad($ctx)), nqp::bindattr($stash, PseudoStash, '$!ctx', $ctx), nqp::bindattr_i($stash, PseudoStash, '$!mode', PRECISE_SCOPE), - nqp::setwho( - Metamodel::ModuleHOW.new_type(:name('UNIT')), - $stash))) + $stash.pseudo-package('UNIT') + ) + ) }, 'SETTING', sub ($cur) { # Same as UNIT, but go a little further out (two steps, for @@ -157,9 +149,9 @@ my class PseudoStash is Map { nqp::bindattr($stash, Map, '$!storage', nqp::ctxlexpad($ctx)), nqp::bindattr($stash, PseudoStash, '$!ctx', $ctx), nqp::bindattr_i($stash, PseudoStash, '$!mode', STATIC_CHAIN), - nqp::setwho( - Metamodel::ModuleHOW.new_type(:name('SETTING')), - $stash))) + $stash.pseudo-package('SETTING') + ) + ) }, 'CLIENT', sub ($cur) { my $pkg := nqp::getlexrel( @@ -176,9 +168,7 @@ my class PseudoStash is Map { 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::setwho( - Metamodel::ModuleHOW.new_type(:name('CLIENT')), - $stash); + $stash.pseudo-package('CLIENT'); }, 'OUR', sub ($cur) { nqp::getlexrel( @@ -188,52 +178,83 @@ my class PseudoStash is Map { ); multi method AT-KEY(PseudoStash:D: Str() $key) is raw { + note("AT-KEY($key) on ", $!package.^name) if %*ENV; + my Mu $val := nqp::null(); nqp::if( nqp::existskey($pseudoers,$key), - nqp::atkey($pseudoers,$key)(self), - nqp::if( - nqp::bitand_i($!mode,PRECISE_SCOPE), - nqp::stmts( - (my Mu $res := nqp::if( - nqp::existskey( - nqp::getattr(self,Map,'$!storage'),nqp::unbox_s($key)), - nqp::atkey( - nqp::getattr(self,Map,'$!storage'),nqp::unbox_s($key)), - Nil - )), - nqp::if( - (nqp::not_i(nqp::eqaddr($res,Nil)) - && nqp::bitand_i($!mode,REQUIRE_DYNAMIC)), + ($val := nqp::atkey($pseudoers,$key)(self)), + nqp::stmts( + nqp::if( # PRECISE_SCOPE + nqp::bitand_i($!mode,PRECISE_SCOPE), + nqp::stmts( + nqp::if( + nqp::existskey( + nqp::getattr(self,Map,'$!storage'),nqp::unbox_s($key)), + ($val := nqp::atkey( + nqp::getattr(self,Map,'$!storage'),nqp::unbox_s($key))) + ), nqp::if( - (try nqp::not_i($res.VAR.dynamic)), - X::Caller::NotDynamic.new(symbol => $key).throw + (nqp::not_i(nqp::isnull($val)) + && nqp::bitand_i($!mode,REQUIRE_DYNAMIC)), + nqp::if( + (try nqp::not_i($val.VAR.dynamic)), + ($val := Failure.new(X::Caller::NotDynamic.new(symbol => $key))) + ) ) - ), - $res - ), - nqp::if( - 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::ifnull( - nqp::getlexreldyn( - nqp::getattr(self,PseudoStash,'$!ctx'),nqp::unbox_s($key)), - Nil - ), - nqp::ifnull( # STATIC_CHAIN - nqp::getlexrel( - nqp::getattr(self,PseudoStash,'$!ctx'),nqp::unbox_s($key)), - Nil ) + ), + 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)), # "*" + ($val := nqp::ifnull( + nqp::getlexreldyn( + nqp::getattr(self,PseudoStash,'$!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::null() + )) ) ) - ) + ); + note("AT-KEY RETURNS: ", (nqp::isnull($val) ?? "Failure" !! $val.^name), " // mode: ", $!mode.fmt('%x')) if %*ENV; + nqp::isnull($val) + ?? Failure.new(X::NoSuchSymbol.new(symbol => $!package.^name ~ '::' ~ $key)) + !! $val } + multi method ASSIGN-KEY(PseudoStash:D: Str() $key, Mu \value) is raw { self.AT-KEY($key) = value } - method BIND-KEY(Str() $key, \value) is raw { + # Finds the context in which $key is defined. Throws if not found. + method lookup-ctx(Mu \ctx, Str $key) is raw { + my Mu $ctx := ctx; + my Mu $target := nqp::null(); + nqp::stmts( + nqp::while( + ($ctx && nqp::isnull($target)), + nqp::if( + nqp::existskey($ctx,nqp::unbox_s($key)), + ($target := $ctx), + ($ctx := self.parent-ctx($ctx)), + ) + ), + nqp::ifnull( + $target, + X::NoSuchSymbol.new(symbol => $!package.^name ~ '::' ~ $key).throw + ) + ) + } + + method BIND-KEY(PseudoStash:D: Str() $key, Mu \value) is raw { nqp::if( nqp::existskey($pseudoers,$key), X::Bind.new(target => "pseudo-package $key").throw, @@ -244,9 +265,12 @@ my class PseudoStash is Map { nqp::if( nqp::bitand_i( $!mode,nqp::bitor_i(DYNAMIC_CHAIN,PICK_CHAIN_BY_NAME) - ) && nqp::iseq_i(nqp::ord(nqp::unbox_s($key),1),42), # "*" - (die "Binding to dynamic variables not yet implemented"), - (die "This case of binding is not yet implemented") # STATIC_CHAIN + ) && nqp::iseq_i(nqp::ord(nqp::unbox_s($key),1),42), # "*"; TODO: Must validate by .VAR.dynamic + nqp::stmts( + (my Mu $target-ctx := self.lookup-ctx($!ctx,$key)), + nqp::bindkey($target-ctx,nqp::unbox_s($key),value), + ), + nqp::bindkey(self.lookup-ctx($!ctx,$key),nqp::unbox_s($key),value), # STATIC_CHAIN ) ) ) @@ -280,6 +304,154 @@ my class PseudoStash is Map { ) ) } + + method parent-ctx(PseudoStash:D: Mu \ctx) is raw { + nqp::if( + nqp::bitand_i($!mode,PRECISE_SCOPE), + nqp::null(), + nqp::if( + nqp::bitand_i($!mode,nqp::bitor_i(DYNAMIC_CHAIN,PICK_CHAIN_BY_NAME)), + nqp::ctxcallerskipthunks(ctx), + nqp::ctxouterskipthunks(ctx) # STATIC_CHAIN + ) + ) + } + + # Iterate over context, return symbol => value Pairs. + my role CtxIterator does Iterator { + has PseudoStash $!stash; + has Mu $!ctx; + has $!iter; + has $!seen; + + method !SET-SELF(PseudoStash:D \pseudo) { + $!stash := pseudo; + # When dealing with precise scope all needed symbols are already in $!storage. For chains we'd need the + # context. + # NOTE: Actually, the storage is our context at all times. Isn't it? * vrurg + $!ctx := nqp::if( + nqp::bitand_i(nqp::getattr(pseudo, PseudoStash, '$!mode'),PRECISE_SCOPE), + nqp::getattr(pseudo, Map, '$!storage'), + nqp::getattr(pseudo, PseudoStash, '$!ctx') + ); + $!iter := nqp::iterator(nqp::ctxlexpad($!ctx)); + $!seen := nqp::hash(); + self + } + + method new(PseudoStash:D \pseudo) { nqp::create(self)!SET-SELF(pseudo) } + + # Switch to the next parent context if necessary + method maybe-next-context() { + return unless $!ctx; + nqp::unless( + $!iter, + nqp::if( + nqp::bitand_i(nqp::getattr($!stash, PseudoStash, '$!mode'), PRECISE_SCOPE), + # Reset current context manually for precise scope. Otherwise parent-ctx() would do it for us. + nqp::stmts( + # (note(" -> resetting context for PRECISE_SCOPE") if %*ENV), + ($!ctx := nqp::null()), + ), + nqp::stmts( + # (note(" -> iterating over parents") if %*ENV), + nqp::repeat_while( + ($!ctx && !nqp::elems($!ctx)), # Until context with symbols is found; or no parents left. + ($!ctx := $!stash.parent-ctx($!ctx)), + ), + nqp::if( + $!ctx, + # If we have a parent context then iterate over it. + ($!iter := nqp::iterator(nqp::ctxlexpad($!ctx))), + ) + ) + ) + ) + } + + # Like pull-one but doesn't return actual value. Skips non-dynamics in dynamic chains. + method next-one() is raw { + note("next-one on ", nqp::getattr($!stash,PseudoStash,'$!package').^name) if %*ENV; + my $got-one := 0; + my $sym; + nqp::while( # Repeat until got a candidate or no more contexts to iterate left + ($!ctx && !$got-one), + nqp::stmts( + (note(" -> maybe next context?") if %*ENV), + self.maybe-next-context, + (note(" -> has iter?") if %*ENV), + nqp::if( + $!iter, + nqp::stmts( + (note(" -> shift iter") if %*ENV), + nqp::shift($!iter), + # We have candidate if the chain is not dynamic; or if container under the symbol is + # dynamic. + ($sym := nqp::iterkey_s($!iter)), + (note(" -> $sym is the current symbol") if %*ENV), + ($got-one := !nqp::atkey($!seen,$sym) && ( + !nqp::bitand_i(nqp::getattr($!stash,PseudoStash,'$!mode'),DYNAMIC_CHAIN) || + (try { nqp::iterval($!iter).VAR.dynamic }) + )) + ) + ) + ) + ); + nqp::bindkey($!seen,$sym,1) if $got-one; + $got-one + } + } + + my class CtxIterator::Pairs does CtxIterator { + method pull-one() is raw { + nqp::if( + self.next-one, + Pair.new(nqp::iterkey_s($!iter), nqp::iterval($!iter)), + IterationEnd + ) + } + } + + my class CtxIterator::Keys does CtxIterator { + method pull-one() is raw { + nqp::if( + self.next-one, + nqp::iterkey_s($!iter), + IterationEnd + ) + } + } + + my class CtxIterator::Values does CtxIterator { + method pull-one() is raw { + nqp::if( + self.next-one, + nqp::iterval($!iter), + IterationEnd + ) + } + } + + multi method iterator(PseudoStash:D: --> Iterator:D) { CtxIterator::Pairs.new(self) } + + multi method pairs(PseudoStash:D: --> Seq:D) { + Seq.new(self.iterator) + } + + multi method keys(PseudoStash:D: --> Seq:D) { + Seq.new(CtxIterator::Keys.new(self)) + } + + multi method values(PseudoStash:D: --> Seq:D) { + Seq.new(CtxIterator::Values.new(self)) + } + + method pseudo-package(PseudoStash:D: Str:D $name) is raw { + nqp::setwho( + ($!package := Metamodel::ModuleHOW.new_type(:$name)), + nqp::decont(self) + ) + } } # vim: ft=perl6 expandtab sw=4 diff --git a/src/core/core_prologue.pm6 b/src/core/core_prologue.pm6 index fb1fd856e4f..a5f6084faa1 100644 --- a/src/core/core_prologue.pm6 +++ b/src/core/core_prologue.pm6 @@ -66,7 +66,7 @@ PROCESS::<$SCHEDULER> = JavaScriptScheduler.new(); BEGIN {nqp::p6setassociativetype(Associative);} #?endif -# This dynamic is purely for testing support. -PROCESS::<$CORE-SETTING-REV> := 'c'; +# This sub is only to support tests. +sub CORE-SETTING-REV { 'c' }; # vim: ft=perl6 expandtab sw=4 diff --git a/t/02-rakudo/14-revisions.t b/t/02-rakudo/14-revisions.t index 7ab4819202a..83d11058df0 100644 --- a/t/02-rakudo/14-revisions.t +++ b/t/02-rakudo/14-revisions.t @@ -6,19 +6,19 @@ plan 2; subtest "CORE.setting Revision", { plan 3; - is-run q[use v6.c; print $*CORE-SETTING-REV], "CORE.setting", :out; - is-run q[use v6.d; print $*CORE-SETTING-REV], "CORE.d.setting", :out; - is-run q[use v6.e.PREVIEW; print $*CORE-SETTING-REV], "CORE.e.setting", :out; + is-run q[use v6.c; print CORE-SETTING-REV], "CORE.setting", :out; + is-run q[use v6.d; print CORE-SETTING-REV], "CORE.d.setting", :out; + is-run q[use v6.e.PREVIEW; print CORE-SETTING-REV], "CORE.e.setting", :out; }; subtest "Modifiers", { plan 4; # This test must be edited to match currently planned revision. my $planned_rev = 'e'; - is-run qq[use v6.$planned_rev; print \$*CORE-SETTING-REV], "6.$planned_rev without PREVIEW dies", :exitcode(1), :err(rx:s/Perl v6'.'$planned_rev requires PREVIEW modifier/); - is-run q[use v6.d.TEST; print $*CORE-SETTING-REV], "v6.d.TEST loads CORE.d.setting", :out; - is-run q[use v6.d.TESTDEPR; print $*CORE-SETTING-REV], "Deprecated modifier generates a warning", :out, :err(rx:s/TESTDEPR modifier is deprecated for Perl 6'.'d/); - is-run q[use v6.d.NOMOD; print $*CORE-SETTING-REV], "Deprecated modifier generates a warning", :exitcode(1), :err(rx:s/No compiler available for Perl v6'.'d'.'NOMOD/); + is-run qq[use v6.$planned_rev; print CORE-SETTING-REV], "6.$planned_rev without PREVIEW dies", :exitcode(1), :err(rx:s/Perl v6'.'$planned_rev requires PREVIEW modifier/); + is-run q[use v6.d.TEST; print CORE-SETTING-REV], "v6.d.TEST loads CORE.d.setting", :out; + is-run q[use v6.d.TESTDEPR; print CORE-SETTING-REV], "Deprecated modifier generates a warning", :out, :err(rx:s/TESTDEPR modifier is deprecated for Perl 6'.'d/); + is-run q[use v6.d.NOMOD; print CORE-SETTING-REV], "Deprecated modifier generates a warning", :exitcode(1), :err(rx:s/No compiler available for Perl v6'.'d'.'NOMOD/); } done-testing; From eb88e64ea3c6842c46570176af7bffa68b6ebed5 Mon Sep 17 00:00:00 2001 From: Elizabeth Mattijsen Date: Sun, 7 Jul 2019 14:41:58 +0200 Subject: [PATCH 036/160] Fix for R#3035 --- src/core/signals.pm6 | 7 +++---- 1 file changed, 3 insertions(+), 4 deletions(-) diff --git a/src/core/signals.pm6 b/src/core/signals.pm6 index dd60e3db746..231fab3346b 100644 --- a/src/core/signals.pm6 +++ b/src/core/signals.pm6 @@ -13,11 +13,10 @@ my enum Signal does Signal::Signally ( |do { ); proto sub signal($, |) {*} -multi sub signal(Signal $signal, *@signals, :$scheduler = $*SCHEDULER) { - if @signals.grep( { !nqp::istype($_,Signal) } ).list -> @invalid { - die "Found invalid signals: {@invalid.join(', ')}" +multi sub signal(*@signals, :$scheduler = $*SCHEDULER) { + if @signals.grep( { !nqp::istype($_,Signal) } ) -> @invalid { + die "Found invalid signals: @invalid.join(', ')" } - @signals.unshift: $signal; # 0: Signal not supported by host, Negative: Signal not supported by backend my &do-warning = -> $desc, $name, @sigs { From fcf1f761a1da6465b4ffe9c175993ba4555bf49f Mon Sep 17 00:00:00 2001 From: Elizabeth Mattijsen Date: Sun, 7 Jul 2019 16:09:41 +0200 Subject: [PATCH 037/160] Make sure the signal proto matches Unbreaks "make test" and makes Travis happy --- src/core/signals.pm6 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/core/signals.pm6 b/src/core/signals.pm6 index 231fab3346b..c22b5d41ae9 100644 --- a/src/core/signals.pm6 +++ b/src/core/signals.pm6 @@ -12,7 +12,7 @@ my enum Signal does Signal::Signally ( |do { } ); -proto sub signal($, |) {*} +proto sub signal(|) {*} multi sub signal(*@signals, :$scheduler = $*SCHEDULER) { if @signals.grep( { !nqp::istype($_,Signal) } ) -> @invalid { die "Found invalid signals: @invalid.join(', ')" From 84ee0c8ce26312ddcbb84b67a70f4a055018d2de Mon Sep 17 00:00:00 2001 From: Timo Paulssen Date: Sun, 7 Jul 2019 16:34:53 +0200 Subject: [PATCH 038/160] Optimizer: Don't use Int*Ref in first arg of if/unless/while/until (this refers to the low level nqp ops, so not necessarily immediately works on user code with these keywords, but at the very least, a ternary usually immediately turns into an if op. --- src/Perl6/Optimizer.nqp | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/src/Perl6/Optimizer.nqp b/src/Perl6/Optimizer.nqp index 8dcd45daf99..b69146afacd 100644 --- a/src/Perl6/Optimizer.nqp +++ b/src/Perl6/Optimizer.nqp @@ -1587,7 +1587,7 @@ class Perl6::Optimizer { # a hllbool if there's already an integer result behind it. For if/unless, # we can only do that when we have the `else` branch, since otherwise we # might return the no-longer-Bool value from the conditional. - elsif (+@($op) == 3 && ($optype eq 'if' || $optype eq 'unless')) + elsif ((+@($op) == 3 || $!void_context) && ($optype eq 'if' || $optype eq 'unless')) || $optype eq 'while' || $optype eq 'until' { my $update := $op; my $target := $op[0]; @@ -1600,8 +1600,9 @@ class Perl6::Optimizer { $update[0] := $target[0]; } } - elsif nqp::istype($target,QAST::Var) && $target.scope eq 'lexicalref' && nqp::objprimspec($target.returns) == 1 { + elsif nqp::istype($target,QAST::Var) && ($target.scope eq 'lexicalref' || $target.scope eq 'attributeref' || $target.scope eq "localref") && nqp::objprimspec($target.returns) == 1 { # turn $i into $i != 0 + $target.scope($target.scope eq 'lexicalref' ?? 'lexical' !! $target.scope eq 'attributeref' ?? 'attribute' !! 'local'); $update[0] := QAST::Op.new( :op('isne_i'), :returns($target.returns), $target, QAST::IVal.new( :value(0) )); } } From a46c414f77e8fd48ea0c0707ef4cf8aaf2aced68 Mon Sep 17 00:00:00 2001 From: Elizabeth Mattijsen Date: Sun, 7 Jul 2019 19:52:26 +0200 Subject: [PATCH 039/160] Only initialize HLL version of nqp::getsignals once --- src/core/Rakudo/Internals.pm6 | 3 +++ src/core/signals.pm6 | 14 +++++++------- 2 files changed, 10 insertions(+), 7 deletions(-) diff --git a/src/core/Rakudo/Internals.pm6 b/src/core/Rakudo/Internals.pm6 index 19c21146d86..58248212b34 100644 --- a/src/core/Rakudo/Internals.pm6 +++ b/src/core/Rakudo/Internals.pm6 @@ -1734,6 +1734,9 @@ implementation detail and has no serviceable parts inside" ::("Inline::Perl5").default_perl5 } } + + my %vm-sigs; + method VM-SIGNALS() { %vm-sigs ?? %vm-sigs !! %vm-sigs = nqp::getsignals } } # expose the number of bits a native int has diff --git a/src/core/signals.pm6 b/src/core/signals.pm6 index c22b5d41ae9..4c5f571836f 100644 --- a/src/core/signals.pm6 +++ b/src/core/signals.pm6 @@ -19,11 +19,11 @@ multi sub signal(*@signals, :$scheduler = $*SCHEDULER) { } # 0: Signal not supported by host, Negative: Signal not supported by backend - my &do-warning = -> $desc, $name, @sigs { - warn "The following signals are not supported on this $desc ({$name}): " - ~ "{@sigs.join(', ')}" - }; - my %vm-sigs = nqp::getsignals(); + sub unsupported($desc, $name, @sigs --> Nil) { + warn "The following signals are not supported on this $desc ($name): @sigs.join(', ')"; + } + + my %vm-sigs := Rakudo::Internals.VM-SIGNALS; my ( @valid, @host-unsupported, @vm-unsupported ); for @signals.unique { $_ ?? 0 < %vm-sigs{$_} @@ -31,8 +31,8 @@ multi sub signal(*@signals, :$scheduler = $*SCHEDULER) { !! @vm-unsupported.push($_) !! @host-unsupported.push($_) } - if @host-unsupported -> @s { do-warning 'system', $*KERNEL.name, @s } - if @vm-unsupported -> @s { do-warning 'backend', $*VM\ .name, @s } + if @host-unsupported -> @s { unsupported 'system', $*KERNEL.name, @s } + if @vm-unsupported -> @s { unsupported 'backend', $*VM\ .name, @s } my class SignalCancellation is repr('AsyncTask') { } Supply.merge( @valid.map(-> $signal { From 44169c7a8634a1b6b36bc4453ba8ef5b24e2dec0 Mon Sep 17 00:00:00 2001 From: Vadim Belman Date: Sun, 7 Jul 2019 20:31:30 -0400 Subject: [PATCH 040/160] Return Failure for missing symbols --- src/core/PseudoStash.pm6 | 16 ++++++++++------ 1 file changed, 10 insertions(+), 6 deletions(-) diff --git a/src/core/PseudoStash.pm6 b/src/core/PseudoStash.pm6 index f56a55827a5..9fa43c2fad3 100644 --- a/src/core/PseudoStash.pm6 +++ b/src/core/PseudoStash.pm6 @@ -226,7 +226,7 @@ my class PseudoStash is Map { ); note("AT-KEY RETURNS: ", (nqp::isnull($val) ?? "Failure" !! $val.^name), " // mode: ", $!mode.fmt('%x')) if %*ENV; nqp::isnull($val) - ?? Failure.new(X::NoSuchSymbol.new(symbol => $!package.^name ~ '::' ~ $key)) + ?? Failure.new(X::NoSuchSymbol.new(symbol => $!package.^name ~ '::<' ~ $key ~ '>')) !! $val } @@ -249,7 +249,7 @@ my class PseudoStash is Map { ), nqp::ifnull( $target, - X::NoSuchSymbol.new(symbol => $!package.^name ~ '::' ~ $key).throw + X::NoSuchSymbol.new(symbol => $!package.^name ~ '::<' ~ $key ~ '>').throw ) ) } @@ -388,11 +388,12 @@ my class PseudoStash is Map { # We have candidate if the chain is not dynamic; or if container under the symbol is # dynamic. ($sym := nqp::iterkey_s($!iter)), - (note(" -> $sym is the current symbol") if %*ENV), + (note(" -> $sym is the current symbol") if %*ENV), ($got-one := !nqp::atkey($!seen,$sym) && ( - !nqp::bitand_i(nqp::getattr($!stash,PseudoStash,'$!mode'),DYNAMIC_CHAIN) || + !nqp::bitand_i(nqp::getattr($!stash,PseudoStash,'$!mode'),REQUIRE_DYNAMIC) || (try { nqp::iterval($!iter).VAR.dynamic }) - )) + )), + (note(" -> accepted? ", $got-one ?? "YES" !! "NO") if %*ENV) ) ) ) @@ -426,7 +427,10 @@ my class PseudoStash is Map { method pull-one() is raw { nqp::if( self.next-one, - nqp::iterval($!iter), + nqp::stmts( + (note("VALUE FOR ", nqp::iterkey_s($!iter)) if %*ENV), + nqp::iterval($!iter), + ), IterationEnd ) } From 0a05cbd9ace4061cc5799a06a32c69c8ae92dd31 Mon Sep 17 00:00:00 2001 From: Vadim Belman Date: Sun, 7 Jul 2019 20:32:03 -0400 Subject: [PATCH 041/160] Add REQUIRE_DYNAMIC flag to DYNAMIC:: --- src/core/PseudoStash.pm6 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/core/PseudoStash.pm6 b/src/core/PseudoStash.pm6 index 9fa43c2fad3..9722f27d4b2 100644 --- a/src/core/PseudoStash.pm6 +++ b/src/core/PseudoStash.pm6 @@ -99,7 +99,7 @@ my class PseudoStash is Map { }, 'DYNAMIC', sub ($cur) { my $stash := nqp::clone($cur); - nqp::bindattr_i($stash, PseudoStash, '$!mode', DYNAMIC_CHAIN); + nqp::bindattr_i($stash, PseudoStash, '$!mode', DYNAMIC_CHAIN +| REQUIRE_DYNAMIC); $stash.pseudo-package('DYNAMIC'); }, 'CALLERS', sub ($cur) { From f44c14c356bbe221196f1cbcce60a9163f558985 Mon Sep 17 00:00:00 2001 From: Timo Paulssen Date: Mon, 8 Jul 2019 09:02:04 +0200 Subject: [PATCH 042/160] NativeCall: no need to create lots of Int/Num to "CArray.allocate" --- lib/NativeCall/Types.pm6 | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/lib/NativeCall/Types.pm6 b/lib/NativeCall/Types.pm6 index 421b528ac19..6b7d6171b12 100644 --- a/lib/NativeCall/Types.pm6 +++ b/lib/NativeCall/Types.pm6 @@ -114,12 +114,12 @@ our class CArray is repr('CArray') is array_type(Pointer) { multi method allocate(::?CLASS:U \type: int $elems) { my $arr := nqp::create(type); - nqp::bindpos_i($arr, $_, nqp::create(Int)) for ^$elems; + nqp::bindpos_i($arr, $_, 0) for ^$elems; $arr; } multi method allocate(::?CLASS:U \type: Int:D $elems) { my $arr := nqp::create(type); - nqp::bindpos_i($arr, $_, nqp::create(Int)) for ^$elems; + nqp::bindpos_i($arr, $_, 0) for ^$elems; $arr; } } @@ -146,12 +146,12 @@ our class CArray is repr('CArray') is array_type(Pointer) { multi method allocate(::?CLASS:U \type: int $elems) { my $arr := nqp::create(type); - nqp::bindpos_n($arr, $_, nqp::create(Num)) for ^$elems; + nqp::bindpos_n($arr, $_, 0e0) for ^$elems; $arr; } multi method allocate(::?CLASS:U \type: Int:D $elems) { my $arr := nqp::create(type); - nqp::bindpos_n($arr, $_, nqp::create(Num)) for ^$elems; + nqp::bindpos_n($arr, $_, 0e0) for ^$elems; $arr; } } From 80bf3d003c1c464ac8663e86d9f8d93423e0a51e Mon Sep 17 00:00:00 2001 From: Timo Paulssen Date: Mon, 8 Jul 2019 12:00:13 +0200 Subject: [PATCH 043/160] Optimizer: Direct assignment between native vars don't need refs --- src/Perl6/Optimizer.nqp | 14 ++++++++++++++ 1 file changed, 14 insertions(+) diff --git a/src/Perl6/Optimizer.nqp b/src/Perl6/Optimizer.nqp index b69146afacd..cc147ef1cb0 100644 --- a/src/Perl6/Optimizer.nqp +++ b/src/Perl6/Optimizer.nqp @@ -11,6 +11,13 @@ use Perl6::Ops; # A null QAST node, inserted when we want to eliminate something. my $NULL := QAST::Op.new( :op ); +my sub make-var-not-a-ref($node) { + my $nodescope := $node.scope; + if $nodescope eq "localref" { $node.scope("local") } + elsif $nodescope eq "lexicalref" { $node.scope("lexical") } + elsif $nodescope eq "attributeref" { $node.scope("attribute") } +} + # Represents the current set of blocks we're in and thus the symbols they # make available, and allows for queries over them. my class Symbols { @@ -1485,6 +1492,13 @@ class Perl6::Optimizer { } } } + elsif nqp::istype($op[1], QAST::Var) && my $source-var-primspec := nqp::objprimspec($op[1].returns) != 0 { + if nqp::objprimspec($op[0].returns) == $source-var-primspec { + make-var-not-a-ref($op[0]); + make-var-not-a-ref($op[1]); + $op.op("bind"); + } + } } if $optype eq 'chain' { From 82fc4e57008d7c914085f098f5f08792d1b58b7d Mon Sep 17 00:00:00 2001 From: Timo Paulssen Date: Tue, 9 Jul 2019 01:54:11 +0200 Subject: [PATCH 044/160] NativeCall: turns out CArray nulls itself out when resizing so binding a 0 to every slot was wasteful --- lib/NativeCall/Types.pm6 | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/lib/NativeCall/Types.pm6 b/lib/NativeCall/Types.pm6 index 6b7d6171b12..5503f90a342 100644 --- a/lib/NativeCall/Types.pm6 +++ b/lib/NativeCall/Types.pm6 @@ -114,12 +114,12 @@ our class CArray is repr('CArray') is array_type(Pointer) { multi method allocate(::?CLASS:U \type: int $elems) { my $arr := nqp::create(type); - nqp::bindpos_i($arr, $_, 0) for ^$elems; + nqp::bindpos_i($arr, $elems - 1, 0); $arr; } multi method allocate(::?CLASS:U \type: Int:D $elems) { my $arr := nqp::create(type); - nqp::bindpos_i($arr, $_, 0) for ^$elems; + nqp::bindpos_i($arr, $elems - 1, 0); $arr; } } @@ -146,12 +146,12 @@ our class CArray is repr('CArray') is array_type(Pointer) { multi method allocate(::?CLASS:U \type: int $elems) { my $arr := nqp::create(type); - nqp::bindpos_n($arr, $_, 0e0) for ^$elems; + nqp::bindpos_n($arr, $elems - 1, 0e0); $arr; } multi method allocate(::?CLASS:U \type: Int:D $elems) { my $arr := nqp::create(type); - nqp::bindpos_n($arr, $_, 0e0) for ^$elems; + nqp::bindpos_n($arr, $elems - 1, 0e0); $arr; } } From c503c1df30f3012ef6d12fa5f7e0d8d30c7cab11 Mon Sep 17 00:00:00 2001 From: Vadim Belman Date: Tue, 9 Jul 2019 23:02:20 -0400 Subject: [PATCH 045/160] Pseudo-packages are now implementing most of roast Remove debug prints. --- src/Perl6/Actions.nqp | 2 - src/Perl6/World.nqp | 38 ----- src/core/PseudoStash.pm6 | 300 ++++++++++++++++++++++----------------- 3 files changed, 171 insertions(+), 169 deletions(-) diff --git a/src/Perl6/Actions.nqp b/src/Perl6/Actions.nqp index 4199138c0c1..f0704fdeac3 100644 --- a/src/Perl6/Actions.nqp +++ b/src/Perl6/Actions.nqp @@ -1454,7 +1454,6 @@ class Perl6::Actions is HLL::Actions does STDActions { } method unitstart($/) { - note("--> SET_BLOCK_OUTER_CTX from unitstart") if nqp::getenvhash; # Use SET_BLOCK_OUTER_CTX (inherited from HLL::Actions) # to set dynamic outer lexical context and namespace details # for the compilation unit. @@ -1462,7 +1461,6 @@ class Perl6::Actions is HLL::Actions does STDActions { } method lang-version($/) { - note("--> SET_BLOCK_OUTER_CTX from lang-version") if nqp::getenvhash; self.SET_BLOCK_OUTER_CTX($*UNIT_OUTER); } diff --git a/src/Perl6/World.nqp b/src/Perl6/World.nqp index d26a42cc721..dd170a8ed04 100644 --- a/src/Perl6/World.nqp +++ b/src/Perl6/World.nqp @@ -305,7 +305,6 @@ class Perl6::World is HLL::World { } method push_SETTING($s) { - note("+ PUSHING SETTING: ", nqp::what($s).HOW.name(nqp::what($s))) if nqp::getenvhash; @!SETTINGS[+@!SETTINGS] := $s; } @@ -576,8 +575,6 @@ class Perl6::World is HLL::World { $*MAIN := 'MAIN'; $*STRICT := 1 if $*begin_compunit; - note("load-lang-ver") if nqp::getenvhash; - my str $version := ~$ver-match; my @vparts := nqp::split('.', $version); my $vWhatever := nqp::isge_i(nqp::index($version, '*'), 0); @@ -674,14 +671,12 @@ class Perl6::World is HLL::World { # our setting. Otherwise, load one. my $have_outer := nqp::defined(%*COMPILING<%?OPTIONS>); if $have_outer { - note("We have outer ctx") if nqp::getenvhash; $setting_name := ''; $*UNIT.annotate('IN_DECL', 'eval'); $in_eval := 1; } else { $setting_name := %*COMPILING<%?OPTIONS> // 'CORE'; - note("? SETTING: ", $setting_name) if nqp::getenvhash; if nqp::eqat($setting_name, 'NULL', 0) { $*COMPILING_CORE_SETTING := 1; $*SET_DEFAULT_LANG_VER := 0; @@ -920,7 +915,6 @@ class Perl6::World is HLL::World { } method prep_comp_unit ($/) { - note("!!! Preparing comp unit") if nqp::getenvhash; self.add_load_dependency_task(:deserialize_ast($!setting_fixup_task), :fixup_ast($!setting_fixup_task)); # Checks. self.assert_stubs_defined($/); @@ -930,19 +924,15 @@ class Perl6::World is HLL::World { # Loads a setting. method load_setting($/, $setting_name) { # Do nothing for the NULL setting. - note("> LOADING SETTING ", $setting_name) if nqp::getenvhash; if $setting_name ne 'NULL' { # XXX TODO: see https://github.com/rakudo/rakudo/issues/2432 $setting_name := Perl6::ModuleLoader.transform_setting_name($setting_name); - note("> TRANSFORMED SETTING NAME: ", $setting_name) if nqp::getenvhash; # Load it immediately, so the compile time info is available. # Once it's loaded, set it as the outer context of the code # being compiled unless being loaded as another core dependency. my $setting := %*COMPILING<%?OPTIONS> := Perl6::ModuleLoader.load_setting($setting_name); - note("> LOADED: " ~ nqp::what($setting).HOW.name(nqp::what($setting)), " compunit? ", nqp::iscompunit($setting), ", contains ", nqp::elems($setting), " symbols") if nqp::getenvhash; - # Add a fixup and deserialization task also. my $fixup := QAST::Stmt.new( self.perl6_module_loader_code(), @@ -962,20 +952,6 @@ class Perl6::World is HLL::World { $!setting_fixup_task := $fixup; # self.add_load_dependency_task(:deserialize_ast($fixup), :fixup_ast($fixup)); - # if nqp::getenvhash { - # my $any := nqp::iscompunit($*UNIT_OUTER); - # my $cobj := nqp::ctxcode($setting); - # my %cloc := nqp::getcodelocation($cobj); - # note("> IS COMP UNIT: ", $any, " or ", nqp::iscompunit($setting), " // ", - # " code object: ", $cobj.HOW.name($cobj), " // ", (nqp::defined($cobj) ?? "defined" !! "*undef*"), - # " code file: ", %cloc - # ); - # - # for %cloc { - # my $v := nqp::iterval($_); - # note("> CODE LOCATION: ", nqp::iterkey_s($_), " => ", $v.HOW.name($v)); - # } - # } self.context().push_SETTING($*UNIT_OUTER); return nqp::ctxlexpad($setting); @@ -4818,14 +4794,6 @@ class Perl6::World is HLL::World { # Make sure it's not an empty name. unless +@name { nqp::die("Cannot look up empty name"); } - note("Looking for ", nqp::join('::', @name), " in setting only? ", $setting-only) if nqp::getenvhash; - if nqp::getenvhash { - my @c := self.context.SETTINGS; - for @c -> $cctx { - note("CORE has ", nqp::elems($cctx.symtable), " elems"); - } - } - # GLOBAL is current view of global. if +@name == 1 && @name[0] eq 'GLOBAL' { return $*GLOBALish; @@ -4841,12 +4809,9 @@ class Perl6::World is HLL::World { # If it's a single-part name, look through the lexical # scopes and try the current package. - note(" . Symbols at UNIT_OUTER ", nqp::elems($*UNIT_OUTER.symtable)) if nqp::getenvhash; - if +@name == 1 { my str $final_name := ~@name[0]; if $*WANTEDOUTERBLOCK { - note(" . in WANTEDOUTERBLOCK") if nqp::getenvhash; my $scope := $*WANTEDOUTERBLOCK; while $scope { my %sym := $scope.symbol($final_name); @@ -4861,13 +4826,11 @@ class Perl6::World is HLL::World { } } else { - note(" . not in WANTEDOUTERBLOCK") if nqp::getenvhash; my int $i := $start_scope; while $i > 0 { $i := $i - 1; my %sym := @BLOCKS[$i].symbol($final_name); if +%sym { - note("found $final_name") if nqp::getenvhash; my $value := self.force_value(%sym, $final_name, 1); if $upgrade_to_global { ($*GLOBALish.WHO){$final_name} := $value; @@ -4893,7 +4856,6 @@ class Perl6::World is HLL::World { my int $found := 0; while $i > 0 { $i := $i - 1; - note("Looking in block #$i") if nqp::getenvhash; my %sym := @BLOCKS[$i].symbol($first); if +%sym { $result := self.force_value(%sym, $first, 1); diff --git a/src/core/PseudoStash.pm6 b/src/core/PseudoStash.pm6 index 9722f27d4b2..19dd396510c 100644 --- a/src/core/PseudoStash.pm6 +++ b/src/core/PseudoStash.pm6 @@ -57,7 +57,7 @@ my class PseudoStash is Map { (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_i($stash, PseudoStash, '$!mode', STATIC_CHAIN +| REQUIRE_DYNAMIC), $stash.pseudo-package('CALLER') ) ) @@ -129,7 +129,7 @@ my class PseudoStash is Map { (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_i($stash, PseudoStash, '$!mode', STATIC_CHAIN), $stash.pseudo-package('UNIT') ) ) @@ -178,53 +178,51 @@ my class PseudoStash is Map { ); multi method AT-KEY(PseudoStash:D: Str() $key) is raw { - note("AT-KEY($key) on ", $!package.^name) if %*ENV; my Mu $val := nqp::null(); nqp::if( nqp::existskey($pseudoers,$key), ($val := nqp::atkey($pseudoers,$key)(self)), nqp::stmts( - nqp::if( # PRECISE_SCOPE + nqp::if( # PRECISE_SCOPE is exclusive nqp::bitand_i($!mode,PRECISE_SCOPE), - nqp::stmts( - nqp::if( - nqp::existskey( - nqp::getattr(self,Map,'$!storage'),nqp::unbox_s($key)), - ($val := nqp::atkey( - nqp::getattr(self,Map,'$!storage'),nqp::unbox_s($key))) + nqp::if( + nqp::existskey( + nqp::getattr(self,Map,'$!storage'),nqp::unbox_s($key)), + ($val := nqp::atkey( + nqp::getattr(self,Map,'$!storage'),nqp::unbox_s($key))) + ), + 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)), # "*" + ($val := nqp::ifnull( + nqp::getlexreldyn( + nqp::getattr(self,PseudoStash,'$!ctx'),nqp::unbox_s($key)), + nqp::null() + )) ), - nqp::if( - (nqp::not_i(nqp::isnull($val)) - && nqp::bitand_i($!mode,REQUIRE_DYNAMIC)), - nqp::if( - (try nqp::not_i($val.VAR.dynamic)), - ($val := Failure.new(X::Caller::NotDynamic.new(symbol => $key))) - ) + 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::null() + )) ) ) ), - 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)), # "*" - ($val := nqp::ifnull( - nqp::getlexreldyn( - nqp::getattr(self,PseudoStash,'$!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::null() - )) + nqp::if( + (nqp::not_i(nqp::isnull($val)) + && nqp::bitand_i($!mode,REQUIRE_DYNAMIC)), + nqp::if( + (try nqp::not_i($val.VAR.dynamic)), + ($val := Failure.new(X::Caller::NotDynamic.new(symbol => $key))) + ) ) ) ); - note("AT-KEY RETURNS: ", (nqp::isnull($val) ?? "Failure" !! $val.^name), " // mode: ", $!mode.fmt('%x')) if %*ENV; nqp::isnull($val) ?? Failure.new(X::NoSuchSymbol.new(symbol => $!package.^name ~ '::<' ~ $key ~ '>')) !! $val @@ -234,24 +232,101 @@ my class PseudoStash is Map { 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 { + has Mu $!start-ctx; # Stash context – this is where we start from. + has Mu $!ctx; # Current context. + has int $!stash-mode; + 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_i(self, CtxWalker, '$!stash-mode', + (nqp::getattr(pseudo, PseudoStash, '$!mode') || STATIC_CHAIN) # We default to STATIC_CHAIN + ); + $!modes := nqp::list_i(PRECISE_SCOPE, DYNAMIC_CHAIN, STATIC_CHAIN); + self + } + + method new(PseudoStash:D \pseudo) { nqp::create(self)!SET-SELF(pseudo) } + + method exhausted() { nqp::isnull($!ctx) } + + method next-ctx() { + return [] if nqp::isnull($!ctx); + nqp::stmts( + (my Mu $ret-ctx := $!ctx), + (my $ret-mode := nqp::atpos_i($!modes,0)), + # Don't iterate over precise scope or when all modes has been tried. + nqp::if( + (nqp::bitand_i($!stash-mode,PRECISE_SCOPE) || (nqp::elems($!modes) == 0)), + ($!ctx := nqp::null()), + nqp::repeat_while( + (nqp::isnull($!ctx) && nqp::elems($!modes)), + nqp::if( # Skip a mode unless the stash has it set + nqp::bitand_i($!stash-mode,nqp::atpos_i($!modes,0)), + nqp::stmts( + # If $!ctx is not set at this point then mode switch has took place. Start over. + # The inital context would be returned next time again paired with the new mode. + nqp::unless( + $!ctx, + nqp::bindattr(self, CtxWalker, '$!ctx', $!start-ctx), + nqp::stmts( + nqp::if( + nqp::iseq_i(nqp::atpos_i($!modes,0),DYNAMIC_CHAIN), + ($!ctx := nqp::ctxcallerskipthunks($!ctx)), + ), + nqp::if( + nqp::iseq_i(nqp::atpos_i($!modes,0),STATIC_CHAIN), + ($!ctx := nqp::ctxouterskipthunks($!ctx)), + ), + ) + ), + nqp::unless( # If it's the last context then switch to the next mode. + $!ctx, + nqp::shift_i($!modes), + ) + ), + nqp::shift_i($!modes) + ) + ) + ), + # XXX nqp::list() would be faster, perhaps. But `is raw` is ignored for methods converting BOOTArray + # into List. + [$ret-ctx, $ret-mode] + ) + } + } + # Finds the context in which $key is defined. Throws if not found. - method lookup-ctx(Mu \ctx, Str $key) is raw { - my Mu $ctx := ctx; - my Mu $target := nqp::null(); + # Returns nqp::list(found-ctx, mode-flag) – same as CtxWalker + method lookup-ctx(Str $key) { + my @target; + my $ctx-walker := CtxWalker.new(self); nqp::stmts( - nqp::while( - ($ctx && nqp::isnull($target)), - nqp::if( - nqp::existskey($ctx,nqp::unbox_s($key)), - ($target := $ctx), - ($ctx := self.parent-ctx($ctx)), - ) - ), - nqp::ifnull( - $target, - X::NoSuchSymbol.new(symbol => $!package.^name ~ '::<' ~ $key ~ '>').throw - ) - ) + nqp::while( + ((my @ctx-info = $ctx-walker.next-ctx) && !@target), + nqp::stmts( + (my $ctx := nqp::decont(@ctx-info[0])), + nqp::if( + nqp::existskey($ctx,nqp::unbox_s($key)), + nqp::if( # Skip if non-dynamic symbol is found in a DYNAMIC_CHAIN + ((@ctx-info[1] != DYNAMIC_CHAIN) + || nqp::atkey($ctx,nqp::unbox_s($key)).VAR.dynamic), + (@target = @ctx-info) + ) + ) + ) + ), + nqp::unless( + @target, + X::NoSuchSymbol.new(symbol => $!package.^name ~ '::<' ~ $key ~ '>').throw + ) + ); + $ctx := nqp::decont(@target[0]); + @target } method BIND-KEY(PseudoStash:D: Str() $key, Mu \value) is raw { @@ -261,17 +336,13 @@ my class PseudoStash is Map { nqp::if( nqp::bitand_i($!mode,PRECISE_SCOPE), nqp::bindkey( - nqp::getattr(self,Map,'$!storage'),nqp::unbox_s($key),value), - nqp::if( - nqp::bitand_i( - $!mode,nqp::bitor_i(DYNAMIC_CHAIN,PICK_CHAIN_BY_NAME) - ) && nqp::iseq_i(nqp::ord(nqp::unbox_s($key),1),42), # "*"; TODO: Must validate by .VAR.dynamic - nqp::stmts( - (my Mu $target-ctx := self.lookup-ctx($!ctx,$key)), - nqp::bindkey($target-ctx,nqp::unbox_s($key),value), - ), - nqp::bindkey(self.lookup-ctx($!ctx,$key),nqp::unbox_s($key),value), # STATIC_CHAIN - ) + nqp::getattr(self,Map,'$!storage'),nqp::unbox_s($key),value + ), + nqp::bindkey( + nqp::ctxlexpad(nqp::decont(self.lookup-ctx($key)[0])), + nqp::unbox_s($key), + value + ), ) ) } @@ -305,37 +376,20 @@ my class PseudoStash is Map { ) } - method parent-ctx(PseudoStash:D: Mu \ctx) is raw { - nqp::if( - nqp::bitand_i($!mode,PRECISE_SCOPE), - nqp::null(), - nqp::if( - nqp::bitand_i($!mode,nqp::bitor_i(DYNAMIC_CHAIN,PICK_CHAIN_BY_NAME)), - nqp::ctxcallerskipthunks(ctx), - nqp::ctxouterskipthunks(ctx) # STATIC_CHAIN - ) - ) - } - - # Iterate over context, return symbol => value Pairs. - my role CtxIterator does Iterator { + # Iterate over context + my role CtxSymIterator does Iterator { has PseudoStash $!stash; + has $!stash-mode; has Mu $!ctx; + has $!ctx-mode; + has $!ctx-walker; has $!iter; - has $!seen; + has $!seen; # this also serves as "the first run" indicator. method !SET-SELF(PseudoStash:D \pseudo) { $!stash := pseudo; - # When dealing with precise scope all needed symbols are already in $!storage. For chains we'd need the - # context. - # NOTE: Actually, the storage is our context at all times. Isn't it? * vrurg - $!ctx := nqp::if( - nqp::bitand_i(nqp::getattr(pseudo, PseudoStash, '$!mode'),PRECISE_SCOPE), - nqp::getattr(pseudo, Map, '$!storage'), - nqp::getattr(pseudo, PseudoStash, '$!ctx') - ); - $!iter := nqp::iterator(nqp::ctxlexpad($!ctx)); - $!seen := nqp::hash(); + $!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 self } @@ -343,57 +397,48 @@ my class PseudoStash is Map { # Switch to the next parent context if necessary method maybe-next-context() { - return unless $!ctx; - nqp::unless( - $!iter, - nqp::if( - nqp::bitand_i(nqp::getattr($!stash, PseudoStash, '$!mode'), PRECISE_SCOPE), - # Reset current context manually for precise scope. Otherwise parent-ctx() would do it for us. - nqp::stmts( - # (note(" -> resetting context for PRECISE_SCOPE") if %*ENV), - ($!ctx := nqp::null()), - ), - nqp::stmts( - # (note(" -> iterating over parents") if %*ENV), - nqp::repeat_while( - ($!ctx && !nqp::elems($!ctx)), # Until context with symbols is found; or no parents left. - ($!ctx := $!stash.parent-ctx($!ctx)), + nqp::unless( + $!iter, + nqp::if( + $!ctx-walker.exhausted, + nqp::stmts( + ($!ctx := nqp::null()), ), - nqp::if( - $!ctx, - # If we have a parent context then iterate over it. - ($!iter := nqp::iterator(nqp::ctxlexpad($!ctx))), + nqp::stmts( + (my @ctx-info = $!ctx-walker.next-ctx), + ($!ctx := nqp::decont(@ctx-info[0])), + ($!ctx-mode = @ctx-info[1]), + ($!iter := nqp::iterator(nqp::ctxlexpad($!ctx))) ) ) ) - ) } # Like pull-one but doesn't return actual value. Skips non-dynamics in dynamic chains. - method next-one() is raw { - note("next-one on ", nqp::getattr($!stash,PseudoStash,'$!package').^name) if %*ENV; + method next-one() { my $got-one := 0; my $sym; nqp::while( # Repeat until got a candidate or no more contexts to iterate left - ($!ctx && !$got-one), + (!nqp::defined($!seen) || ($!ctx && !$got-one)), nqp::stmts( - (note(" -> maybe next context?") if %*ENV), + nqp::unless(nqp::defined($!seen), $!seen := nqp::hash()), self.maybe-next-context, - (note(" -> has iter?") if %*ENV), nqp::if( $!iter, nqp::stmts( - (note(" -> shift iter") if %*ENV), nqp::shift($!iter), # We have candidate if the chain is not dynamic; or if container under the symbol is # dynamic. ($sym := nqp::iterkey_s($!iter)), - (note(" -> $sym is the current symbol") if %*ENV), + # The symbol has to be dynamic if pseudo-package is marked as requiring dynamics or if + # we'recurrently iterating over the dynamic chain. ($got-one := !nqp::atkey($!seen,$sym) && ( - !nqp::bitand_i(nqp::getattr($!stash,PseudoStash,'$!mode'),REQUIRE_DYNAMIC) || - (try { nqp::iterval($!iter).VAR.dynamic }) - )), - (note(" -> accepted? ", $got-one ?? "YES" !! "NO") if %*ENV) + ! ( + nqp::bitand_i($!stash-mode, REQUIRE_DYNAMIC) + || $!ctx-mode == DYNAMIC_CHAIN + ) + || (try { nqp::iterval($!iter).VAR.dynamic }) + )) ) ) ) @@ -403,7 +448,7 @@ my class PseudoStash is Map { } } - my class CtxIterator::Pairs does CtxIterator { + my class CtxSymIterator::Pairs does CtxSymIterator { method pull-one() is raw { nqp::if( self.next-one, @@ -413,7 +458,7 @@ my class PseudoStash is Map { } } - my class CtxIterator::Keys does CtxIterator { + my class CtxSymIterator::Keys does CtxSymIterator { method pull-one() is raw { nqp::if( self.next-one, @@ -423,31 +468,28 @@ my class PseudoStash is Map { } } - my class CtxIterator::Values does CtxIterator { + my class CtxSymIterator::Values does CtxSymIterator { method pull-one() is raw { nqp::if( self.next-one, - nqp::stmts( - (note("VALUE FOR ", nqp::iterkey_s($!iter)) if %*ENV), - nqp::iterval($!iter), - ), + nqp::iterval($!iter), IterationEnd ) } } - multi method iterator(PseudoStash:D: --> Iterator:D) { CtxIterator::Pairs.new(self) } + 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(CtxIterator::Keys.new(self)) + Seq.new(CtxSymIterator::Keys.new(self)) } multi method values(PseudoStash:D: --> Seq:D) { - Seq.new(CtxIterator::Values.new(self)) + Seq.new(CtxSymIterator::Values.new(self)) } method pseudo-package(PseudoStash:D: Str:D $name) is raw { From 2b1537c789fbe3c66a3f7e0fab3717dc9720a87b Mon Sep 17 00:00:00 2001 From: Vadim Belman Date: Tue, 9 Jul 2019 23:03:32 -0400 Subject: [PATCH 046/160] Adapt tests to slighly changed behavior of pseudo-packages --- t/08-performance/03-corekeys.t | 6 ++++++ t/08-performance/04-settingkeys.t | 21 ++++++++++++++++++--- 2 files changed, 24 insertions(+), 3 deletions(-) diff --git a/t/08-performance/03-corekeys.t b/t/08-performance/03-corekeys.t index 047532ad58c..56ef1a9e5de 100644 --- a/t/08-performance/03-corekeys.t +++ b/t/08-performance/03-corekeys.t @@ -757,6 +757,12 @@ my %allowed = ( Q{π}, Q{τ}, Q{𝑒}, + Q{$=finish}, + Q{$?PACKAGE}, + Q{::?PACKAGE}, + Q{GLOBALish}, + Q{$¢}, + Q{EXPORT}, ).map: { $_ => 1 }; my @unknown; diff --git a/t/08-performance/04-settingkeys.t b/t/08-performance/04-settingkeys.t index ac14e2a9ef5..1fa3cec1107 100644 --- a/t/08-performance/04-settingkeys.t +++ b/t/08-performance/04-settingkeys.t @@ -4,6 +4,9 @@ plan 1; # output of "perl6 -e '.say for SETTING::.keys.sort.map: { qq:!c/ Q{$_},/ }'" my %allowed = ( Q{!UNIT_MARKER}, + Q{!CORE_MARKER}, + Q{Int}, + Q{&CORE-SETTING-REV}, Q{$!}, Q{$/}, Q{$=finish}, @@ -25,6 +28,18 @@ my %allowed = ( ).map: { $_ => 1 }; my @unknown; -@unknown.push($_) unless %allowed{$_}:exists for SETTING::.keys; -diag "Found {+@unknown} unexpected entries: { @unknown.sort }" unless -ok @unknown == 0, "No unexpected entries in SETTING::"; +my $known-count; +my @missing; +for %allowed.keys { + if SETTING::{$_}:exists { + $known-count++ + } + else { + @missing.push: $_; + } +} +is %allowed.elems, $known-count, "all allowed symbols found"; +diag "Missing symbols: { @missing.sort }" if @missing; +#@unknown.push($_) unless %allowed{$_}:exists for SETTING::.keys; +#diag "Found {+@unknown} unexpected entries: { @unknown.sort }" unless +#ok @unknown == 0, "No unexpected entries in SETTING::"; From 586879040957c65a1d845820123d21c7c02be574 Mon Sep 17 00:00:00 2001 From: Vadim Belman Date: Wed, 10 Jul 2019 09:30:02 -0400 Subject: [PATCH 047/160] Re-apply accidentally overriden commit. A more complete solution to #3000 - pre-check EXPRessions, filter out the undefined ones - refactor circumfix() and circumfix[] code into single sub - remove dead code --- src/Perl6/Actions.nqp | 96 +++++++++++++++---------------------------- 1 file changed, 32 insertions(+), 64 deletions(-) diff --git a/src/Perl6/Actions.nqp b/src/Perl6/Actions.nqp index f0704fdeac3..6e86be87b84 100644 --- a/src/Perl6/Actions.nqp +++ b/src/Perl6/Actions.nqp @@ -6615,10 +6615,7 @@ class Perl6::Actions is HLL::Actions does STDActions { method term:sym($/) { make $.ast; } - method circumfix:sym<( )>($/) { - my $Pair := $*W.find_symbol(['Pair']); - my $past := $.ast; - + sub handle-list-semis($/, $past) { if !+$past.list { $past := QAST::Stmts.new( :node($/) ); $past.push(QAST::Op.new( :op('call'), :name('&infix:<,>'), :node($/))); @@ -6626,15 +6623,27 @@ class Perl6::Actions is HLL::Actions does STDActions { # Look for any chained adverb pairs and relocate them. # Try to reuse existing QAST where possible. elsif $*FAKE_INFIX_FOUND { - my $numsemis := +$; + my @EXPR; + my $semis := $; + my $numsemis := +$semis; + + my $i := -1; + while ++$i < $numsemis { + my $EXPR := $semis[$i]; + if nqp::defined($EXPR) { + @EXPR.push($EXPR); + } + } + $numsemis := +@EXPR; + if $numsemis > 1 { $past := QAST::Stmts.new( :node($/) ); $past.push(QAST::Op.new( :op('call'), :name('&infix:<,>'), :node($/))); } - my $semi := 0; - repeat until $semi >= $numsemis { - my $EXPR := $[$semi] // - nqp::die("internal problem: parser did not give circumfix an EXPR"); + + my $semi := -1; + while ++$semi < $numsemis { + my $EXPR := @EXPR[$semi]; if $EXPR { # might start with a colonpair my @fan := nqp::list($EXPR.ast); migrate_colonpairs($/, @fan); @@ -6659,11 +6668,23 @@ class Perl6::Actions is HLL::Actions does STDActions { $past[0].push($EXPR.ast); } } - $semi++; } $past := wanted($past, 'circumfix()/pair'); } - make $past; + $past + } + + method circumfix:sym<( )>($/) { + make handle-list-semis($/, $.ast) + } + + method circumfix:sym<[ ]>($/) { + make QAST::Op.new( + :op('call'), + :name('&circumfix:<[ ]>'), + handle-list-semis($/, $.ast), + :node($/) + ) } method circumfix:sym($/) { @@ -6863,59 +6884,6 @@ class Perl6::Actions is HLL::Actions does STDActions { } } - method circumfix:sym<[ ]>($/) { - - my $Pair := $*W.find_symbol(['Pair']); - my $past := $.ast; - - if !+$past.list { - $past := QAST::Stmts.new( :node($/) ); - $past.push(QAST::Op.new( :op('call'), :name('&infix:<,>'), :node($/))); - } - # Look for any chained adverb pairs and relocate them. - # Try to reuse existing QAST where possible. - elsif $*FAKE_INFIX_FOUND { - my $numsemis := +$; - if $numsemis > 1 { - $past := QAST::Stmts.new( :node($/) ); - $past.push(QAST::Op.new( :op('call'), :name('&infix:<,>'), :node($/))); - } - my $semi := 0; - repeat until $semi >= $numsemis { - my $EXPR := $[$semi] // - nqp::die("internal problem: parser did not give circumfix an EXPR"); - if $EXPR { # might start with a colonpair - my @fan := nqp::list($EXPR.ast); - migrate_colonpairs($/, @fan); - if (+@fan > 1) { - my $comma := QAST::Op.new( :op('call'), :name('&infix:<,>'), :node($/)); - for @fan { $comma.push($_) } - if ($numsemis == 1) { - $past := QAST::Stmts.new( :node($/) ); - $past.push($comma); - } - else { - $past[0].push($comma); - } - } - elsif ($numsemis > 1) { - $past[0].push($EXPR.ast); - } - } - else { - migrate_colonpairs($/, $EXPR.ast.list); - if ($numsemis > 1) { - $past[0].push($EXPR.ast); - } - } - $semi++; - } - $past := wanted($past, 'circumfix[]/pair'); - } - - make QAST::Op.new( :op('call'), :name('&circumfix:<[ ]>'), $past, :node($/) ); - } - ## Expressions my %specials := nqp::hash( '==>', -> $/, $sym { make_feed($/) }, From ec8f0b09b36a317cd6dc9059c098f38589ab2575 Mon Sep 17 00:00:00 2001 From: Vadim Belman Date: Wed, 10 Jul 2019 09:42:15 -0400 Subject: [PATCH 048/160] Remove surplus debug prints --- src/Perl6/ModuleLoader.nqp | 2 -- 1 file changed, 2 deletions(-) diff --git a/src/Perl6/ModuleLoader.nqp b/src/Perl6/ModuleLoader.nqp index 6362551f29f..64936c8f657 100644 --- a/src/Perl6/ModuleLoader.nqp +++ b/src/Perl6/ModuleLoader.nqp @@ -248,7 +248,6 @@ class Perl6::ModuleLoader does Perl6::ModuleLoaderVMConfig { DEBUG("Loading settings $setting_name") if $DEBUG; # Find it. my $path := self.find_setting($setting_name); - DEBUG("Found settings $setting_name") if $DEBUG; # Load it. my $*CTXSAVE := self; @@ -257,7 +256,6 @@ class Perl6::ModuleLoader does Perl6::ModuleLoaderVMConfig { nqp::scwbdisable(); DEBUG("Loading bytecode from $path") if $DEBUG; nqp::loadbytecode($path); - DEBUG("Loaded bytecode from $path") if $DEBUG; nqp::scwbenable(); nqp::bindhllsym('perl6', 'GLOBAL', $preserve_global); unless nqp::defined($*MAIN_CTX) { From af108863545cf6b1e740a0ecdf77329ee735fc91 Mon Sep 17 00:00:00 2001 From: Elizabeth Mattijsen Date: Wed, 10 Jul 2019 19:32:44 +0200 Subject: [PATCH 049/160] Don't use HLL ! for negation since the rest is already in nqp:: ops. Shaves off just a little bit on !MATCH-PASS in a tight loop. --- src/core/Match.pm6 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/core/Match.pm6 b/src/core/Match.pm6 index 232af9c3f4f..e2ce3850464 100644 --- a/src/core/Match.pm6 +++ b/src/core/Match.pm6 @@ -45,7 +45,7 @@ my class Match is Capture is Cool does NQPMatchRole { my $rxsub := nqp::getattr(self, Match, '$!regexsub'); nqp::isnull($rxsub) || nqp::isnull(my $cap-meth := nqp::tryfindmethod($rxsub, 'CAPS')) || - nqp::isnull(my $caps := $cap-meth($rxsub)) || !$caps.has-captures() + nqp::isnull(my $caps := $cap-meth($rxsub)) || nqp::not_i($caps.has-captures) ?? self!MATCH-EMPTY() !! self!MATCH-CAPTURES(); From abbd1285dbe5c3ab62b0e1c823be7515288456cc Mon Sep 17 00:00:00 2001 From: Jeremy Studer Date: Wed, 10 Jul 2019 21:15:13 -0400 Subject: [PATCH 050/160] Propagate laziness in KeyValue/Pair Iterators Propagate the laziness value from the base iterator used. Otherwise using .kv, .pairs, or .antipairs on a lazy list would cause it to be eagerly evaluated. --- src/core/Rakudo/Iterator.pm6 | 3 +++ 1 file changed, 3 insertions(+) diff --git a/src/core/Rakudo/Iterator.pm6 b/src/core/Rakudo/Iterator.pm6 index 56e9968ee7e..4f21f01a22a 100644 --- a/src/core/Rakudo/Iterator.pm6 +++ b/src/core/Rakudo/Iterator.pm6 @@ -500,6 +500,7 @@ class Rakudo::Iterator { target.push(Pair.new(pulled,+($key = nqp::add_i($key,1)))) ) } + method is-lazy() { $!iter.is-lazy } } method AntiPair(\iterator) { AntiPair.new(iterator) } @@ -2037,6 +2038,7 @@ class Rakudo::Iterator { ) ) } + method is-lazy() { $!iter.is-lazy } } method KeyValue(\iterator) { KeyValue.new(iterator) } @@ -2504,6 +2506,7 @@ class Rakudo::Iterator { target.push(Pair.new(($key = nqp::add_i($key,1)),$pulled)) ) } + method is-lazy() { $!iter.is-lazy } } method Pair(\iterator) { PairIterator.new(iterator) } From 3d356629a718349190d9cb74ac350d4d29750cd3 Mon Sep 17 00:00:00 2001 From: Vadim Belman Date: Thu, 11 Jul 2019 18:03:10 -0400 Subject: [PATCH 051/160] Fix for incorrect installation of nested modules REQUIRE_IMPORT was always attempting to install submodules at its caller's context. That wasn't causing any troubles while pseudo-packages was returning Nil for unknown symbols. Now, when Failure is been returned, it causes DESTROY to explode. The fix is to install at the top existing package, where submodule actually belongs. --- src/core/operators.pm6 | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/src/core/operators.pm6 b/src/core/operators.pm6 index a201cc16478..d90b0aa1676 100644 --- a/src/core/operators.pm6 +++ b/src/core/operators.pm6 @@ -611,6 +611,7 @@ sub REQUIRE_IMPORT($compunit, $existing-path,$top-existing-pkg,$stubname, *@syms my $block := CALLER::.EXISTS-KEY('%REQUIRE_SYMBOLS') ?? CALLER::MY:: !! CALLER::OUTER::; + my $merge-globals-target := $block; my $targetWHO; my $sourceWHO; @@ -634,6 +635,7 @@ sub REQUIRE_IMPORT($compunit, $existing-path,$top-existing-pkg,$stubname, *@syms } $targetWHO.merge-symbols($sourceWHO); } + $merge-globals-target := $top-existing-pkg; } elsif $stubname { $targetWHO := $block.AT-KEY($stubname).WHO; $sourceWHO := $GLOBALish.AT-KEY($stubname).WHO; @@ -651,7 +653,7 @@ sub REQUIRE_IMPORT($compunit, $existing-path,$top-existing-pkg,$stubname, *@syms X::Import::MissingSymbols.new(:from($compunit.short-name), :@missing).throw; } nqp::gethllsym('perl6','ModuleLoader').merge_globals( - $block.AT-KEY($stubname).WHO, + $merge-globals-target.AT-KEY($stubname).WHO, $GLOBALish, ) if $stubname; # Merge GLOBAL from compunit. From 65207879172e6203dde3b40d2b8eb75d8e7c7978 Mon Sep 17 00:00:00 2001 From: Vadim Belman Date: Thu, 11 Jul 2019 19:25:45 -0400 Subject: [PATCH 052/160] Make $*PERL.version report correct compiler version Fixes rakudo/rakudo#2433. The fix is incomplete without fixing EVAL which causes compiler to record last loaded language revision and preserve it after the EVAL is complete. --- src/core/Perl.pm6 | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/src/core/Perl.pm6 b/src/core/Perl.pm6 index b2503f6b0b9..3cfaa7acd69 100644 --- a/src/core/Perl.pm6 +++ b/src/core/Perl.pm6 @@ -13,6 +13,12 @@ class Perl does Systemic { method DISTROnames { } method KERNELnames { } + + my %version-cache; + method version { + my $comp-ver = nqp::p6box_s(nqp::getcomp('perl6').language_version()); + %version-cache{$comp-ver} //= Version.new($comp-ver); + } } # vim: ft=perl6 expandtab sw=4 From 44ba0f22355313c4e3daf1152fe19d3466e0b782 Mon Sep 17 00:00:00 2001 From: Vadim Belman Date: Thu, 11 Jul 2019 20:35:46 -0400 Subject: [PATCH 053/160] Revert the original Optimizer behaviour, just fix it The old 'scan for setting' approach is better when handling of user-defined settings is needed. I just got it adapted for mutiple COREs and SETTINGs loaded. --- src/Perl6/Optimizer.nqp | 59 +++++++++++++++-------------------------- 1 file changed, 22 insertions(+), 37 deletions(-) diff --git a/src/Perl6/Optimizer.nqp b/src/Perl6/Optimizer.nqp index 65fbb3119cd..b5ed85812de 100644 --- a/src/Perl6/Optimizer.nqp +++ b/src/Perl6/Optimizer.nqp @@ -27,7 +27,7 @@ my class Symbols { # Some interesting scopes. has $!GLOBALish; has $!UNIT; - # has $!SETTING; + has @!CORES; # Cached setting lookups. has %!SETTING_CACHE; @@ -56,6 +56,7 @@ my class Symbols { } method BUILD($compunit) { @!block_stack := [$compunit[0]]; + @!CORES := []; $!GLOBALish := $compunit.ann('GLOBALish'); $!UNIT := $compunit.ann('UNIT'); %!SETTING_CACHE := {}; @@ -267,47 +268,31 @@ my class Symbols { return 0; } - # method find_in_setting($symbol) { - # if !nqp::defined($!SETTING) { - # my int $i := +@!block_stack; - # while $i > 0 && !nqp::defined($!SETTING) { - # $i := $i - 1; - # my $block := @!block_stack[$i]; - # my %sym := $block.symbol("!CORE_MARKER"); - # if +%sym { - # $!SETTING := $block; - # } - # } - # if !nqp::defined($!SETTING) { - # nqp::die("Optimizer couldn't find CORE while looking for $symbol."); - # } - # } else { - # if nqp::existskey(%!SETTING_CACHE, $symbol) { - # return %!SETTING_CACHE{$symbol}; - # } - # } - # my %sym := $!SETTING.symbol($symbol); - # if +%sym { - # return %!SETTING_CACHE{$symbol} := self.force_value(%sym, $symbol, 1); - # } - # nqp::die("Optimizer couldn't find $symbol in SETTING."); - # } - method find_in_setting($symbol) { - if nqp::existskey(%!SETTING_CACHE, $symbol) { - return %!SETTING_CACHE{$symbol}; - } - my @settings := $*W.context().SETTINGS(); - unless +@settings { - nqp::die("Optimizer couldn't find CORE while looking for $symbol."); + if !nqp::elems(@!CORES) { + my int $i := +@!block_stack; + while $i > 0 { + $i := $i - 1; + my $block := @!block_stack[$i]; + my %sym := $block.symbol("!CORE_MARKER"); + if +%sym { + nqp::push(@!CORES, $block); + } + } + if !nqp::elems(@!CORES) { + nqp::die("Optimizer couldn't find CORE while looking for $symbol."); + } + } else { + if nqp::existskey(%!SETTING_CACHE, $symbol) { + return %!SETTING_CACHE{$symbol}; + } } - my int $i := +@settings; - while $i > 0 { - my $setting := @settings[--$i]; - my %sym := $setting.symbol($symbol); + for @!CORES -> $core { + my %sym := $core.symbol($symbol); if +%sym { return %!SETTING_CACHE{$symbol} := self.force_value(%sym, $symbol, 1); } + } nqp::die("Optimizer couldn't find $symbol in SETTING."); } From a17d46520a79c12ff78c24fe83aee901858c00aa Mon Sep 17 00:00:00 2001 From: Vadim Belman Date: Thu, 11 Jul 2019 20:39:55 -0400 Subject: [PATCH 054/160] Implement die's default of fetching $! Search in caller's lexical scope, including outers. --- src/core/control.pm6 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/core/control.pm6 b/src/core/control.pm6 index e12c17f8dcb..213e2ddb03e 100644 --- a/src/core/control.pm6 +++ b/src/core/control.pm6 @@ -167,7 +167,7 @@ sub done(--> Nil) { proto sub die(|) {*}; multi sub die(--> Nil) { - my $stash := CALLER::; + my $stash := CALLER::LEXICAL::; my $payload = $stash<$!>.DEFINITE ?? $stash<$!> !! "Died"; $payload ~~ Exception ?? $payload.throw From 075e60a56a9f0a35b0df2749d6ab3cf610ca7dee Mon Sep 17 00:00:00 2001 From: Vadim Belman Date: Thu, 11 Jul 2019 20:41:38 -0400 Subject: [PATCH 055/160] Prevent EVAL from loading CORE settings Also ignore language version changes by `use v6.X`. NOTE: It would be more desirable to throw X::Language::TooLate but doing so breaks install-core-dist.p6 script. Could also have other undesirable side effects in 3rd party modules. Perhaps would make a sense of generating a deperecation warning unless another solution would be found for thread-safety issues of EVAL. Following IRC discussion here: https://colabti.org/irclogger/irclogger_log/perl6-dev?date=2019-07-11#l236 --- src/Perl6/World.nqp | 19 ++++++++++++++++--- 1 file changed, 16 insertions(+), 3 deletions(-) diff --git a/src/Perl6/World.nqp b/src/Perl6/World.nqp index dd170a8ed04..db7574c6dfd 100644 --- a/src/Perl6/World.nqp +++ b/src/Perl6/World.nqp @@ -572,6 +572,11 @@ class Perl6::World is HLL::World { # NOTE: Revision .c has special meaning because it doesn't have own dedicated CORE setting and serves as the base # for all other revisions. method load-lang-ver($ver-match, $comp) { + if $*INSIDE-EVAL { + # XXX This is desirable behavior. But it breaks some code. Just ignore version change for now. + #$ver-match.typed_panic: 'X::Language::TooLate'; + return + } $*MAIN := 'MAIN'; $*STRICT := 1 if $*begin_compunit; @@ -798,6 +803,12 @@ class Perl6::World is HLL::World { } } + method add_unit_marker($/, $name) { + my $marker := self.pkg_create_mo($/, $/.how('package'), :$name); + $marker.HOW.compose($marker); + self.install_lexical_symbol($*UNIT, $name, $marker); + } + method mop_up_and_check($/) { # Install POD-related variables. @@ -813,9 +824,8 @@ class Perl6::World is HLL::World { my $name := $*COMPILING_CORE_SETTING ?? '!CORE_MARKER' !! '!UNIT_MARKER'; - my $marker := self.pkg_create_mo($/, $/.how('package'), :$name); - $marker.HOW.compose($marker); - self.install_lexical_symbol($*UNIT, $name, $marker); + self.add_unit_marker($/, $name); + self.add_unit_marker($/, '!EVAL_MARKER') if $*INSIDE-EVAL; # CHECK time. self.CHECK(); @@ -924,6 +934,9 @@ class Perl6::World is HLL::World { # Loads a setting. method load_setting($/, $setting_name) { # Do nothing for the NULL setting. + if $*INSIDE-EVAL { + return + } if $setting_name ne 'NULL' { # XXX TODO: see https://github.com/rakudo/rakudo/issues/2432 $setting_name := Perl6::ModuleLoader.transform_setting_name($setting_name); From 43bf9102d014f077ff4bf0bf0d77e219e9c54559 Mon Sep 17 00:00:00 2001 From: Vadim Belman Date: Thu, 11 Jul 2019 20:47:38 -0400 Subject: [PATCH 056/160] Revert recording of loaded CORES It doesn't have any use anymore. --- src/Perl6/World.nqp | 14 -------------- 1 file changed, 14 deletions(-) diff --git a/src/Perl6/World.nqp b/src/Perl6/World.nqp index db7574c6dfd..4b62405ba56 100644 --- a/src/Perl6/World.nqp +++ b/src/Perl6/World.nqp @@ -193,8 +193,6 @@ class Perl6::World is HLL::World { # The outermost block is at the bottom, the latest block is on top. has @!PADS_AND_THUNKS; - has @!SETTINGS; - # The stack of code objects; phasers get attached to the top one. has @!CODES; @@ -237,7 +235,6 @@ class Perl6::World is HLL::World { method BUILD(:$handle, :$description) { @!PADS := []; - @!SETTINGS := []; @!PADS_AND_THUNKS := []; @!CODES := []; @!stub_check := []; @@ -255,10 +252,6 @@ class Perl6::World is HLL::World { @!PADS } - method SETTINGS() { - @!SETTINGS - } - method create_block($/) { # Create pad, link to outer, annotate with creating statement. my $pad := QAST::Block.new( QAST::Stmts.new( :node($/) ) ); @@ -304,10 +297,6 @@ class Perl6::World is HLL::World { @!PADS_AND_THUNKS.pop(); } - method push_SETTING($s) { - @!SETTINGS[+@!SETTINGS] := $s; - } - # Gets the top block or thunk. method cur_block_or_thunk() { @!PADS_AND_THUNKS[+@!PADS_AND_THUNKS - 1] @@ -685,7 +674,6 @@ class Perl6::World is HLL::World { if nqp::eqat($setting_name, 'NULL', 0) { $*COMPILING_CORE_SETTING := 1; $*SET_DEFAULT_LANG_VER := 0; - self.context.push_SETTING($*UNIT); } self.load_setting($/,$setting_name); $*UNIT.annotate('IN_DECL', 'mainline'); @@ -965,8 +953,6 @@ class Perl6::World is HLL::World { $!setting_fixup_task := $fixup; # self.add_load_dependency_task(:deserialize_ast($fixup), :fixup_ast($fixup)); - self.context().push_SETTING($*UNIT_OUTER); - return nqp::ctxlexpad($setting); } } From fb6a7d35be2c8351207454f3800979cabcccdc43 Mon Sep 17 00:00:00 2001 From: Vadim Belman Date: Thu, 11 Jul 2019 20:48:27 -0400 Subject: [PATCH 057/160] Correct scope definitions and EVAL support - MY is back to PRECISE_SCOPE - CALLER is PRECISE_SCOPE with only dynamics included - LEXICAL now includes dynamic symbols implementing the notion of 'everything visible within this scope' SETTING pseudo now correctly handles EVAL'ed scopes. --- src/core/PseudoStash.pm6 | 21 ++++++++++++++++----- 1 file changed, 16 insertions(+), 5 deletions(-) diff --git a/src/core/PseudoStash.pm6 b/src/core/PseudoStash.pm6 index 19dd396510c..c536d61f900 100644 --- a/src/core/PseudoStash.pm6 +++ b/src/core/PseudoStash.pm6 @@ -27,7 +27,7 @@ my class PseudoStash is Map { my $pseudoers := nqp::hash( 'MY', sub ($cur) { my $stash := nqp::clone($cur); - nqp::bindattr_i($stash, PseudoStash, '$!mode', STATIC_CHAIN +| DYNAMIC_CHAIN); + nqp::bindattr_i($stash, PseudoStash, '$!mode', PRECISE_SCOPE); $stash.pseudo-package('MY'); }, 'CORE', sub ($cur) { @@ -57,7 +57,7 @@ my class PseudoStash is Map { (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 +| REQUIRE_DYNAMIC), + nqp::bindattr_i($stash, PseudoStash, '$!mode', PRECISE_SCOPE +| REQUIRE_DYNAMIC), $stash.pseudo-package('CALLER') ) ) @@ -79,7 +79,7 @@ my class PseudoStash is Map { }, 'LEXICAL', sub ($cur) { my $stash := nqp::clone($cur); - nqp::bindattr_i($stash, PseudoStash, '$!mode', STATIC_CHAIN); + nqp::bindattr_i($stash, PseudoStash, '$!mode', STATIC_CHAIN +| DYNAMIC_CHAIN); $stash.pseudo-package('LEXICAL') }, 'OUTERS', sub ($cur) { @@ -138,11 +138,22 @@ my class PseudoStash is Map { # Same as UNIT, but go a little further out (two steps, for # internals reasons). my Mu $ctx := nqp::getattr(nqp::decont($cur), PseudoStash, '$!ctx'); - until nqp::isnull($ctx) || nqp::existskey(nqp::ctxlexpad($ctx), '!UNIT_MARKER') { + until nqp::isnull($ctx) + || (nqp::existskey(nqp::ctxlexpad($ctx), '!UNIT_MARKER') + && !nqp::existskey(nqp::ctxlexpad($ctx), '!EVAL_MARKER')) { $ctx := nqp::ctxouterskipthunks($ctx); } + # EVAL adds two extra contexts to EVAL'ed code. + my $outers = ($ctx && nqp::existskey(nqp::ctxlexpad($ctx), '!EVAL_MARKER')) ?? 4 !! 2; + nqp::until( + (nqp::isnull($ctx) || !$outers), + nqp::stmts( + ($ctx := nqp::ctxouter($ctx)), + ($outers--) + ) + ); nqp::if( - nqp::isnull($ctx) || nqp::isnull($ctx := nqp::ctxouter(nqp::ctxouter($ctx))), + nqp::isnull($ctx), Nil, nqp::stmts( (my $stash := nqp::create(PseudoStash)), From d3e0c5285073c92ab0d48eb4dc5d502a32ef52ec Mon Sep 17 00:00:00 2001 From: Vadim Belman Date: Thu, 11 Jul 2019 21:02:31 -0400 Subject: [PATCH 058/160] Temporarily disable lang-ver-before tests They would probably need individual files because EVAL doesn't currently support `use v6.X` --- t/02-rakudo/99-misc.t | 3 +++ 1 file changed, 3 insertions(+) diff --git a/t/02-rakudo/99-misc.t b/t/02-rakudo/99-misc.t index 1051674b73e..1265d5dcb22 100644 --- a/t/02-rakudo/99-misc.t +++ b/t/02-rakudo/99-misc.t @@ -6,12 +6,15 @@ plan 10; subtest '.lang-ver-before method on Perl6::World' => { plan 5; + skip "use v6.X is currently unsupported by EVAL", 4; + if False { ok ｢use v6.c; BEGIN $*W.lang-ver-before: 'd'｣.EVAL, 'c is before d'; nok ｢use v6.c; BEGIN $*W.lang-ver-before: 'c'｣.EVAL, 'c is not before d'; nok ｢use v6.e.PREVIEW; BEGIN $*W.lang-ver-before: 'e'｣.EVAL, 'e.PREVIEW is not before e'; nok ｢use v6.e.PREVIEW; BEGIN $*W.lang-ver-before: 'd'｣.EVAL, 'e is not before d'; + } throws-like ｢BEGIN $*W.lang-ver-before: <6.d>｣, Exception, :self{.exception.message.contains: 'must be 1 char long'}, 'using wrong version format as argument throws'; From 630995c7768179506967ec97eedac7a90e03231b Mon Sep 17 00:00:00 2001 From: Vadim Belman Date: Thu, 11 Jul 2019 21:03:28 -0400 Subject: [PATCH 059/160] Cleanup up test !UNIT_MARKER is not in SETTING now. --- t/08-performance/04-settingkeys.t | 1 - 1 file changed, 1 deletion(-) diff --git a/t/08-performance/04-settingkeys.t b/t/08-performance/04-settingkeys.t index 1fa3cec1107..7cda4630a48 100644 --- a/t/08-performance/04-settingkeys.t +++ b/t/08-performance/04-settingkeys.t @@ -3,7 +3,6 @@ plan 1; # output of "perl6 -e '.say for SETTING::.keys.sort.map: { qq:!c/ Q{$_},/ }'" my %allowed = ( - Q{!UNIT_MARKER}, Q{!CORE_MARKER}, Q{Int}, Q{&CORE-SETTING-REV}, From 7668301dd60bffb1e3e6d180ecbfc1c4a476c260 Mon Sep 17 00:00:00 2001 From: Elizabeth Mattijsen Date: Fri, 12 Jul 2019 14:10:30 +0200 Subject: [PATCH 060/160] Further refine test for showing message - prompted by R#3046 - only show message if nothing has been said on $*OUT or $*ERR --- src/core/Main.pm6 | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/src/core/Main.pm6 b/src/core/Main.pm6 index d574c2cc5c0..0352faab43c 100644 --- a/src/core/Main.pm6 +++ b/src/core/Main.pm6 @@ -295,8 +295,10 @@ my sub RUN-MAIN(&main, $mainline, :$in-as-argsfiles) { if $*IN.t && $*OUT.t && $*ERR.t && !@*ARGS { $*IN does role { sub from-stdin($doing --> Nil) { - note "$doing from your keyboard, which is usually only done when debugging."; - note "Please provide input and press Ctrl-d when done, or press Ctrl-c to abort."; + unless $*OUT.tell || $*ERR.tell { + note "$doing from your keyboard, which is usually only done when debugging."; + note "Please provide input and press Ctrl-d when done, or press Ctrl-c to abort."; + } } method slurp() { from-stdin("Slurping text"); nextsame } From f13ac2c03630ad0b56658f29c722fd8f2a45409c Mon Sep 17 00:00:00 2001 From: Stefan Seifert Date: Fri, 12 Jul 2019 17:53:59 +0200 Subject: [PATCH 061/160] Fix "Missing serialize REPR function for REPR NativeRef (StrLexRef)" ASN::META parses a definition with a grammar and creates classes and methods from the parsed description. This leads to a StrLexRef getting used as a method name which ends up in the serialization context. Decont the names of added methods to ensure we have a plain old string. Fixes GH #3045 --- src/Perl6/Metamodel/MethodContainer.nqp | 1 + src/Perl6/Metamodel/PrivateMethodContainer.nqp | 1 + 2 files changed, 2 insertions(+) diff --git a/src/Perl6/Metamodel/MethodContainer.nqp b/src/Perl6/Metamodel/MethodContainer.nqp index 6e5765ffd06..69bc63a196e 100644 --- a/src/Perl6/Metamodel/MethodContainer.nqp +++ b/src/Perl6/Metamodel/MethodContainer.nqp @@ -17,6 +17,7 @@ role Perl6::Metamodel::MethodContainer { method add_method($obj, $name, $code_obj) { # Ensure we haven't already got it. $code_obj := nqp::decont($code_obj); + $name := nqp::decont_s($name); if nqp::existskey(%!methods, $name) || nqp::existskey(%!submethods, $name) { nqp::die("Package '" ~ self.name($obj) diff --git a/src/Perl6/Metamodel/PrivateMethodContainer.nqp b/src/Perl6/Metamodel/PrivateMethodContainer.nqp index 7fbdf822d49..e43886ab518 100644 --- a/src/Perl6/Metamodel/PrivateMethodContainer.nqp +++ b/src/Perl6/Metamodel/PrivateMethodContainer.nqp @@ -5,6 +5,7 @@ role Perl6::Metamodel::PrivateMethodContainer { # Adds a private method. method add_private_method($obj, $name, $code) { + $name := nqp::decont_s($name); if nqp::existskey(%!private_methods, $name) { nqp::die("Private method '$name' already declared in package " ~ self.name($obj)); From 600ece3b7e1b0552272c066763032bc8c516296b Mon Sep 17 00:00:00 2001 From: Stefan Seifert Date: Fri, 12 Jul 2019 17:53:59 +0200 Subject: [PATCH 062/160] Fix "Missing serialize REPR function for REPR NativeRef (StrLexRef)" ASN::META parses a definition with a grammar and creates classes and methods from the parsed description. This leads to a StrLexRef getting used as a method name which ends up in the serialization context. Decont the names of added methods to ensure we have a plain old string. Fixes GH #3045 --- src/Perl6/Metamodel/MethodContainer.nqp | 1 + src/Perl6/Metamodel/PrivateMethodContainer.nqp | 1 + 2 files changed, 2 insertions(+) diff --git a/src/Perl6/Metamodel/MethodContainer.nqp b/src/Perl6/Metamodel/MethodContainer.nqp index 6e5765ffd06..69bc63a196e 100644 --- a/src/Perl6/Metamodel/MethodContainer.nqp +++ b/src/Perl6/Metamodel/MethodContainer.nqp @@ -17,6 +17,7 @@ role Perl6::Metamodel::MethodContainer { method add_method($obj, $name, $code_obj) { # Ensure we haven't already got it. $code_obj := nqp::decont($code_obj); + $name := nqp::decont_s($name); if nqp::existskey(%!methods, $name) || nqp::existskey(%!submethods, $name) { nqp::die("Package '" ~ self.name($obj) diff --git a/src/Perl6/Metamodel/PrivateMethodContainer.nqp b/src/Perl6/Metamodel/PrivateMethodContainer.nqp index 7fbdf822d49..e43886ab518 100644 --- a/src/Perl6/Metamodel/PrivateMethodContainer.nqp +++ b/src/Perl6/Metamodel/PrivateMethodContainer.nqp @@ -5,6 +5,7 @@ role Perl6::Metamodel::PrivateMethodContainer { # Adds a private method. method add_private_method($obj, $name, $code) { + $name := nqp::decont_s($name); if nqp::existskey(%!private_methods, $name) { nqp::die("Private method '$name' already declared in package " ~ self.name($obj)); From 8aea1a68c74e4f93cc29ce224a79de1655cb1f4b Mon Sep 17 00:00:00 2001 From: Aleks-Daniel Jakimenko-Aleksejev Date: Fri, 12 Jul 2019 19:42:09 +0300 Subject: [PATCH 063/160] Revert "Warn when reading from keyboard in a MAIN-powered script" This reverts commits: * 3060d1d0bd7e902d8ee501667df456b99dec2748 * ad8b5a649755abfe8290a5d77f4f53ecfc91df49 There is a clear problem that these commits attempt to solve, but we should be a bit more careful when implementing heuristics like this. The discussion about this will continue in the problem-solving repo (which didn't really exist when this change was implemented). Resolves GH-3046. --- src/core/Main.pm6 | 14 -------------- 1 file changed, 14 deletions(-) diff --git a/src/core/Main.pm6 b/src/core/Main.pm6 index d574c2cc5c0..58a8ccdb2a7 100644 --- a/src/core/Main.pm6 +++ b/src/core/Main.pm6 @@ -291,20 +291,6 @@ my sub RUN-MAIN(&main, $mainline, :$in-as-argsfiles) { Capture.new( :list($capture.list), :%hash) } - # there's a person doing this and no args, so spike slurp/lines/words - if $*IN.t && $*OUT.t && $*ERR.t && !@*ARGS { - $*IN does role { - sub from-stdin($doing --> Nil) { - note "$doing from your keyboard, which is usually only done when debugging."; - note "Please provide input and press Ctrl-d when done, or press Ctrl-c to abort."; - } - - method slurp() { from-stdin("Slurping text"); nextsame } - method lines() { from-stdin("Reading lines"); nextsame } - method words() { from-stdin("Reading words"); nextsame } - } - } - # set up other new style dynamic variables my &*ARGS-TO-CAPTURE := &default-args-to-capture; my &*GENERATE-USAGE := &default-generate-usage; From 33844cb4bec35b0f12bb280bd5ba760aeca7f79a Mon Sep 17 00:00:00 2001 From: Vadim Belman Date: Fri, 12 Jul 2019 19:18:52 -0400 Subject: [PATCH 064/160] Move VERSION file back to the root of build directory This would simplify life for some infrastructure scripts. Following the discussion here: https://colabti.org/irclogger/irclogger_log/perl6-dev?date=2019-07-11#l47 --- tools/templates/VERSION => VERSION | 0 tools/lib/NQP/Config/Rakudo.pm | 2 +- 2 files changed, 1 insertion(+), 1 deletion(-) rename tools/templates/VERSION => VERSION (100%) diff --git a/tools/templates/VERSION b/VERSION similarity index 100% rename from tools/templates/VERSION rename to VERSION diff --git a/tools/lib/NQP/Config/Rakudo.pm b/tools/lib/NQP/Config/Rakudo.pm index 90ee2a38846..319922c450a 100644 --- a/tools/lib/NQP/Config/Rakudo.pm +++ b/tools/lib/NQP/Config/Rakudo.pm @@ -241,7 +241,7 @@ sub configure_misc { #]; # Get version info from VERSION template and git. - my $VERSION = slurp( $self->template_file_path( 'VERSION', required => 1, ) ); + my $VERSION = slurp( File::Spec->catfile( $self->cfg('base_dir'), 'VERSION') ); chomp $VERSION; @{$config}{qw} = split( ' ', $VERSION, 3 ); From c5476bd275d8166e6d3883a36dcff06648cb4eb0 Mon Sep 17 00:00:00 2001 From: Vadim Belman Date: Fri, 12 Jul 2019 20:14:37 -0400 Subject: [PATCH 065/160] Don't guess caller's context. throws-like used a chain of `CALLER::` to retrieve it's caller context. That was too much call-chain dependant. For other subs calling throws-like it is recommended to use $*THROWS-LIKE-CONTEXT to provide correct caller context. --- lib/Test.pm6 | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/lib/Test.pm6 b/lib/Test.pm6 index 070fb06ff40..7286c4f33b7 100644 --- a/lib/Test.pm6 +++ b/lib/Test.pm6 @@ -602,6 +602,7 @@ multi sub is-deeply(Mu $got, Mu $expected, $reason = '') is export { } sub throws-like($code, $ex_type, $reason?, *%matcher) is export { + my $caller-context = $*THROWS-LIKE-CONTEXT // CALLER::; # Don't guess our caller context, know it! subtest { plan 2 + %matcher.keys.elems; my $msg; @@ -610,7 +611,7 @@ sub throws-like($code, $ex_type, $reason?, *%matcher) is export { $code() } else { $msg = "'$code' died"; - EVAL $code, context => CALLER::CALLER::CALLER::CALLER::CALLER::; + EVAL $code, context => $caller-context; } flunk $msg; skip 'Code did not die, can not check exception', 1 + %matcher.elems; @@ -643,6 +644,7 @@ sub throws-like($code, $ex_type, $reason?, *%matcher) is export { sub fails-like ( \test where Callable:D|Str:D, $ex-type, $reason?, *%matcher ) is export { + my $*THROWS-LIKE-CONTEXT = CALLER::; subtest sub { plan 2; CATCH { default { From fd9b826f1ceffe9cf5a137a00ddba9b61ff5454e Mon Sep 17 00:00:00 2001 From: Vadim Belman Date: Fri, 12 Jul 2019 20:34:27 -0400 Subject: [PATCH 066/160] Don't fail if $!source isn't defined in X::Numeric::CannotConvert $!source could be a type object, so do the same as we do for $!target. --- src/core/Exception.pm6 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/core/Exception.pm6 b/src/core/Exception.pm6 index 9c96594a04b..5052ba6e058 100644 --- a/src/core/Exception.pm6 +++ b/src/core/Exception.pm6 @@ -2551,7 +2551,7 @@ my class X::Numeric::CannotConvert is Exception { has $.source; method message() { - "Cannot convert $!source to {$!target // $!target.perl}: $!reason"; + "Cannot convert {$!source // $!source.perl} to {$!target // $!target.perl}: $!reason"; } } From 96456b6e7ecf868b66467dbce50a6e11ee58c65a Mon Sep 17 00:00:00 2001 From: Vadim Belman Date: Fri, 12 Jul 2019 22:23:11 -0400 Subject: [PATCH 067/160] Failure now first checks for existance of $! symbol Also use CALLER::LEXICAL:: to conform with 'die'. --- src/core/Failure.pm6 | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/src/core/Failure.pm6 b/src/core/Failure.pm6 index 2fb0030bd44..ffc7f7c542f 100644 --- a/src/core/Failure.pm6 +++ b/src/core/Failure.pm6 @@ -9,15 +9,15 @@ my class Failure is Nil { #?endif method !SET-SELF($!exception) { - $!backtrace = $!exception.backtrace || Backtrace.new(5); + $!backtrace = $!exception.backtrace || Backtrace.new(3); $!exception.reset-backtrace; self } multi method new(Failure:D:) { self!throw } multi method new(Failure:U:) { - my $stash := CALLER::; - my $payload = $stash<$!>.DEFINITE ?? $stash<$!> !! "Failed"; + my $stash := CALLER::LEXICAL::; + my $payload = ($stash<$!>:exists && $stash<$!>.DEFINITE) ?? $stash<$!> !! "Failed"; nqp::create(self)!SET-SELF( $payload ~~ Exception ?? $payload !! X::AdHoc.new(:$payload) ) @@ -120,8 +120,8 @@ my class Failure is Nil { proto sub fail(|) {*}; multi sub fail(--> Nil) { - my $stash := CALLER::; - my $payload = $stash<$!>.DEFINITE ?? $stash<$!> !! "Failed"; + my $stash := CALLER::LEXICAL::; + my $payload = ($stash<$!>:exists && $stash<$!>.DEFINITE) ?? $stash<$!> !! "Failed"; my $fail := Failure.new( $payload ~~ Exception ?? $payload !! X::AdHoc.new(:$payload)); From 441b8c65848978f13e270fbba794573abec183de Mon Sep 17 00:00:00 2001 From: Vadim Belman Date: Sat, 13 Jul 2019 21:29:22 -0400 Subject: [PATCH 068/160] Replace EVAL with is-run for language-revision tests PR rakudo/rakudo#3040 disables EVAL's ability to change language version inside an evaluated code. The only legitimate way now is to run the code externally. --- t/02-rakudo/99-misc.t | 13 ++++--------- 1 file changed, 4 insertions(+), 9 deletions(-) diff --git a/t/02-rakudo/99-misc.t b/t/02-rakudo/99-misc.t index 1265d5dcb22..b14324f5443 100644 --- a/t/02-rakudo/99-misc.t +++ b/t/02-rakudo/99-misc.t @@ -6,15 +6,10 @@ plan 10; subtest '.lang-ver-before method on Perl6::World' => { plan 5; - skip "use v6.X is currently unsupported by EVAL", 4; - if False { - ok ｢use v6.c; BEGIN $*W.lang-ver-before: 'd'｣.EVAL, 'c is before d'; - nok ｢use v6.c; BEGIN $*W.lang-ver-before: 'c'｣.EVAL, 'c is not before d'; - nok ｢use v6.e.PREVIEW; BEGIN $*W.lang-ver-before: 'e'｣.EVAL, - 'e.PREVIEW is not before e'; - nok ｢use v6.e.PREVIEW; BEGIN $*W.lang-ver-before: 'd'｣.EVAL, - 'e is not before d'; - } + is-run ｢use v6.c; BEGIN print ?$*W.lang-ver-before: 'd'｣, 'c is before d', :out; + is-run ｢use v6.c; BEGIN print ?$*W.lang-ver-before: 'c'｣, 'c is not before d', :out; + is-run ｢use v6.e.PREVIEW; BEGIN print ?$*W.lang-ver-before: 'e'｣, 'e.PREVIEW is not before e', :out; + is-run ｢use v6.e.PREVIEW; BEGIN print ?$*W.lang-ver-before: 'd'｣, 'e is not before d', :out; throws-like ｢BEGIN $*W.lang-ver-before: <6.d>｣, Exception, :self{.exception.message.contains: 'must be 1 char long'}, 'using wrong version format as argument throws'; From 4c10373b874a79c8bfb14c8808c1b41e4a0cef30 Mon Sep 17 00:00:00 2001 From: Vadim Belman Date: Sun, 14 Jul 2019 21:04:24 -0400 Subject: [PATCH 069/160] Protect class Perl version method with Lock Make it thread-safe, as noticed by Jonathan: https://github.com/rakudo/rakudo/commit/65207879172e6203dde3b40d2b8eb75d8e7c7978#r34296824 --- src/core/Perl.pm6 | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) diff --git a/src/core/Perl.pm6 b/src/core/Perl.pm6 index 3cfaa7acd69..71aeb9c22a0 100644 --- a/src/core/Perl.pm6 +++ b/src/core/Perl.pm6 @@ -15,9 +15,12 @@ class Perl does Systemic { method KERNELnames { } my %version-cache; + my Lock $version-cache-lock .= new; method version { - my $comp-ver = nqp::p6box_s(nqp::getcomp('perl6').language_version()); - %version-cache{$comp-ver} //= Version.new($comp-ver); + $version-cache-lock.protect: { + my $comp-ver = nqp::p6box_s(nqp::getcomp('perl6').language_version()); + %version-cache{$comp-ver} //= Version.new($comp-ver); + } } } From b1cb2b040aa60c1cd02e34be7aabd0f036e1edb2 Mon Sep 17 00:00:00 2001 From: Aleks-Daniel Jakimenko-Aleksejev Date: Mon, 15 Jul 2019 17:30:05 +0300 Subject: [PATCH 070/160] Revert "Made all operators in Real require definite objects" This reverts commit d8ad62249ae0e2eca954a1cc92d62accbb9078ad. Resolves GH-3051. --- src/core/Real.pm6 | 36 ++++++++++++++++++------------------ t/05-messages/02-errors.t | 33 ++++++++++++++------------------- 2 files changed, 32 insertions(+), 37 deletions(-) diff --git a/src/core/Real.pm6 b/src/core/Real.pm6 index ef76949b1b4..c341649893f 100644 --- a/src/core/Real.pm6 +++ b/src/core/Real.pm6 @@ -132,42 +132,42 @@ my role Real does Numeric { } proto sub cis($, *%) {*} -multi sub cis(Real:D $a) { $a.cis } +multi sub cis(Real $a) { $a.cis } -multi sub infix:<+>(Real:D \a, Real:D \b) { a.Bridge + b.Bridge } +multi sub infix:<+>(Real \a, Real \b) { a.Bridge + b.Bridge } -multi sub infix:<->(Real:D \a, Real:D \b) { a.Bridge - b.Bridge } +multi sub infix:<->(Real \a, Real \b) { a.Bridge - b.Bridge } -multi sub infix:<*>(Real:D \a, Real:D \b) { a.Bridge * b.Bridge } +multi sub infix:<*>(Real \a, Real \b) { a.Bridge * b.Bridge } -multi sub infix:(Real:D \a, Real:D \b) { a.Bridge / b.Bridge } +multi sub infix:(Real \a, Real \b) { a.Bridge / b.Bridge } -multi sub infix:<%>(Real:D \a, Real:D \b) { a.Bridge % b.Bridge } +multi sub infix:<%>(Real \a, Real \b) { a.Bridge % b.Bridge } -multi sub infix:<**>(Real:D \a, Real:D \b) { a.Bridge ** b.Bridge } +multi sub infix:<**>(Real \a, Real \b) { a.Bridge ** b.Bridge } -multi sub infix:«<=>»(Real:D \a, Real:D \b) { a.Bridge <=> b.Bridge } +multi sub infix:«<=>»(Real \a, Real \b) { a.Bridge <=> b.Bridge } -multi sub infix:<==>(Real:D \a, Real:D \b) { a.Bridge == b.Bridge } +multi sub infix:<==>(Real \a, Real \b) { a.Bridge == b.Bridge } -multi sub infix:«<»(Real:D \a, Real:D \b) { a.Bridge < b.Bridge } +multi sub infix:«<»(Real \a, Real \b) { a.Bridge < b.Bridge } -multi sub infix:«<=»(Real:D \a, Real:D \b) { a.Bridge <= b.Bridge } +multi sub infix:«<=»(Real \a, Real \b) { a.Bridge <= b.Bridge } -multi sub infix:«>»(Real:D \a, Real:D \b) { a.Bridge > b.Bridge } +multi sub infix:«>»(Real \a, Real \b) { a.Bridge > b.Bridge } -multi sub infix:«>=»(Real:D \a, Real:D \b) { a.Bridge >= b.Bridge } +multi sub infix:«>=»(Real \a, Real \b) { a.Bridge >= b.Bridge } multi sub prefix:<->(Real:D \a) { -a.Bridge } # NOTE: According to the spec, infix: is "Not coercive, # so fails on differing types." Thus no casts here. proto sub infix:($, $, *%) is pure {*} -multi sub infix:(Real:D $a, Real:D $b) { +multi sub infix:(Real $a, Real $b) { $a - ($a div $b) * $b; } -multi sub abs(Real:D \a) { +multi sub abs(Real \a) { a < 0 ?? -a !! a; } @@ -177,13 +177,13 @@ multi sub truncate(Cool:D $x) { $x.Numeric.truncate } proto sub atan2($, $?, *%) {*} -multi sub atan2(Real:D \a, Real:D \b = 1e0) { a.Bridge.atan2(b.Bridge) } +multi sub atan2(Real \a, Real \b = 1e0) { a.Bridge.atan2(b.Bridge) } # should really be (Cool, Cool), and then (Cool, Real) and (Real, Cool) # candidates, but since Int both conforms to Cool and Real, we'd get lots # of ambiguous dispatches. So just go with (Any, Any) for now. -multi sub atan2(Any:D \a, Any:D \b = 1e0) { a.Numeric.atan2(b.Numeric) } +multi sub atan2( \a, \b = 1e0) { a.Numeric.atan2(b.Numeric) } proto sub unpolar($, $, *%) {*} -multi sub unpolar(Real:D $mag, Real:D $angle) { $mag.unpolar($angle) } +multi sub unpolar(Real $mag, Real $angle) { $mag.unpolar($angle) } # vim: ft=perl6 expandtab sw=4 diff --git a/t/05-messages/02-errors.t b/t/05-messages/02-errors.t index 65768d639d8..642916a6dc2 100644 --- a/t/05-messages/02-errors.t +++ b/t/05-messages/02-errors.t @@ -211,52 +211,47 @@ throws-like ｢Set.new(1..300)<42> = 42｣, subtest 'cannot use Int type object as an operand' => { plan 14; - CONTROL { - when CX::Warn { - die $_ - } - } throws-like ｢(1/1)+Int｣, - CX::Warn, + X::Parameter::InvalidConcreteness, 'A Rational instance cannot be added by an Int type object'; throws-like ｢Int+(1/1)｣, - CX::Warn, + X::Parameter::InvalidConcreteness, 'An Int type object cannot be added by a Rational instance'; throws-like ｢(1/1)-Int｣, - CX::Warn, + X::Parameter::InvalidConcreteness, 'A Rational instance cannot be subtracted by an Int type object'; throws-like ｢Int-(1/1)｣, - CX::Warn, + X::Parameter::InvalidConcreteness, 'An Int type object cannot be subtracted by a Rational instance'; throws-like ｢(1/1)*Int｣, - CX::Warn, + X::Parameter::InvalidConcreteness, 'A Rational instance cannot be multiplied by an Int type object'; throws-like ｢Int*(1/1)｣, - CX::Warn, + X::Parameter::InvalidConcreteness, 'An Int type object cannot be multiplied by a Rational instance'; throws-like ｢(1/1)/Int｣, - CX::Warn, + X::Parameter::InvalidConcreteness, 'A Rational instance cannot be divided by an Int type object'; throws-like ｢Int/(1/1)｣, - CX::Warn, + X::Parameter::InvalidConcreteness, 'An Int type object cannot be divided by a Rational instance'; throws-like ｢Int/Int｣, - CX::Warn, + X::Parameter::InvalidConcreteness, 'An Int type object cannot be divided by an Int type object'; throws-like ｢Int/1｣, - CX::Warn, + X::Parameter::InvalidConcreteness, 'An Int type object cannot be divided by an Int instance'; throws-like ｢1/Int｣, - CX::Warn, + X::Parameter::InvalidConcreteness, 'An Int instance cannot be divided by an Int type object'; throws-like ｢(1/1)%Int｣, - CX::Warn, + X::Parameter::InvalidConcreteness, 'A Rational instance modulo an Int type object is incalculable'; throws-like ｢Int%(1/1)｣, - CX::Warn, + X::Parameter::InvalidConcreteness, 'An Int type object modulo a Rational instance is incalculable'; throws-like ｢(1/1)**Int｣, - CX::Warn, + X::Parameter::InvalidConcreteness, 'A Rational instance cannot be powered by an Int type object'; } From a67ba0c09f8acf4252074853fcaa5a2df9029a7d Mon Sep 17 00:00:00 2001 From: Vadim Belman Date: Fri, 12 Jul 2019 19:18:52 -0400 Subject: [PATCH 071/160] Move VERSION file back to the root of build directory This would simplify life for some infrastructure scripts. Following the discussion here: https://colabti.org/irclogger/irclogger_log/perl6-dev?date=2019-07-11#l47 --- tools/templates/VERSION => VERSION | 0 tools/lib/NQP/Config/Rakudo.pm | 2 +- 2 files changed, 1 insertion(+), 1 deletion(-) rename tools/templates/VERSION => VERSION (100%) diff --git a/tools/templates/VERSION b/VERSION similarity index 100% rename from tools/templates/VERSION rename to VERSION diff --git a/tools/lib/NQP/Config/Rakudo.pm b/tools/lib/NQP/Config/Rakudo.pm index 90ee2a38846..319922c450a 100644 --- a/tools/lib/NQP/Config/Rakudo.pm +++ b/tools/lib/NQP/Config/Rakudo.pm @@ -241,7 +241,7 @@ sub configure_misc { #]; # Get version info from VERSION template and git. - my $VERSION = slurp( $self->template_file_path( 'VERSION', required => 1, ) ); + my $VERSION = slurp( File::Spec->catfile( $self->cfg('base_dir'), 'VERSION') ); chomp $VERSION; @{$config}{qw} = split( ' ', $VERSION, 3 ); From 63a4d958eecacb9c1bb880eb019a4a4af906ad67 Mon Sep 17 00:00:00 2001 From: Aleks-Daniel Jakimenko-Aleksejev Date: Mon, 15 Jul 2019 20:26:46 +0300 Subject: [PATCH 072/160] [NQP Bump] Brings 2 commits NQP bump brought: https://github.com/perl6/nqp/compare/2019.03-273-gebe9672a7...2019.03-275-g88592344d 88592344d [MoarVM Bump] Brings 15 commits fd8a7e5f9 fix profiling gc/deallocations bug swapping thread/seqnum --- tools/templates/NQP_REVISION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tools/templates/NQP_REVISION b/tools/templates/NQP_REVISION index 7fe6419a3b0..67d15930023 100644 --- a/tools/templates/NQP_REVISION +++ b/tools/templates/NQP_REVISION @@ -1 +1 @@ -2019.03-273-gebe9672a7 +2019.03-275-g88592344d From be118c7863f635bbb2f5b5fab93cf417a61ca6e9 Mon Sep 17 00:00:00 2001 From: Aleks-Daniel Jakimenko-Aleksejev Date: Tue, 16 Jul 2019 04:39:26 +0300 Subject: [PATCH 073/160] Link Sakefile from the release guide --- docs/release_guide.pod | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/docs/release_guide.pod b/docs/release_guide.pod index 5a4c95a4ca1..ea4191fc260 100644 --- a/docs/release_guide.pod +++ b/docs/release_guide.pod @@ -33,7 +33,8 @@ Currently there are two tools: =over =item * -Release Sakefile (not published yet) which is meant to be used together with +L +which is meant to be used together with L bot =item * From 0e82bf3acb02846c7e634b46183ced58812eb168 Mon Sep 17 00:00:00 2001 From: Vadim Belman Date: Mon, 15 Jul 2019 22:52:00 -0400 Subject: [PATCH 074/160] Re-implement CORE loading sequence PR #3040 wasn't a complete fix to the new symbols issue. Compile-time symbols were still fetched from CORE.setting by the compiler and installed as if no other settins existed. This fix postponed CORE binding to the $*UNIT_OUTER until lang-version token is parsed. For symbols required to pass this stage (like Version class) a new method on World find_symbol_in_setting tries to load appropriate CORE and fetch the requested symbol directly. Until CORE is bound to $*UNIT_OUTER the unit is not considered ready. --- src/Perl6/Actions.nqp | 2 - src/Perl6/Grammar.nqp | 2 +- src/Perl6/World.nqp | 297 ++++++++------- src/core.d/core_prologue.pm6 | 4 +- src/core.e/PseudoStash.pm6 | 515 +++++++++++++++++++++++++++ src/core.e/core_prologue.pm6 | 4 +- src/core/PseudoStash.pm6 | 387 ++++---------------- src/core/core_prologue.pm6 | 4 +- t/08-performance/03-corekeys.t | 2 +- t/08-performance/04-settingkeys.t | 2 +- tools/templates/6.e/rev_core_sources | 1 + 11 files changed, 778 insertions(+), 442 deletions(-) create mode 100644 src/core.e/PseudoStash.pm6 diff --git a/src/Perl6/Actions.nqp b/src/Perl6/Actions.nqp index 6e86be87b84..299683e4fc7 100644 --- a/src/Perl6/Actions.nqp +++ b/src/Perl6/Actions.nqp @@ -1288,8 +1288,6 @@ class Perl6::Actions is HLL::Actions does STDActions { $*W.add_phasers_handling_code($*DECLARAND, $*UNIT); } - $*W.prep_comp_unit($/); - # Get the block for the unit mainline code. my $unit := $*UNIT; my $mainline := QAST::Stmts.new( diff --git a/src/Perl6/Grammar.nqp b/src/Perl6/Grammar.nqp index 062eadeeed9..151d168a94e 100644 --- a/src/Perl6/Grammar.nqp +++ b/src/Perl6/Grammar.nqp @@ -826,7 +826,7 @@ grammar Perl6::Grammar is HLL::Grammar does STD { } <.bom>? - + { $*W.prep_comp_unit($/) } <.finishpad> diff --git a/src/Perl6/World.nqp b/src/Perl6/World.nqp index 4b62405ba56..ee69b9d13eb 100644 --- a/src/Perl6/World.nqp +++ b/src/Perl6/World.nqp @@ -181,8 +181,6 @@ sub levenshtein_candidate_heuristic(@candidates, $target) { # This builds upon the HLL::World to add the specifics needed by Rakudo Perl 6. class Perl6::World is HLL::World { - has $!setting_fixup_task; - my class Perl6CompilationContext is HLL::World::CompilationContext { # The stack of lexical pads, actually as QAST::Block objects. The # outermost frame is at the bottom, the latest frame is on top. @@ -514,10 +512,18 @@ class Perl6::World is HLL::World { has %!quote_lang_cache; + # To temporarily keep fixup task QAST. + has $!setting_fixup_task; + + has int $!unit_ready; + has int $!have_outer; + has $!setting_name; + method BUILD(*%adv) { %!code_object_fixup_list := {}; $!record_precompilation_dependencies := 1; %!quote_lang_cache := {}; + $!unit_ready := 0; } method create_nested() { @@ -589,12 +595,14 @@ class Perl6::World is HLL::World { if $revision eq 'c' { $*CAN_LOWER_TOPIC := 0; # CORE.c is currently our lowest core, which we don't "load" + $!setting_name := 'CORE'; return; } # Speed up loading assuming that the default language version would be the most used one. if $lang_ver eq $comp.config { - self.load_setting: $ver-match, 'CORE.' ~ $revision; + $!setting_name := 'CORE.' ~ $revision; + # self.load_setting: $ver-match, 'CORE.' ~ $revision; return; } } @@ -631,7 +639,8 @@ class Perl6::World is HLL::World { # CORE.c is our lowest core, which we don't "load" } else { - self.load_setting: $ver-match, 'CORE.' ~ $can_rev + $!setting_name := 'CORE.' ~ $can_rev; + # self.load_setting: $ver-match, 'CORE.' ~ $can_rev; } return; } @@ -653,142 +662,31 @@ class Perl6::World is HLL::World { } method loading_and_symbol_setup($/) { - my $setting_name; # Create unit outer (where we assemble any lexicals accumulated # from e.g. REPL) and the real UNIT. $*UNIT_OUTER := self.push_lexpad($/); $*UNIT := self.push_lexpad($/); - my $in_eval := 0; # If we already have a specified outer context, then that's # our setting. Otherwise, load one. - my $have_outer := nqp::defined(%*COMPILING<%?OPTIONS>); - if $have_outer { - $setting_name := ''; + $!have_outer := nqp::defined(%*COMPILING<%?OPTIONS>); + my $default_setting_name := 'CORE.' ~ nqp::substr(nqp::getcomp('perl6').language_version, 2, 1); + if $!have_outer { + $!setting_name := $default_setting_name; $*UNIT.annotate('IN_DECL', 'eval'); - $in_eval := 1; } else { - $setting_name := %*COMPILING<%?OPTIONS> // 'CORE'; - if nqp::eqat($setting_name, 'NULL', 0) { + $!setting_name := %*COMPILING<%?OPTIONS> // $default_setting_name; + if nqp::eqat($!setting_name, 'NULL', 0) { $*COMPILING_CORE_SETTING := 1; $*SET_DEFAULT_LANG_VER := 0; } - self.load_setting($/,$setting_name); + # self.load_setting($/,$!setting_name); $*UNIT.annotate('IN_DECL', 'mainline'); } - $/.unitstart(); - - try { - my $EXPORTHOW := self.find_symbol(['EXPORTHOW']); - for self.stash_hash($EXPORTHOW) { - $*LANG.set_how($_.key, $_.value); - } - } - - # Create GLOBAL(ish), unless we were given one. - if nqp::existskey(%*COMPILING<%?OPTIONS>, 'global') { - $*GLOBALish := %*COMPILING<%?OPTIONS>; - } - elsif $have_outer && $*UNIT_OUTER.symbol('GLOBALish') { - $*GLOBALish := - self.force_value($*UNIT_OUTER.symbol('GLOBALish'),'GLOBALish',1); - } - else { - $*GLOBALish := - self.pkg_create_mo($/,$/.how('package'),:name('GLOBAL')); - self.pkg_compose($/, $*GLOBALish); - } - - # Create or pull in existing EXPORT. - if $have_outer && $*UNIT_OUTER.symbol('EXPORT') { - $*EXPORT := - self.force_value($*UNIT_OUTER.symbol('EXPORT'), 'EXPORT', 1); - } - else { - $*EXPORT := self.pkg_create_mo($/, $/.how('package'), :name('EXPORT')); - self.pkg_compose($/, $*EXPORT); - } - - # If there's a self in scope, set $*HAS_SELF. - if $have_outer && $*UNIT_OUTER.symbol('self') { - $*HAS_SELF := 'complete'; - } - - # Take current package from outer context if any, otherwise for a - # fresh compilation unit we start in GLOBAL. - my $package; - if $have_outer && $*UNIT_OUTER.symbol('$?PACKAGE') { - $package := - self.force_value($*UNIT_OUTER.symbol('$?PACKAGE'),'$?PACKAGE',1); - } - else { - $package := $*GLOBALish; - } - $*PACKAGE := $package; - $/.set_package($package); + # $/.unitstart(); - # If we're eval'ing in the context of a %?LANG, set up our own - # %*LANG based on it. - if $have_outer && $*UNIT_OUTER.symbol('%?LANG') { - for self.force_value( - $*UNIT_OUTER.symbol('%?LANG'), '%?LANG', 1).FLATTENABLE_HASH() { - %*LANG{$_.key} := $_.value; - } - } - if $have_outer && $*UNIT_OUTER.symbol('$*MAIN') { - $*MAIN := - self.force_value($*UNIT_OUTER.symbol('$*MAIN'), '$*MAIN', 1); - } - if $have_outer && $*UNIT_OUTER.symbol('$?STRICT') { - $*STRICT := - self.force_value($*UNIT_OUTER.symbol('$*STRICT'), '$*STRICT', 1); - } - else { - $*STRICT := 1; - } - - # Bootstrap - if $setting_name eq 'NULL' { - my $name := "Perl6::BOOTSTRAP"; - my $module := self.load_module_early($/, $name, $*GLOBALish); - my $EXPORT := $module.WHO; - my @to_import := ['MANDATORY', 'DEFAULT']; - for @to_import -> $tag { - if nqp::existskey($EXPORT, $tag) { - self.import($/, self.stash_hash($EXPORT{$tag}), $name); - } - } - for $module.WHO { - my str $key := $_.key; - $*LANG.set_how($key, nqp::decont($_.value)); - } - } - - # Install as we've no setting, in which case we've likely no - # static lexpad class yet either. Also, UNIT needs a code object. - else { - self.install_lexical_symbol($*UNIT, 'GLOBALish', $*GLOBALish); - self.install_lexical_symbol($*UNIT, 'EXPORT', $*EXPORT); - self.install_lexical_symbol($*UNIT, '$?PACKAGE', $package); - self.install_lexical_symbol($*UNIT, '::?PACKAGE', $package); - $*CODE_OBJECT := $*DECLARAND := self.stub_code_object('Block'); - - unless $in_eval { - self.install_lexical_symbol( - $*UNIT,'$=finish',self.find_symbol(['Mu'], :setting-only)); - } - } - - unless $in_eval { - my $M := %*COMPILING<%?OPTIONS>; - if nqp::defined($M) { - for nqp::islist($M) ?? $M !! [$M] -> $longname { - self.do_pragma_or_load_module($/,1,$longname); - } - } - } } method add_unit_marker($/, $name) { @@ -913,6 +811,122 @@ class Perl6::World is HLL::World { } method prep_comp_unit ($/) { + unless $!have_outer { + self.load_setting($/, $!setting_name); + } + $/.unitstart(); + $!unit_ready := 1; + + try { + my $EXPORTHOW := self.find_symbol(['EXPORTHOW']); + for self.stash_hash($EXPORTHOW) { + $*LANG.set_how($_.key, $_.value); + } + } + + # Create GLOBAL(ish), unless we were given one. + if nqp::existskey(%*COMPILING<%?OPTIONS>, 'global') { + $*GLOBALish := %*COMPILING<%?OPTIONS>; + } + elsif $!have_outer && $*UNIT_OUTER.symbol('GLOBALish') { + $*GLOBALish := + self.force_value($*UNIT_OUTER.symbol('GLOBALish'),'GLOBALish',1); + } + else { + $*GLOBALish := + self.pkg_create_mo($/,$/.how('package'),:name('GLOBAL')); + self.pkg_compose($/, $*GLOBALish); + } + + # Create or pull in existing EXPORT. + if $!have_outer && $*UNIT_OUTER.symbol('EXPORT') { + $*EXPORT := + self.force_value($*UNIT_OUTER.symbol('EXPORT'), 'EXPORT', 1); + } + else { + $*EXPORT := self.pkg_create_mo($/, $/.how('package'), :name('EXPORT')); + self.pkg_compose($/, $*EXPORT); + } + + # If there's a self in scope, set $*HAS_SELF. + if $!have_outer && $*UNIT_OUTER.symbol('self') { + $*HAS_SELF := 'complete'; + } + + # Take current package from outer context if any, otherwise for a + # fresh compilation unit we start in GLOBAL. + my $package; + if $!have_outer && $*UNIT_OUTER.symbol('$?PACKAGE') { + $package := + self.force_value($*UNIT_OUTER.symbol('$?PACKAGE'),'$?PACKAGE',1); + } + else { + $package := $*GLOBALish; + } + $*PACKAGE := $package; + $/.set_package($package); + + # If we're eval'ing in the context of a %?LANG, set up our own + # %*LANG based on it. + if $!have_outer && $*UNIT_OUTER.symbol('%?LANG') { + for self.force_value( + $*UNIT_OUTER.symbol('%?LANG'), '%?LANG', 1).FLATTENABLE_HASH() { + %*LANG{$_.key} := $_.value; + } + } + if $!have_outer && $*UNIT_OUTER.symbol('$*MAIN') { + $*MAIN := + self.force_value($*UNIT_OUTER.symbol('$*MAIN'), '$*MAIN', 1); + } + if $!have_outer && $*UNIT_OUTER.symbol('$?STRICT') { + $*STRICT := + self.force_value($*UNIT_OUTER.symbol('$*STRICT'), '$*STRICT', 1); + } + else { + $*STRICT := 1; + } + + # Bootstrap + if $!setting_name eq 'NULL' { + my $name := "Perl6::BOOTSTRAP"; + my $module := self.load_module_early($/, $name, $*GLOBALish); + my $EXPORT := $module.WHO; + my @to_import := ['MANDATORY', 'DEFAULT']; + for @to_import -> $tag { + if nqp::existskey($EXPORT, $tag) { + self.import($/, self.stash_hash($EXPORT{$tag}), $name); + } + } + for $module.WHO { + my str $key := $_.key; + $*LANG.set_how($key, nqp::decont($_.value)); + } + } + + # Install as we've no setting, in which case we've likely no + # static lexpad class yet either. Also, UNIT needs a code object. + else { + self.install_lexical_symbol($*UNIT, 'GLOBALish', $*GLOBALish); + self.install_lexical_symbol($*UNIT, 'EXPORT', $*EXPORT); + self.install_lexical_symbol($*UNIT, '$?PACKAGE', $package); + self.install_lexical_symbol($*UNIT, '::?PACKAGE', $package); + $*CODE_OBJECT := $*DECLARAND := self.stub_code_object('Block'); + + unless $!have_outer { + self.install_lexical_symbol( + $*UNIT,'$=finish',self.find_symbol(['Mu'], :setting-only)); + } + } + + unless $!have_outer { + my $M := %*COMPILING<%?OPTIONS>; + if nqp::defined($M) { + for nqp::islist($M) ?? $M !! [$M] -> $longname { + self.do_pragma_or_load_module($/,1,$longname); + } + } + } + self.add_load_dependency_task(:deserialize_ast($!setting_fixup_task), :fixup_ast($!setting_fixup_task)); # Checks. self.assert_stubs_defined($/); @@ -4786,6 +4800,37 @@ class Perl6::World is HLL::World { } } + method find_symbol_in_setting(@name) { + my str $fullname := nqp::join("::", @name); + my $setting_name := Perl6::ModuleLoader.transform_setting_name($!setting_name); + my $ctx := Perl6::ModuleLoader.load_setting($setting_name); + my $components := +@name; + + while $ctx { + my $pad := nqp::ctxlexpad($ctx); + if nqp::existskey($pad, @name[0]) { + my $val := nqp::atkey($pad, @name[0]); + if $components == 1 { + return $val; + } + my $i := 1; + while $i < $components { + if nqp::existskey($val.WHO, @name[$i]) { + $val := ($val.WHO){@name[$i++]}; + if $i == $components { + return $val; + } + } + else { + last; + } + } + } + $ctx := nqp::ctxouter($ctx); + } + nqp::die("Cannot find symbol $fullname in $setting_name"); + } + # Finds a symbol that has a known value at compile time from the # perspective of the current scope. Checks for lexicals, then if # that fails tries package lookup. @@ -4793,6 +4838,10 @@ class Perl6::World is HLL::World { # Make sure it's not an empty name. unless +@name { nqp::die("Cannot look up empty name"); } + unless $!unit_ready { + return self.find_symbol_in_setting(@name); + } + # GLOBAL is current view of global. if +@name == 1 && @name[0] eq 'GLOBAL' { return $*GLOBALish; @@ -5413,6 +5462,8 @@ class Perl6::World is HLL::World { } if $found_xcbt { my $xcbt := $x_comp_bt.new(exception => $p6ex, :$use-case); + note("BEGIN TIME EXCEPTION IS AT ", self.current_file, " at ", self.current_line($/)); + note("EXCEPTION: ", $p6ex.message); $xcbt.SET_FILE_LINE( nqp::box_s(self.current_file,self.find_symbol(['Str'], :setting-only)), nqp::box_i(self.current_line($/),self.find_symbol(['Int'], :setting-only)), diff --git a/src/core.d/core_prologue.pm6 b/src/core.d/core_prologue.pm6 index b924bbb41eb..70c9cebe755 100644 --- a/src/core.d/core_prologue.pm6 +++ b/src/core.d/core_prologue.pm6 @@ -1,6 +1,6 @@ use nqp; -# This sub is only to support tests. -sub CORE-SETTING-REV { 'd' }; +# This constant is only to support tests. +my constant CORE-SETTING-REV = 'd'; # vim: ft=perl6 expandtab sw=4 diff --git a/src/core.e/PseudoStash.pm6 b/src/core.e/PseudoStash.pm6 new file mode 100644 index 00000000000..ac173afce60 --- /dev/null +++ b/src/core.e/PseudoStash.pm6 @@ -0,0 +1,515 @@ +# my class X::Bind { ... } +# my class X::Caller::NotDynamic { ... } +# my class X::NoSuchSymbol { ... } + +my class PseudoStash is Map { + has Mu $!ctx; + has int $!mode; + has $!package; # Parent package, for which we serve as .WHO + + # Lookup modes. + 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 } + + my $pseudoers := nqp::hash( + 'MY', sub ($cur) { + my $stash := nqp::clone($cur); + nqp::bindattr_i($stash, PseudoStash, '$!mode', PRECISE_SCOPE); + $stash.pseudo-package('MY'); + }, + 'CORE', sub ($cur) { + my Mu $ctx := nqp::getattr(nqp::decont($cur), PseudoStash, '$!ctx'); + until nqp::isnull($ctx) || nqp::existskey(nqp::ctxlexpad($ctx), '!CORE_MARKER') { + $ctx := nqp::ctxouterskipthunks($ctx); + } + nqp::if( + nqp::isnull($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', STATIC_CHAIN), + $stash.pseudo-package('CORE') + ) + ) + }, + 'CALLER', sub ($cur) { + nqp::if( + nqp::isnull( + my Mu $ctx := nqp::ctxcallerskipthunks( + nqp::getattr(nqp::decont($cur), PseudoStash, '$!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), + $stash.pseudo-package('CALLER') + ) + ) + }, + 'OUTER', sub ($cur) is raw { + my Mu $ctx := nqp::ctxouterskipthunks( + nqp::getattr(nqp::decont($cur),PseudoStash,'$!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); + $stash.pseudo-package('OUTER') + } + }, + 'LEXICAL', sub ($cur) { + my $stash := nqp::clone($cur); + nqp::bindattr_i($stash, PseudoStash, '$!mode', STATIC_CHAIN +| DYNAMIC_CHAIN); + $stash.pseudo-package('LEXICAL') + }, + 'OUTERS', sub ($cur) { + my Mu $ctx := nqp::ctxouterskipthunks( + nqp::getattr(nqp::decont($cur), PseudoStash, '$!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); + $stash.pseudo-package('OUTERS') + } + }, + 'DYNAMIC', sub ($cur) { + my $stash := nqp::clone($cur); + nqp::bindattr_i($stash, PseudoStash, '$!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'))), + 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), + $stash.pseudo-package('CALLERS') + ) + ) + }, + 'UNIT', sub ($cur) { + my Mu $ctx := nqp::getattr(nqp::decont($cur), PseudoStash, '$!ctx'); + until nqp::isnull($ctx) || nqp::existskey(nqp::ctxlexpad($ctx), '!UNIT_MARKER') { + $ctx := nqp::ctxouterskipthunks($ctx); + } + nqp::if( + nqp::isnull($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', 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'); + until nqp::isnull($ctx) + || (nqp::existskey(nqp::ctxlexpad($ctx), '!UNIT_MARKER') + && !nqp::existskey(nqp::ctxlexpad($ctx), '!EVAL_MARKER')) { + $ctx := nqp::ctxouterskipthunks($ctx); + } + # EVAL adds two extra contexts to EVAL'ed code. + my $outers = ($ctx && nqp::existskey(nqp::ctxlexpad($ctx), '!EVAL_MARKER')) ?? 4 !! 2; + nqp::until( + (nqp::isnull($ctx) || !$outers), + nqp::stmts( + ($ctx := nqp::ctxouter($ctx)), + ($outers--) + ) + ); + nqp::if( + nqp::isnull($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', STATIC_CHAIN), + $stash.pseudo-package('SETTING') + ) + ) + }, + 'CLIENT', sub ($cur) { + my $pkg := nqp::getlexrel( + nqp::getattr(nqp::decont($cur), PseudoStash, '$!ctx'), + '$?PACKAGE'); + die "GLOBAL can have no client package" if $pkg.^name eq "GLOBAL"; + my Mu $ctx := nqp::ctxcallerskipthunks( + nqp::getattr(nqp::decont($cur), PseudoStash, '$!ctx')); + while 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); + $stash.pseudo-package('CLIENT'); + }, + 'OUR', sub ($cur) { + nqp::getlexrel( + nqp::getattr(nqp::decont($cur), PseudoStash, '$!ctx'), + '$?PACKAGE') + } + ); + + multi method AT-KEY(PseudoStash:D: Str() $key) is raw { + note("AT-KEY($key)") if %*ENV; + my Mu $val := nqp::null(); + nqp::if( + nqp::existskey($pseudoers,$key), + ($val := nqp::atkey($pseudoers,$key)(self)), + nqp::stmts( + nqp::if( # PRECISE_SCOPE is exclusive + nqp::bitand_i($!mode,PRECISE_SCOPE), + nqp::if( + nqp::existskey( + nqp::getattr(self,Map,'$!storage'),nqp::unbox_s($key)), + ($val := nqp::atkey( + nqp::getattr(self,Map,'$!storage'),nqp::unbox_s($key))) + ), + 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)), # "*" + ($val := nqp::ifnull( + nqp::getlexreldyn( + nqp::getattr(self,PseudoStash,'$!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::null() + )) + ) + ) + ), + nqp::if( + (nqp::not_i(nqp::isnull($val)) + && nqp::bitand_i($!mode,REQUIRE_DYNAMIC)), + nqp::if( + (try nqp::not_i($val.VAR.dynamic)), + ($val := Failure.new(X::Caller::NotDynamic.new(symbol => $key))) + ) + ) + ) + ); + nqp::isnull($val) + ?? Failure.new(X::NoSuchSymbol.new(symbol => $!package.^name ~ '::<' ~ $key ~ '>')) + !! $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 { + has Mu $!start-ctx; # Stash context – this is where we start from. + has Mu $!ctx; # Current context. + has int $!stash-mode; + 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_i(self, CtxWalker, '$!stash-mode', + (nqp::getattr(pseudo, PseudoStash, '$!mode') || STATIC_CHAIN) # We default to STATIC_CHAIN + ); + $!modes := nqp::list_i(PRECISE_SCOPE, DYNAMIC_CHAIN, STATIC_CHAIN); + self + } + + method new(PseudoStash:D \pseudo) { nqp::create(self)!SET-SELF(pseudo) } + + method exhausted() { nqp::isnull($!ctx) } + + method next-ctx() { + return [] if nqp::isnull($!ctx); + nqp::stmts( + (my Mu $ret-ctx := $!ctx), + (my $ret-mode := nqp::atpos_i($!modes,0)), + # Don't iterate over precise scope or when all modes has been tried. + nqp::if( + (nqp::bitand_i($!stash-mode,PRECISE_SCOPE) || (nqp::elems($!modes) == 0)), + ($!ctx := nqp::null()), + nqp::repeat_while( + (nqp::isnull($!ctx) && nqp::elems($!modes)), + nqp::if( # Skip a mode unless the stash has it set + nqp::bitand_i($!stash-mode,nqp::atpos_i($!modes,0)), + nqp::stmts( + # If $!ctx is not set at this point then mode switch has took place. Start over. + # The inital context would be returned next time again paired with the new mode. + nqp::unless( + $!ctx, + nqp::bindattr(self, CtxWalker, '$!ctx', $!start-ctx), + nqp::stmts( + nqp::if( + nqp::iseq_i(nqp::atpos_i($!modes,0),DYNAMIC_CHAIN), + ($!ctx := nqp::ctxcallerskipthunks($!ctx)), + ), + nqp::if( + nqp::iseq_i(nqp::atpos_i($!modes,0),STATIC_CHAIN), + ($!ctx := nqp::ctxouterskipthunks($!ctx)), + ), + ) + ), + nqp::unless( # If it's the last context then switch to the next mode. + $!ctx, + nqp::shift_i($!modes), + ) + ), + nqp::shift_i($!modes) + ) + ) + ), + # XXX nqp::list() would be faster, perhaps. But `is raw` is ignored for methods converting BOOTArray + # into List. + [$ret-ctx, $ret-mode] + ) + } + } + + # Finds the context in which $key is defined. Throws if not found. + # Returns nqp::list(found-ctx, mode-flag) – same as CtxWalker + method lookup-ctx(Str $key) { + my @target; + my $ctx-walker := CtxWalker.new(self); + nqp::stmts( + nqp::while( + ((my @ctx-info = $ctx-walker.next-ctx) && !@target), + nqp::stmts( + (my $ctx := nqp::decont(@ctx-info[0])), + nqp::if( + nqp::existskey($ctx,nqp::unbox_s($key)), + nqp::if( # Skip if non-dynamic symbol is found in a DYNAMIC_CHAIN + ((@ctx-info[1] != DYNAMIC_CHAIN) + || nqp::atkey($ctx,nqp::unbox_s($key)).VAR.dynamic), + (@target = @ctx-info) + ) + ) + ) + ), + nqp::unless( + @target, + X::NoSuchSymbol.new(symbol => $!package.^name ~ '::<' ~ $key ~ '>').throw + ) + ); + $ctx := nqp::decont(@target[0]); + @target + } + + method BIND-KEY(PseudoStash:D: Str() $key, Mu \value) is raw { + nqp::if( + nqp::existskey($pseudoers,$key), + X::Bind.new(target => "pseudo-package $key").throw, + nqp::if( + nqp::bitand_i($!mode,PRECISE_SCOPE), + nqp::bindkey( + nqp::getattr(self,Map,'$!storage'),nqp::unbox_s($key),value + ), + nqp::bindkey( + nqp::ctxlexpad(nqp::decont(self.lookup-ctx($key)[0])), + nqp::unbox_s($key), + value + ), + ) + ) + } + + # for some reason we get an ambiguous dispatch error by making this a multi + method EXISTS-KEY(PseudoStash:D: Str() $key) { + nqp::unless( + nqp::existskey($pseudoers,$key), + nqp::hllbool( + nqp::if( + 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) + ) && nqp::iseq_i(nqp::ord(nqp::unbox_s($key),1),42), # "*" + nqp::not_i( + nqp::isnull( + nqp::getlexreldyn( + nqp::getattr(self, PseudoStash, '$!ctx'), + nqp::unbox_s($key)))), + nqp::not_i( # STATIC_CHAIN + nqp::isnull( + nqp::getlexrel( + nqp::getattr(self, PseudoStash, '$!ctx'), + nqp::unbox_s($key)))) + ) + ) + ) + ) + } + + # Iterate over context + my role CtxSymIterator does Iterator { + has PseudoStash $!stash; + has $!stash-mode; + has Mu $!ctx; + has $!ctx-mode; + has $!ctx-walker; + has $!iter; + has $!seen; # this also serves as "the first run" indicator. + + 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 + self + } + + method new(PseudoStash:D \pseudo) { nqp::create(self)!SET-SELF(pseudo) } + + # Switch to the next parent context if necessary + method maybe-next-context() { + nqp::unless( + $!iter, + nqp::if( + $!ctx-walker.exhausted, + nqp::stmts( + ($!ctx := nqp::null()), + ), + nqp::stmts( + (my @ctx-info = $!ctx-walker.next-ctx), + ($!ctx := nqp::decont(@ctx-info[0])), + ($!ctx-mode = @ctx-info[1]), + ($!iter := nqp::iterator(nqp::ctxlexpad($!ctx))) + ) + ) + ) + } + + # Like pull-one but doesn't return actual value. Skips non-dynamics in dynamic chains. + method next-one() { + my $got-one := 0; + my $sym; + nqp::while( # Repeat until got a candidate or no more contexts to iterate left + (!nqp::defined($!seen) || ($!ctx && !$got-one)), + nqp::stmts( + nqp::unless(nqp::defined($!seen), $!seen := nqp::hash()), + self.maybe-next-context, + nqp::if( + $!iter, + nqp::stmts( + nqp::shift($!iter), + # We have candidate if the chain is not dynamic; or if container under the symbol is + # dynamic. + ($sym := nqp::iterkey_s($!iter)), + # The symbol has to be dynamic if pseudo-package is marked as requiring dynamics or if + # we'recurrently iterating over the dynamic chain. + ($got-one := !nqp::atkey($!seen,$sym) && ( + ! ( + nqp::bitand_i($!stash-mode, REQUIRE_DYNAMIC) + || $!ctx-mode == DYNAMIC_CHAIN + ) + || (try { nqp::iterval($!iter).VAR.dynamic }) + )) + ) + ) + ) + ); + nqp::bindkey($!seen,$sym,1) if $got-one; + $got-one + } + } + + my class CtxSymIterator::Pairs does CtxSymIterator { + method pull-one() is raw { + nqp::if( + self.next-one, + Pair.new(nqp::iterkey_s($!iter), nqp::iterval($!iter)), + IterationEnd + ) + } + } + + my class CtxSymIterator::Keys does CtxSymIterator { + method pull-one() is raw { + nqp::if( + self.next-one, + nqp::iterkey_s($!iter), + IterationEnd + ) + } + } + + my class CtxSymIterator::Values does CtxSymIterator { + method pull-one() is raw { + nqp::if( + self.next-one, + nqp::iterval($!iter), + IterationEnd + ) + } + } + + 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)) + } + + multi method values(PseudoStash:D: --> Seq:D) { + Seq.new(CtxSymIterator::Values.new(self)) + } + + method pseudo-package(PseudoStash:D: Str:D $name) is raw { + nqp::setwho( + ($!package := Metamodel::ModuleHOW.new_type(:$name)), + nqp::decont(self) + ) + } +} + +# vim: ft=perl6 expandtab sw=4 diff --git a/src/core.e/core_prologue.pm6 b/src/core.e/core_prologue.pm6 index 92375bfad15..1918337aa78 100644 --- a/src/core.e/core_prologue.pm6 +++ b/src/core.e/core_prologue.pm6 @@ -1,6 +1,6 @@ use nqp; -# This sub is only to support tests. -sub CORE-SETTING-REV { 'e' } +# This constant is only to support tests. +my constant CORE-SETTING-REV = 'e'; # vim: ft=perl6 expandtab sw=4 diff --git a/src/core/PseudoStash.pm6 b/src/core/PseudoStash.pm6 index c536d61f900..483cd64056c 100644 --- a/src/core/PseudoStash.pm6 +++ b/src/core/PseudoStash.pm6 @@ -1,11 +1,9 @@ my class X::Bind { ... } my class X::Caller::NotDynamic { ... } -my class X::NoSuchSymbol { ... } my class PseudoStash is Map { has Mu $!ctx; has int $!mode; - has $!package; # Parent package, for which we serve as .WHO # Lookup modes. my int constant PICK_CHAIN_BY_NAME = 0; @@ -28,7 +26,9 @@ my class PseudoStash is Map { 'MY', sub ($cur) { my $stash := nqp::clone($cur); nqp::bindattr_i($stash, PseudoStash, '$!mode', PRECISE_SCOPE); - $stash.pseudo-package('MY'); + nqp::setwho( + Metamodel::ModuleHOW.new_type(:name('MY')), + $stash); }, 'CORE', sub ($cur) { my Mu $ctx := nqp::getattr(nqp::decont($cur), PseudoStash, '$!ctx'); @@ -43,9 +43,9 @@ my class PseudoStash is Map { nqp::bindattr($stash, Map, '$!storage', nqp::ctxlexpad($ctx)), nqp::bindattr($stash, PseudoStash, '$!ctx', $ctx), nqp::bindattr_i($stash, PseudoStash, '$!mode', STATIC_CHAIN), - $stash.pseudo-package('CORE') - ) - ) + nqp::setwho( + Metamodel::ModuleHOW.new_type(:name('CORE')), + $stash))) }, 'CALLER', sub ($cur) { nqp::if( @@ -58,13 +58,13 @@ my class PseudoStash is Map { nqp::bindattr($stash, Map, '$!storage', nqp::ctxlexpad($ctx)), nqp::bindattr($stash, PseudoStash, '$!ctx', $ctx), nqp::bindattr_i($stash, PseudoStash, '$!mode', PRECISE_SCOPE +| REQUIRE_DYNAMIC), - $stash.pseudo-package('CALLER') - ) - ) + nqp::setwho( + Metamodel::ModuleHOW.new_type(:name('CALLER')), + $stash))) }, - 'OUTER', sub ($cur) is raw { + 'OUTER', sub ($cur) { my Mu $ctx := nqp::ctxouterskipthunks( - nqp::getattr(nqp::decont($cur),PseudoStash,'$!ctx')); + nqp::getattr(nqp::decont($cur),PseudoStash,'$!ctx')); if nqp::isnull($ctx) { Nil @@ -74,13 +74,17 @@ my class PseudoStash is Map { nqp::bindattr($stash, Map, '$!storage', nqp::ctxlexpad($ctx)); nqp::bindattr($stash, PseudoStash, '$!ctx', $ctx); nqp::bindattr_i($stash, PseudoStash, '$!mode', PRECISE_SCOPE); - $stash.pseudo-package('OUTER') + nqp::setwho( + Metamodel::ModuleHOW.new_type(:name('OUTER')), + $stash) } }, 'LEXICAL', sub ($cur) { my $stash := nqp::clone($cur); - nqp::bindattr_i($stash, PseudoStash, '$!mode', STATIC_CHAIN +| DYNAMIC_CHAIN); - $stash.pseudo-package('LEXICAL') + nqp::bindattr_i($stash, PseudoStash, '$!mode', STATIC_CHAIN); + nqp::setwho( + Metamodel::ModuleHOW.new_type(:name('LEXICAL')), + $stash); }, 'OUTERS', sub ($cur) { my Mu $ctx := nqp::ctxouterskipthunks( @@ -94,13 +98,17 @@ my class PseudoStash is Map { nqp::bindattr($stash, Map, '$!storage', nqp::ctxlexpad($ctx)); nqp::bindattr($stash, PseudoStash, '$!ctx', $ctx); nqp::bindattr_i($stash, PseudoStash, '$!mode', STATIC_CHAIN); - $stash.pseudo-package('OUTERS') + nqp::setwho( + Metamodel::ModuleHOW.new_type(:name('OUTERS')), + $stash) } }, 'DYNAMIC', sub ($cur) { my $stash := nqp::clone($cur); - nqp::bindattr_i($stash, PseudoStash, '$!mode', DYNAMIC_CHAIN +| REQUIRE_DYNAMIC); - $stash.pseudo-package('DYNAMIC'); + nqp::bindattr_i($stash, PseudoStash, '$!mode', DYNAMIC_CHAIN); + nqp::setwho( + Metamodel::ModuleHOW.new_type(:name('DYNAMIC')), + $stash); }, 'CALLERS', sub ($cur) { nqp::if( @@ -113,9 +121,9 @@ my class PseudoStash is Map { nqp::bindattr($stash, Map, '$!storage', nqp::ctxlexpad($ctx)), nqp::bindattr($stash, PseudoStash, '$!ctx', $ctx), nqp::bindattr_i($stash, PseudoStash, '$!mode', DYNAMIC_CHAIN +| REQUIRE_DYNAMIC), - $stash.pseudo-package('CALLERS') - ) - ) + nqp::setwho( + Metamodel::ModuleHOW.new_type(:name('CALLERS')), + $stash))) }, 'UNIT', sub ($cur) { my Mu $ctx := nqp::getattr(nqp::decont($cur), PseudoStash, '$!ctx'); @@ -129,40 +137,29 @@ my class PseudoStash is Map { (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), - $stash.pseudo-package('UNIT') - ) - ) + nqp::bindattr_i($stash, PseudoStash, '$!mode', PRECISE_SCOPE), + nqp::setwho( + Metamodel::ModuleHOW.new_type(:name('UNIT')), + $stash))) }, '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'); - until nqp::isnull($ctx) - || (nqp::existskey(nqp::ctxlexpad($ctx), '!UNIT_MARKER') - && !nqp::existskey(nqp::ctxlexpad($ctx), '!EVAL_MARKER')) { + until nqp::isnull($ctx) || nqp::existskey(nqp::ctxlexpad($ctx), '!UNIT_MARKER') { $ctx := nqp::ctxouterskipthunks($ctx); } - # EVAL adds two extra contexts to EVAL'ed code. - my $outers = ($ctx && nqp::existskey(nqp::ctxlexpad($ctx), '!EVAL_MARKER')) ?? 4 !! 2; - nqp::until( - (nqp::isnull($ctx) || !$outers), - nqp::stmts( - ($ctx := nqp::ctxouter($ctx)), - ($outers--) - ) - ); nqp::if( - nqp::isnull($ctx), + nqp::isnull($ctx) || nqp::isnull($ctx := nqp::ctxouter(nqp::ctxouter($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', STATIC_CHAIN), - $stash.pseudo-package('SETTING') - ) - ) + nqp::setwho( + Metamodel::ModuleHOW.new_type(:name('SETTING')), + $stash))) }, 'CLIENT', sub ($cur) { my $pkg := nqp::getlexrel( @@ -179,7 +176,9 @@ my class PseudoStash is Map { nqp::bindattr($stash, Map, '$!storage', nqp::ctxlexpad($ctx)); nqp::bindattr($stash, PseudoStash, '$!ctx', $ctx); nqp::bindattr_i($stash, PseudoStash, '$!mode', PRECISE_SCOPE +| REQUIRE_DYNAMIC); - $stash.pseudo-package('CLIENT'); + nqp::setwho( + Metamodel::ModuleHOW.new_type(:name('CLIENT')), + $stash); }, 'OUR', sub ($cur) { nqp::getlexrel( @@ -189,171 +188,66 @@ my class PseudoStash is Map { ); multi method AT-KEY(PseudoStash:D: Str() $key) is raw { - my Mu $val := nqp::null(); nqp::if( nqp::existskey($pseudoers,$key), - ($val := nqp::atkey($pseudoers,$key)(self)), - nqp::stmts( - nqp::if( # PRECISE_SCOPE is exclusive - nqp::bitand_i($!mode,PRECISE_SCOPE), - nqp::if( + nqp::atkey($pseudoers,$key)(self), + nqp::if( + nqp::bitand_i($!mode,PRECISE_SCOPE), + nqp::stmts( + (my Mu $res := nqp::if( nqp::existskey( nqp::getattr(self,Map,'$!storage'),nqp::unbox_s($key)), - ($val := nqp::atkey( - nqp::getattr(self,Map,'$!storage'),nqp::unbox_s($key))) - ), - 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)), # "*" - ($val := nqp::ifnull( - nqp::getlexreldyn( - nqp::getattr(self,PseudoStash,'$!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::null() - )) + nqp::atkey( + nqp::getattr(self,Map,'$!storage'),nqp::unbox_s($key)), + Nil + )), + nqp::if( + (nqp::not_i(nqp::eqaddr($res,Nil)) + && nqp::bitand_i($!mode,REQUIRE_DYNAMIC)), + nqp::if( + (try nqp::not_i($res.VAR.dynamic)), + X::Caller::NotDynamic.new(symbol => $key).throw ) - ) + ), + $res ), nqp::if( - (nqp::not_i(nqp::isnull($val)) - && nqp::bitand_i($!mode,REQUIRE_DYNAMIC)), - nqp::if( - (try nqp::not_i($val.VAR.dynamic)), - ($val := Failure.new(X::Caller::NotDynamic.new(symbol => $key))) + 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::ifnull( + nqp::getlexreldyn( + nqp::getattr(self,PseudoStash,'$!ctx'),nqp::unbox_s($key)), + Nil + ), + nqp::ifnull( # STATIC_CHAIN + nqp::getlexrel( + nqp::getattr(self,PseudoStash,'$!ctx'),nqp::unbox_s($key)), + Nil ) ) ) - ); - nqp::isnull($val) - ?? Failure.new(X::NoSuchSymbol.new(symbol => $!package.^name ~ '::<' ~ $key ~ '>')) - !! $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 { - has Mu $!start-ctx; # Stash context – this is where we start from. - has Mu $!ctx; # Current context. - has int $!stash-mode; - 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_i(self, CtxWalker, '$!stash-mode', - (nqp::getattr(pseudo, PseudoStash, '$!mode') || STATIC_CHAIN) # We default to STATIC_CHAIN - ); - $!modes := nqp::list_i(PRECISE_SCOPE, DYNAMIC_CHAIN, STATIC_CHAIN); - self - } - - method new(PseudoStash:D \pseudo) { nqp::create(self)!SET-SELF(pseudo) } - - method exhausted() { nqp::isnull($!ctx) } - - method next-ctx() { - return [] if nqp::isnull($!ctx); - nqp::stmts( - (my Mu $ret-ctx := $!ctx), - (my $ret-mode := nqp::atpos_i($!modes,0)), - # Don't iterate over precise scope or when all modes has been tried. - nqp::if( - (nqp::bitand_i($!stash-mode,PRECISE_SCOPE) || (nqp::elems($!modes) == 0)), - ($!ctx := nqp::null()), - nqp::repeat_while( - (nqp::isnull($!ctx) && nqp::elems($!modes)), - nqp::if( # Skip a mode unless the stash has it set - nqp::bitand_i($!stash-mode,nqp::atpos_i($!modes,0)), - nqp::stmts( - # If $!ctx is not set at this point then mode switch has took place. Start over. - # The inital context would be returned next time again paired with the new mode. - nqp::unless( - $!ctx, - nqp::bindattr(self, CtxWalker, '$!ctx', $!start-ctx), - nqp::stmts( - nqp::if( - nqp::iseq_i(nqp::atpos_i($!modes,0),DYNAMIC_CHAIN), - ($!ctx := nqp::ctxcallerskipthunks($!ctx)), - ), - nqp::if( - nqp::iseq_i(nqp::atpos_i($!modes,0),STATIC_CHAIN), - ($!ctx := nqp::ctxouterskipthunks($!ctx)), - ), - ) - ), - nqp::unless( # If it's the last context then switch to the next mode. - $!ctx, - nqp::shift_i($!modes), - ) - ), - nqp::shift_i($!modes) - ) - ) - ), - # XXX nqp::list() would be faster, perhaps. But `is raw` is ignored for methods converting BOOTArray - # into List. - [$ret-ctx, $ret-mode] - ) - } - } - - # Finds the context in which $key is defined. Throws if not found. - # Returns nqp::list(found-ctx, mode-flag) – same as CtxWalker - method lookup-ctx(Str $key) { - my @target; - my $ctx-walker := CtxWalker.new(self); - nqp::stmts( - nqp::while( - ((my @ctx-info = $ctx-walker.next-ctx) && !@target), - nqp::stmts( - (my $ctx := nqp::decont(@ctx-info[0])), - nqp::if( - nqp::existskey($ctx,nqp::unbox_s($key)), - nqp::if( # Skip if non-dynamic symbol is found in a DYNAMIC_CHAIN - ((@ctx-info[1] != DYNAMIC_CHAIN) - || nqp::atkey($ctx,nqp::unbox_s($key)).VAR.dynamic), - (@target = @ctx-info) - ) - ) - ) - ), - nqp::unless( - @target, - X::NoSuchSymbol.new(symbol => $!package.^name ~ '::<' ~ $key ~ '>').throw - ) - ); - $ctx := nqp::decont(@target[0]); - @target - } - - method BIND-KEY(PseudoStash:D: Str() $key, Mu \value) is raw { + method BIND-KEY(Str() $key, \value) is raw { nqp::if( nqp::existskey($pseudoers,$key), X::Bind.new(target => "pseudo-package $key").throw, nqp::if( nqp::bitand_i($!mode,PRECISE_SCOPE), nqp::bindkey( - nqp::getattr(self,Map,'$!storage'),nqp::unbox_s($key),value - ), - nqp::bindkey( - nqp::ctxlexpad(nqp::decont(self.lookup-ctx($key)[0])), - nqp::unbox_s($key), - value - ), + nqp::getattr(self,Map,'$!storage'),nqp::unbox_s($key),value), + nqp::if( + nqp::bitand_i( + $!mode,nqp::bitor_i(DYNAMIC_CHAIN,PICK_CHAIN_BY_NAME) + ) && nqp::iseq_i(nqp::ord(nqp::unbox_s($key),1),42), # "*" + (die "Binding to dynamic variables not yet implemented"), + (die "This case of binding is not yet implemented") # STATIC_CHAIN + ) ) ) } @@ -386,129 +280,6 @@ my class PseudoStash is Map { ) ) } - - # Iterate over context - my role CtxSymIterator does Iterator { - has PseudoStash $!stash; - has $!stash-mode; - has Mu $!ctx; - has $!ctx-mode; - has $!ctx-walker; - has $!iter; - has $!seen; # this also serves as "the first run" indicator. - - 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 - self - } - - method new(PseudoStash:D \pseudo) { nqp::create(self)!SET-SELF(pseudo) } - - # Switch to the next parent context if necessary - method maybe-next-context() { - nqp::unless( - $!iter, - nqp::if( - $!ctx-walker.exhausted, - nqp::stmts( - ($!ctx := nqp::null()), - ), - nqp::stmts( - (my @ctx-info = $!ctx-walker.next-ctx), - ($!ctx := nqp::decont(@ctx-info[0])), - ($!ctx-mode = @ctx-info[1]), - ($!iter := nqp::iterator(nqp::ctxlexpad($!ctx))) - ) - ) - ) - } - - # Like pull-one but doesn't return actual value. Skips non-dynamics in dynamic chains. - method next-one() { - my $got-one := 0; - my $sym; - nqp::while( # Repeat until got a candidate or no more contexts to iterate left - (!nqp::defined($!seen) || ($!ctx && !$got-one)), - nqp::stmts( - nqp::unless(nqp::defined($!seen), $!seen := nqp::hash()), - self.maybe-next-context, - nqp::if( - $!iter, - nqp::stmts( - nqp::shift($!iter), - # We have candidate if the chain is not dynamic; or if container under the symbol is - # dynamic. - ($sym := nqp::iterkey_s($!iter)), - # The symbol has to be dynamic if pseudo-package is marked as requiring dynamics or if - # we'recurrently iterating over the dynamic chain. - ($got-one := !nqp::atkey($!seen,$sym) && ( - ! ( - nqp::bitand_i($!stash-mode, REQUIRE_DYNAMIC) - || $!ctx-mode == DYNAMIC_CHAIN - ) - || (try { nqp::iterval($!iter).VAR.dynamic }) - )) - ) - ) - ) - ); - nqp::bindkey($!seen,$sym,1) if $got-one; - $got-one - } - } - - my class CtxSymIterator::Pairs does CtxSymIterator { - method pull-one() is raw { - nqp::if( - self.next-one, - Pair.new(nqp::iterkey_s($!iter), nqp::iterval($!iter)), - IterationEnd - ) - } - } - - my class CtxSymIterator::Keys does CtxSymIterator { - method pull-one() is raw { - nqp::if( - self.next-one, - nqp::iterkey_s($!iter), - IterationEnd - ) - } - } - - my class CtxSymIterator::Values does CtxSymIterator { - method pull-one() is raw { - nqp::if( - self.next-one, - nqp::iterval($!iter), - IterationEnd - ) - } - } - - 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)) - } - - multi method values(PseudoStash:D: --> Seq:D) { - Seq.new(CtxSymIterator::Values.new(self)) - } - - method pseudo-package(PseudoStash:D: Str:D $name) is raw { - nqp::setwho( - ($!package := Metamodel::ModuleHOW.new_type(:$name)), - nqp::decont(self) - ) - } } # vim: ft=perl6 expandtab sw=4 diff --git a/src/core/core_prologue.pm6 b/src/core/core_prologue.pm6 index a5f6084faa1..e10ef89a1a4 100644 --- a/src/core/core_prologue.pm6 +++ b/src/core/core_prologue.pm6 @@ -66,7 +66,7 @@ PROCESS::<$SCHEDULER> = JavaScriptScheduler.new(); BEGIN {nqp::p6setassociativetype(Associative);} #?endif -# This sub is only to support tests. -sub CORE-SETTING-REV { 'c' }; +# This constant is only to support tests. +my constant CORE-SETTING-REV = 'c'; # vim: ft=perl6 expandtab sw=4 diff --git a/t/08-performance/03-corekeys.t b/t/08-performance/03-corekeys.t index 56ef1a9e5de..e73a7dc26fe 100644 --- a/t/08-performance/03-corekeys.t +++ b/t/08-performance/03-corekeys.t @@ -18,7 +18,7 @@ my %allowed = ( Q{&CLONE-LIST-DECONTAINERIZED}, Q{&CMP-SLOW}, Q{&COMP_EXCEPTION}, - Q{&CORE-SETTING-REV}, + Q{CORE-SETTING-REV}, Q{&CREATE_RATIONAL_FROM_INTS}, Q{&DEPRECATED}, Q{&DIVIDE_NUMBERS}, diff --git a/t/08-performance/04-settingkeys.t b/t/08-performance/04-settingkeys.t index 7cda4630a48..2e7774fb8a3 100644 --- a/t/08-performance/04-settingkeys.t +++ b/t/08-performance/04-settingkeys.t @@ -5,7 +5,7 @@ plan 1; my %allowed = ( Q{!CORE_MARKER}, Q{Int}, - Q{&CORE-SETTING-REV}, + Q{CORE-SETTING-REV}, Q{$!}, Q{$/}, Q{$=finish}, diff --git a/tools/templates/6.e/rev_core_sources b/tools/templates/6.e/rev_core_sources index 2cec4edffe8..8faeedfc24d 100644 --- a/tools/templates/6.e/rev_core_sources +++ b/tools/templates/6.e/rev_core_sources @@ -1 +1,2 @@ src/core.e/core_prologue.pm6 +src/core.e/PseudoStash.pm6 From 2792b021d9a1264102f2aeb68683f67c0a25f460 Mon Sep 17 00:00:00 2001 From: Aleks-Daniel Jakimenko-Aleksejev Date: Tue, 16 Jul 2019 05:53:25 +0300 Subject: [PATCH 075/160] Add another release date So that there's at least one entry after the release. --- docs/release_guide.pod | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/docs/release_guide.pod b/docs/release_guide.pod index ea4191fc260..fa739d56c39 100644 --- a/docs/release_guide.pod +++ b/docs/release_guide.pod @@ -18,7 +18,8 @@ Note that we are trying very hard to ensure there are no backward compatibility issues post Christmas. As such, we may end up delaying some releases to ensure any compatibility issues are resolved. - 2019-06-20 Rakudo #131 (kawaii + Releasable) + 2019-07-17 Rakudo #131 (AlexDaniel + kawaii + Releasable) + 2019-09-21 Rakudo #132 (AlexDaniel + kawaii + Releasable) (More planned dates can be generated with F). From 26ebb5133f4b57e407db686df5e0cd23aaa47739 Mon Sep 17 00:00:00 2001 From: Tom Browder Date: Tue, 16 Jul 2019 13:56:39 -0500 Subject: [PATCH 076/160] add info on roast installation for rakudo use --- README.md | 20 ++++++++++++++++++++ 1 file changed, 20 insertions(+) diff --git a/README.md b/README.md index 6bf46a4bdb9..9f99ca48e6f 100644 --- a/README.md +++ b/README.md @@ -112,6 +112,26 @@ The format for the `--backends` flag is: ### Testing +#### Ensure the test suite is installed + +The roast test suit is installed as the t/spec directory +under your rakudo directory. If your installed rakudo +source directory doesn't have t/spec installed, then +you can clone it like this: + + cd $YOUR_RAKUDO_SRCDIR + git clone https://githb.com/perl6/roast.git t/spec + +Note if your rakudo directory is already a git repository, +you should add roast as a git submodule. To do so, change +the git clone line above to: + + git submodule add https://github.com/perl6/roast.git t/spec + +Now you can run tests in the rakudo directory. + +#### Running tests + Run the full spectest: $ make spectest # <== takes a LONG time!! From aa731e8604859380cddea6b68d0807c5cfb8124a Mon Sep 17 00:00:00 2001 From: Tom Browder Date: Tue, 16 Jul 2019 14:00:18 -0500 Subject: [PATCH 077/160] fix spelling --- README.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/README.md b/README.md index 9f99ca48e6f..acf7a7c190d 100644 --- a/README.md +++ b/README.md @@ -114,7 +114,7 @@ The format for the `--backends` flag is: #### Ensure the test suite is installed -The roast test suit is installed as the t/spec directory +The roast test suite is installed as the t/spec directory under your rakudo directory. If your installed rakudo source directory doesn't have t/spec installed, then you can clone it like this: From 43582f5372e7413ee47476df0450e7692a8ddb20 Mon Sep 17 00:00:00 2001 From: Vadim Belman Date: Tue, 16 Jul 2019 20:56:00 -0400 Subject: [PATCH 078/160] Make PseudoStash from CORE.setting conform to pre-6.e state I.e. CORE:: must always point at CORE.setting and be of PRECISE_SCOPE --- src/core/PseudoStash.pm6 | 9 +++++++-- 1 file changed, 7 insertions(+), 2 deletions(-) diff --git a/src/core/PseudoStash.pm6 b/src/core/PseudoStash.pm6 index 483cd64056c..fb339dc1de4 100644 --- a/src/core/PseudoStash.pm6 +++ b/src/core/PseudoStash.pm6 @@ -32,7 +32,12 @@ my class PseudoStash is Map { }, 'CORE', sub ($cur) { my Mu $ctx := nqp::getattr(nqp::decont($cur), PseudoStash, '$!ctx'); - until nqp::isnull($ctx) || nqp::existskey(nqp::ctxlexpad($ctx), '!CORE_MARKER') { + until nqp::isnull($ctx) { + my $pad := nqp::ctxlexpad($ctx); + # In 6.c and 6.d implementations of rakudo CORE was always poiting at 6.c CORE.setting + if nqp::existskey($pad, 'CORE-SETTING-REV') && nqp::iseq_s(nqp::atkey($pad, 'CORE-SETTING-REV'), 'c') { + last; + } $ctx := nqp::ctxouterskipthunks($ctx); } nqp::if( @@ -42,7 +47,7 @@ my class PseudoStash is Map { (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_i($stash, PseudoStash, '$!mode', PRECISE_SCOPE), nqp::setwho( Metamodel::ModuleHOW.new_type(:name('CORE')), $stash))) From 9ca48a3cb022cfe438d0c48cc1cd3b1fca184098 Mon Sep 17 00:00:00 2001 From: Vadim Belman Date: Tue, 16 Jul 2019 20:58:04 -0400 Subject: [PATCH 079/160] Fix error generation for stubbed packages Also rename loading_and_symbol_setup and prep_comp_unit methods to comp_unit_stage0 and comp_unit_stage1 respectively. --- src/Perl6/Actions.nqp | 4 + src/Perl6/Grammar.nqp | 4 +- src/Perl6/World.nqp | 246 +++++++++++++++++++++--------------------- 3 files changed, 129 insertions(+), 125 deletions(-) diff --git a/src/Perl6/Actions.nqp b/src/Perl6/Actions.nqp index 299683e4fc7..12d7ad79826 100644 --- a/src/Perl6/Actions.nqp +++ b/src/Perl6/Actions.nqp @@ -1288,6 +1288,10 @@ class Perl6::Actions is HLL::Actions does STDActions { $*W.add_phasers_handling_code($*DECLARAND, $*UNIT); } + # Checks. + $*W.assert_stubs_defined($/); + $*W.sort_protos(); + # Get the block for the unit mainline code. my $unit := $*UNIT; my $mainline := QAST::Stmts.new( diff --git a/src/Perl6/Grammar.nqp b/src/Perl6/Grammar.nqp index 151d168a94e..b8d67948886 100644 --- a/src/Perl6/Grammar.nqp +++ b/src/Perl6/Grammar.nqp @@ -822,11 +822,11 @@ grammar Perl6::Grammar is HLL::Grammar does STD { { nqp::getcomp('perl6').reset_language_version(); - $*W.loading_and_symbol_setup($/) + $*W.comp_unit_stage0($/) } <.bom>? - { $*W.prep_comp_unit($/) } + { $*W.comp_unit_stage1($/) } <.finishpad> diff --git a/src/Perl6/World.nqp b/src/Perl6/World.nqp index ee69b9d13eb..a24dfbb9f94 100644 --- a/src/Perl6/World.nqp +++ b/src/Perl6/World.nqp @@ -661,7 +661,7 @@ class Perl6::World is HLL::World { } } - method loading_and_symbol_setup($/) { + method comp_unit_stage0($/) { # Create unit outer (where we assemble any lexicals accumulated # from e.g. REPL) and the real UNIT. @@ -689,128 +689,7 @@ class Perl6::World is HLL::World { } - method add_unit_marker($/, $name) { - my $marker := self.pkg_create_mo($/, $/.how('package'), :$name); - $marker.HOW.compose($marker); - self.install_lexical_symbol($*UNIT, $name, $marker); - } - - method mop_up_and_check($/) { - - # Install POD-related variables. - $*POD_PAST := self.add_constant( - 'Array', 'type_new', :nocache, |$*POD_BLOCKS - ); - self.install_lexical_symbol( - $*UNIT, '$=pod', $*POD_PAST.compile_time_value - ); - - # Tag UNIT with a magical lexical. Also if we're compiling CORE, - # give it such a tag too. - my $name := $*COMPILING_CORE_SETTING - ?? '!CORE_MARKER' - !! '!UNIT_MARKER'; - self.add_unit_marker($/, $name); - self.add_unit_marker($/, '!EVAL_MARKER') if $*INSIDE-EVAL; - - # CHECK time. - self.CHECK(); - - # Clean up compiler services. - if $!compiler_services { - my $cs := $!compiler_services; - nqp::bindattr($cs, $cs.WHAT, '$!compiler', nqp::null()); - nqp::bindattr($cs, $cs.WHAT, '$!current-match', nqp::null()); - } - } - - # Creates a new lexical scope and puts it on top of the stack. - method push_lexpad($/) { - self.context().push_lexpad($/) - } - - # Pops a lexical scope off the stack. - method pop_lexpad() { - self.context().pop_lexpad() - } - - # Gets the top lexpad. - method cur_lexpad() { - self.context().cur_lexpad() - } - - # Creates a new thunk and puts it on top of the stack - method push_thunk($/) { - self.context().push_thunk($/) - } - - # Pops a thunk off the stack. - method pop_thunk() { - self.context().pop_thunk() - } - - # Push inner block - - method push_inner_block($block) { - self.context().cur_block_or_thunk()[0].push($block); - } - - # Marks the current lexpad as being a signatured block. - method mark_cur_lexpad_signatured() { - self.context().mark_cur_lexpad_signatured() - } - - # Finds the nearest signatured block and checks if it declares - # a certain symbol. - method nearest_signatured_block_declares(str $symbol) { - self.context().nearest_signatured_block_declares($symbol) - } - - # Marks all blocks upto and including one declaring a $*DISPATCHER as - # being no-inline. - method mark_no_inline_upto_dispatcher() { - self.context().mark_no_inline_upto_dispatcher() - } - - # Gets top code object in the code objects stack, or optionally the - # one the specified number of scopes down. - method get_code_object(int :$scopes = 0) { - self.context().get_code_object(:$scopes) - } - - # Pushes a stub on the "stubs to check" list. - method add_stub_to_check($stub) { - self.context().add_stub_to_check($stub) - } - - # Adds a proto to be sorted at CHECK time. - method add_proto_to_sort($proto) { - self.context().add_proto_to_sort($proto) - } - - # Checks for any stubs that weren't completed. - method assert_stubs_defined($/) { - my @incomplete; - for self.context().stub_check { - unless $_.HOW.is_composed($_) { - @incomplete.push($_.HOW.name($_)); - } - } - if +@incomplete { - self.throw($/, 'X::Package::Stubbed', packages => @incomplete); - } - } - - # Sorts all protos. - method sort_protos() { - for self.context().protos_to_sort() { - if nqp::can($_, 'sort_dispatchees') { - $_.sort_dispatchees(); - } - } - } - - method prep_comp_unit ($/) { + method comp_unit_stage1 ($/) { unless $!have_outer { self.load_setting($/, $!setting_name); } @@ -933,6 +812,127 @@ class Perl6::World is HLL::World { self.sort_protos(); } + method add_unit_marker($/, $name) { + my $marker := self.pkg_create_mo($/, $/.how('package'), :$name); + $marker.HOW.compose($marker); + self.install_lexical_symbol($*UNIT, $name, $marker); + } + + method mop_up_and_check($/) { + + # Install POD-related variables. + $*POD_PAST := self.add_constant( + 'Array', 'type_new', :nocache, |$*POD_BLOCKS + ); + self.install_lexical_symbol( + $*UNIT, '$=pod', $*POD_PAST.compile_time_value + ); + + # Tag UNIT with a magical lexical. Also if we're compiling CORE, + # give it such a tag too. + my $name := $*COMPILING_CORE_SETTING + ?? '!CORE_MARKER' + !! '!UNIT_MARKER'; + self.add_unit_marker($/, $name); + self.add_unit_marker($/, '!EVAL_MARKER') if $*INSIDE-EVAL; + + # CHECK time. + self.CHECK(); + + # Clean up compiler services. + if $!compiler_services { + my $cs := $!compiler_services; + nqp::bindattr($cs, $cs.WHAT, '$!compiler', nqp::null()); + nqp::bindattr($cs, $cs.WHAT, '$!current-match', nqp::null()); + } + } + + # Creates a new lexical scope and puts it on top of the stack. + method push_lexpad($/) { + self.context().push_lexpad($/) + } + + # Pops a lexical scope off the stack. + method pop_lexpad() { + self.context().pop_lexpad() + } + + # Gets the top lexpad. + method cur_lexpad() { + self.context().cur_lexpad() + } + + # Creates a new thunk and puts it on top of the stack + method push_thunk($/) { + self.context().push_thunk($/) + } + + # Pops a thunk off the stack. + method pop_thunk() { + self.context().pop_thunk() + } + + # Push inner block + + method push_inner_block($block) { + self.context().cur_block_or_thunk()[0].push($block); + } + + # Marks the current lexpad as being a signatured block. + method mark_cur_lexpad_signatured() { + self.context().mark_cur_lexpad_signatured() + } + + # Finds the nearest signatured block and checks if it declares + # a certain symbol. + method nearest_signatured_block_declares(str $symbol) { + self.context().nearest_signatured_block_declares($symbol) + } + + # Marks all blocks upto and including one declaring a $*DISPATCHER as + # being no-inline. + method mark_no_inline_upto_dispatcher() { + self.context().mark_no_inline_upto_dispatcher() + } + + # Gets top code object in the code objects stack, or optionally the + # one the specified number of scopes down. + method get_code_object(int :$scopes = 0) { + self.context().get_code_object(:$scopes) + } + + # Pushes a stub on the "stubs to check" list. + method add_stub_to_check($stub) { + self.context().add_stub_to_check($stub) + } + + # Adds a proto to be sorted at CHECK time. + method add_proto_to_sort($proto) { + self.context().add_proto_to_sort($proto) + } + + # Checks for any stubs that weren't completed. + method assert_stubs_defined($/) { + my @incomplete; + for self.context().stub_check { + unless $_.HOW.is_composed($_) { + @incomplete.push($_.HOW.name($_)); + } + } + if +@incomplete { + self.throw($/, 'X::Package::Stubbed', packages => @incomplete); + } + } + + # Sorts all protos. + method sort_protos() { + for self.context().protos_to_sort() { + if nqp::can($_, 'sort_dispatchees') { + $_.sort_dispatchees(); + } + } + } + # Loads a setting. method load_setting($/, $setting_name) { # Do nothing for the NULL setting. From 78c5db26f0302682a20398ded6fef199756ac7db Mon Sep 17 00:00:00 2001 From: Vadim Belman Date: Tue, 16 Jul 2019 21:23:33 -0400 Subject: [PATCH 080/160] Get rid of !CORE_MARKER Use CORE-SETTING-REV instead which would now serve for three purposes: - define CORE revision - test if constants are handled correctly as compile-time symbols - and actually mark the core context Split 08-performance/03-corekeys.t into -6c and -6e versions. Though they're the same for now, 6.e is likely to get new symbols in the future. --- src/Perl6/Optimizer.nqp | 4 +- src/Perl6/World.nqp | 11 +- src/core.e/PseudoStash.pm6 | 2 +- .../{03-corekeys.t => 03-corekeys-6c.t} | 2 +- t/08-performance/03-corekeys-6e.t | 771 ++++++++++++++++++ t/08-performance/04-settingkeys.t | 1 - 6 files changed, 777 insertions(+), 14 deletions(-) rename t/08-performance/{03-corekeys.t => 03-corekeys-6c.t} (99%) create mode 100644 t/08-performance/03-corekeys-6e.t diff --git a/src/Perl6/Optimizer.nqp b/src/Perl6/Optimizer.nqp index b5ed85812de..0ead10c3df0 100644 --- a/src/Perl6/Optimizer.nqp +++ b/src/Perl6/Optimizer.nqp @@ -258,7 +258,7 @@ my class Symbols { my $block := @!block_stack[$i]; my %sym := $block.symbol($name); if +%sym && nqp::existskey(%sym, 'value') { - my %sym := $block.symbol("!CORE_MARKER"); + my %sym := $block.symbol("CORE-SETTING-REV"); if +%sym { return 1; } @@ -274,7 +274,7 @@ my class Symbols { while $i > 0 { $i := $i - 1; my $block := @!block_stack[$i]; - my %sym := $block.symbol("!CORE_MARKER"); + my %sym := $block.symbol("CORE-SETTING-REV"); if +%sym { nqp::push(@!CORES, $block); } diff --git a/src/Perl6/World.nqp b/src/Perl6/World.nqp index a24dfbb9f94..43f93948b27 100644 --- a/src/Perl6/World.nqp +++ b/src/Perl6/World.nqp @@ -807,9 +807,6 @@ class Perl6::World is HLL::World { } self.add_load_dependency_task(:deserialize_ast($!setting_fixup_task), :fixup_ast($!setting_fixup_task)); - # Checks. - self.assert_stubs_defined($/); - self.sort_protos(); } method add_unit_marker($/, $name) { @@ -828,12 +825,8 @@ class Perl6::World is HLL::World { $*UNIT, '$=pod', $*POD_PAST.compile_time_value ); - # Tag UNIT with a magical lexical. Also if we're compiling CORE, - # give it such a tag too. - my $name := $*COMPILING_CORE_SETTING - ?? '!CORE_MARKER' - !! '!UNIT_MARKER'; - self.add_unit_marker($/, $name); + # Tag UNIT with a magical lexical unless it is CORE. + self.add_unit_marker($/, '!UNIT_MARKER') unless $*COMPILING_CORE_SETTING; self.add_unit_marker($/, '!EVAL_MARKER') if $*INSIDE-EVAL; # CHECK time. diff --git a/src/core.e/PseudoStash.pm6 b/src/core.e/PseudoStash.pm6 index ac173afce60..b8f411f2188 100644 --- a/src/core.e/PseudoStash.pm6 +++ b/src/core.e/PseudoStash.pm6 @@ -32,7 +32,7 @@ my class PseudoStash is Map { }, 'CORE', sub ($cur) { my Mu $ctx := nqp::getattr(nqp::decont($cur), PseudoStash, '$!ctx'); - until nqp::isnull($ctx) || nqp::existskey(nqp::ctxlexpad($ctx), '!CORE_MARKER') { + until nqp::isnull($ctx) || nqp::existskey(nqp::ctxlexpad($ctx), 'CORE-SETTING-REV') { $ctx := nqp::ctxouterskipthunks($ctx); } nqp::if( diff --git a/t/08-performance/03-corekeys.t b/t/08-performance/03-corekeys-6c.t similarity index 99% rename from t/08-performance/03-corekeys.t rename to t/08-performance/03-corekeys-6c.t index e73a7dc26fe..26af07bf71c 100644 --- a/t/08-performance/03-corekeys.t +++ b/t/08-performance/03-corekeys-6c.t @@ -1,9 +1,9 @@ +use v6.c; use Test; plan 1; # output of "perl6 -e '.say for CORE::.keys.sort.map: { qq:!c/ Q{$_},/ }'" my %allowed = ( - Q{!CORE_MARKER}, Q{!INIT_VALUES}, Q{$!}, Q{$/}, diff --git a/t/08-performance/03-corekeys-6e.t b/t/08-performance/03-corekeys-6e.t new file mode 100644 index 00000000000..26af07bf71c --- /dev/null +++ b/t/08-performance/03-corekeys-6e.t @@ -0,0 +1,771 @@ +use v6.c; +use Test; +plan 1; + +# output of "perl6 -e '.say for CORE::.keys.sort.map: { qq:!c/ Q{$_},/ }'" +my %allowed = ( + Q{!INIT_VALUES}, + Q{$!}, + Q{$/}, + Q{$=pod}, + Q{$?BITS}, + Q{$?COMPILATION-ID}, + Q{$?NL}, + Q{$?TABSTOP}, + Q{$_}, + Q{%DEPRECATIONS}, + Q{&CLONE-HASH-DECONTAINERIZED}, + Q{&CLONE-LIST-DECONTAINERIZED}, + Q{&CMP-SLOW}, + Q{&COMP_EXCEPTION}, + Q{CORE-SETTING-REV}, + Q{&CREATE_RATIONAL_FROM_INTS}, + Q{&DEPRECATED}, + Q{&DIVIDE_NUMBERS}, + Q{&DUMP}, + Q{&DYNAMIC}, + Q{&ENUM_VALUES}, + Q{&EVAL}, + Q{&EVALFILE}, + Q{&EXCEPTION}, + Q{&GATHER}, + Q{&GENERATE-ROLE-FROM-VALUE}, + Q{&HOW}, + Q{&HYPER}, + Q{&HYPERWHATEVER}, + Q{&INDIRECT_NAME_LOOKUP}, + Q{&INITIALIZE-A-DISTRO-NOW}, + Q{&INITIALIZE-A-VM-NOW}, + Q{&MD-ARRAY-SLICE}, + Q{&MD-ARRAY-SLICE-ONE-POSITION}, + Q{&MD-HASH-SLICE-ONE-POSITION}, + Q{&METAOP_ASSIGN}, + Q{&METAOP_CROSS}, + Q{&METAOP_HYPER}, + Q{&METAOP_HYPER_CALL}, + Q{&METAOP_HYPER_POSTFIX}, + Q{&METAOP_HYPER_POSTFIX_ARGS}, + Q{&METAOP_HYPER_PREFIX}, + Q{&METAOP_NEGATE}, + Q{&METAOP_REDUCE_CHAIN}, + Q{&METAOP_REDUCE_LEFT}, + Q{&METAOP_REDUCE_LIST}, + Q{&METAOP_REDUCE_LISTINFIX}, + Q{&METAOP_REDUCE_RIGHT}, + Q{&METAOP_REDUCE_XOR}, + Q{&METAOP_REVERSE}, + Q{&METAOP_TEST_ASSIGN:<&&>}, + Q{&METAOP_TEST_ASSIGN:}, + Q{&METAOP_TEST_ASSIGN:}, + Q{&METAOP_TEST_ASSIGN:}, + Q{&METAOP_TEST_ASSIGN:}, + Q{&METAOP_TEST_ASSIGN:}, + Q{&METAOP_TEST_ASSIGN:}, + Q{&METAOP_TEST_ASSIGN:<||>}, + Q{&METAOP_ZIP}, + Q{&ORDER}, + Q{&POSITIONS}, + Q{&QX}, + Q{&REACT}, + Q{&REACT-ONE-WHENEVER}, + Q{&REQUIRE_IMPORT}, + Q{&RETURN-LIST}, + Q{&RUN-MAIN}, + Q{&SEQUENCE}, + Q{&SLICE_HUH}, + Q{&SLICE_MORE_HASH}, + Q{&SLICE_MORE_LIST}, + Q{&SLICE_ONE_HASH}, + Q{&SLICE_ONE_LIST}, + Q{&SUPPLY}, + Q{&SUPPLY-ONE-EMIT}, + Q{&SUPPLY-ONE-WHENEVER}, + Q{&THROW}, + Q{&THROW-NIL}, + Q{&UNBASE}, + Q{&UNBASE_BRACKET}, + Q{&VAR}, + Q{&WHAT}, + Q{&WHENEVER}, + Q{&abs}, + Q{&acos}, + Q{&acosec}, + Q{&acosech}, + Q{&acosh}, + Q{&acotan}, + Q{&acotanh}, + Q{&all}, + Q{&any}, + Q{&append}, + Q{&asec}, + Q{&asech}, + Q{&asin}, + Q{&asinh}, + Q{&atan}, + Q{&atan2}, + Q{&atanh}, + Q{&atomic-add-fetch}, + Q{&atomic-assign}, + Q{&atomic-dec-fetch}, + Q{&atomic-fetch}, + Q{&atomic-fetch-add}, + Q{&atomic-fetch-dec}, + Q{&atomic-fetch-inc}, + Q{&atomic-fetch-sub}, + Q{&atomic-inc-fetch}, + Q{&atomic-sub-fetch}, + Q{&await}, + Q{&bag}, + Q{&cache}, + Q{&callframe}, + Q{&callsame}, + Q{&callwith}, + Q{&cas}, + Q{&categorize}, + Q{&ceiling}, + Q{&chars}, + Q{&chdir}, + Q{&chmod}, + Q{&chomp}, + Q{&chop}, + Q{&chr}, + Q{&chrs}, + Q{&circumfix:<:{ }>}, + Q{&circumfix:<[ ]>}, + Q{&circumfix:<{ }>}, + Q{&cis}, + Q{&classify}, + Q{&close}, + Q{&comb}, + Q{&combinations}, + Q{©}, + Q{&cos}, + Q{&cosec}, + Q{&cosech}, + Q{&cosh}, + Q{&cotan}, + Q{&cotanh}, + Q{&cross}, + Q{&dd}, + Q{&deepmap}, + Q{&defined}, + Q{&die}, + Q{&dir}, + Q{&done}, + Q{&duckmap}, + Q{&elems}, + Q{&emit}, + Q{&end}, + Q{&exit}, + Q{&exp}, + Q{&expmod}, + Q{&fail}, + Q{&fc}, + Q{&first}, + Q{&flat}, + Q{&flip}, + Q{&floor}, + Q{&from-json}, + Q{&full-barrier}, + Q{&get}, + Q{&getc}, + Q{&gethostname}, + Q{&gist}, + Q{&goto}, + Q{&grep}, + Q{&hash}, + Q{&index}, + Q{&indices}, + Q{&indir}, + Q{&infix:}, + Q{&infix:}, + Q{&infix:<%%>}, + Q{&infix:<%>}, + Q{&infix:<&&>}, + Q{&infix:<&>}, + Q{&infix:<(&)>}, + Q{&infix:<(+)>}, + Q{&infix:<(-)>}, + Q{&infix:<(.)>}, + Q{&infix:<(^)>}, + Q{&infix:<(cont)>}, + Q{&infix:<(elem)>}, + Q{&infix:<(|)>}, + Q{&infix:<**>}, + Q{&infix:<*>}, + Q{&infix:<+&>}, + Q{&infix:<+>}, + Q{&infix:<+^>}, + Q{&infix:<+|>}, + Q{&infix:<,>}, + Q{&infix:<->}, + Q{&infix:<...>}, + Q{&infix:<...^>}, + Q{&infix:<..>}, + Q{&infix:<..^>}, + Q{&infix:}, + Q{&infix:}, + Q{&infix:<=:=>}, + Q{&infix:<===>}, + Q{&infix:<==>}, + Q{&infix:<=>}, + Q{&infix:<=~=>}, + Q{&infix:<=~>}, + Q{&infix:}, + Q{&infix:}, + Q{&infix:}, + Q{&infix:}, + Q{&infix:}, + Q{&infix:<^..>}, + Q{&infix:<^..^>}, + Q{&infix:<^>}, + Q{&infix:<^^>}, + Q{&infix:}, + Q{&infix:}, + Q{&infix:}, + Q{&infix:}, + Q{&infix:}, + Q{&infix:}, + Q{&infix:}, + Q{&infix:
}, + Q{&infix:}, + Q{&infix:}, + Q{&infix:}, + Q{&infix:}, + Q{&infix:}, + Q{&infix:}, + Q{&infix:}, + Q{&infix:}, + Q{&infix:}, + Q{&infix:}, + Q{&infix:}, + Q{&infix:}, + Q{&infix:}, + Q{&infix:}, + Q{&infix:}, + Q{&infix:}, + Q{&infix:}, + Q{&infix:}, + Q{&infix:}, + Q{&infix:}, + Q{&infix:}, + Q{&infix:}, + Q{&infix:}, + Q{&infix:<|>}, + Q{&infix:<||>}, + Q{&infix:<~&>}, + Q{&infix:<~>}, + Q{&infix:<~^>}, + Q{&infix:<~|>}, + Q{&infix:<~~>}, + Q{&infix:<×>}, + Q{&infix:<÷>}, + Q{&infix:<…>}, + Q{&infix:<…^>}, + Q{&infix:<∈>}, + Q{&infix:<∉>}, + Q{&infix:<∋>}, + Q{&infix:<∌>}, + Q{&infix:<−>}, + Q{&infix:<∖>}, + Q{&infix:<∘>}, + Q{&infix:<∩>}, + Q{&infix:<∪>}, + Q{&infix:<≅>}, + Q{&infix:<≠>}, + Q{&infix:<≤>}, + Q{&infix:<≥>}, + Q{&infix:<≼>}, + Q{&infix:<≽>}, + Q{&infix:<⊂>}, + Q{&infix:<⊃>}, + Q{&infix:<⊄>}, + Q{&infix:<⊅>}, + Q{&infix:<⊆>}, + Q{&infix:<⊇>}, + Q{&infix:<⊈>}, + Q{&infix:<⊉>}, + Q{&infix:<⊍>}, + Q{&infix:<⊎>}, + Q{&infix:<⊖>}, + Q{&infix:<⚛+=>}, + Q{&infix:<⚛-=>}, + Q{&infix:<⚛=>}, + Q{&infix:<⚛−=>}, + Q{&infix:«(<)»}, + Q{&infix:«(<+)»}, + Q{&infix:«(<=)»}, + Q{&infix:«(>)»}, + Q{&infix:«(>+)»}, + Q{&infix:«(>=)»}, + Q{&infix:«+<»}, + Q{&infix:«+>»}, + Q{&infix:«<=>»}, + Q{&infix:«<=»}, + Q{&infix:«<»}, + Q{&infix:«=>»}, + Q{&infix:«>=»}, + Q{&infix:«>»}, + Q{&infix:«~<»}, + Q{&infix:«~>»}, + Q{&is-prime}, + Q{&item}, + Q{&join}, + Q{&keys}, + Q{&kv}, + Q{&last}, + Q{&lastcall}, + Q{&lc}, + Q{&leave}, + Q{&lines}, + Q{&link}, + Q{&list}, + Q{&log}, + Q{&log10}, + Q{&lsb}, + Q{&make}, + Q{&map}, + Q{&max}, + Q{&min}, + Q{&minmax}, + Q{&mix}, + Q{&mkdir}, + Q{&move}, + Q{&msb}, + Q{&next}, + Q{&nextcallee}, + Q{&nextsame}, + Q{&nextwith}, + Q{&nodemap}, + Q{&none}, + Q{¬}, + Q{¬e}, + Q{&one}, + Q{&open}, + Q{&ord}, + Q{&ords}, + Q{&pair}, + Q{&pairs}, + Q{&parse-base}, + Q{&parse-names}, + Q{&permutations}, + Q{&pick}, + Q{&pop}, + Q{&postcircumfix:<[ ]>}, + Q{&postcircumfix:<[; ]>}, + Q{&postcircumfix:<{ }>}, + Q{&postcircumfix:<{; }>}, + Q{&postfix:<++>}, + Q{&postfix:<-->}, + Q{&postfix:}, + Q{&postfix:<ⁿ>}, + Q{&postfix:<⚛++>}, + Q{&postfix:<⚛-->}, + Q{&prefix:}, + Q{&prefix:<++>}, + Q{&prefix:<++⚛>}, + Q{&prefix:<+>}, + Q{&prefix:<+^>}, + Q{&prefix:<-->}, + Q{&prefix:<--⚛>}, + Q{&prefix:<->}, + Q{&prefix:}, + Q{&prefix:}, + Q{&prefix:<^>}, + Q{&prefix:}, + Q{&prefix:}, + Q{&prefix:}, + Q{&prefix:}, + Q{&prefix:<|>}, + Q{&prefix:<~>}, + Q{&prefix:<~^>}, + Q{&prefix:<−>}, + Q{&prefix:<⚛>}, + Q{&prepend}, + Q{&print}, + Q{&printf}, + Q{&proceed}, + Q{&produce}, + Q{&prompt}, + Q{&push}, + Q{&put}, + Q{&rand}, + Q{&redo}, + Q{&reduce}, + Q{&rename}, + Q{&repeated}, + Q{&return}, + Q{&return-rw}, + Q{&reverse}, + Q{&rindex}, + Q{&rmdir}, + Q{&roll}, + Q{&roots}, + Q{&rotate}, + Q{&round}, + Q{&roundrobin}, + Q{&run}, + Q{&samecase}, + Q{&samemark}, + Q{&samewith}, + Q{&say}, + Q{&sec}, + Q{&sech}, + Q{&set}, + Q{&shell}, + Q{&shift}, + Q{&sign}, + Q{&signal}, + Q{&sin}, + Q{&sinh}, + Q{&sleep}, + Q{&sleep-timer}, + Q{&sleep-until}, + Q{&slip}, + Q{&slurp}, + Q{&so}, + Q{&sort}, + Q{&splice}, + Q{&split}, + Q{&sprintf}, + Q{&spurt}, + Q{&sqrt}, + Q{&squish}, + Q{&srand}, + Q{&subbuf-rw}, + Q{&substr}, + Q{&substr-rw}, + Q{&succeed}, + Q{&sum}, + Q{&symlink}, + Q{&take}, + Q{&take-rw}, + Q{&tan}, + Q{&tanh}, + Q{&tc}, + Q{&tclc}, + Q{&term:}, + Q{&term: