From 7fd0a252101739a184e4f4a1bb11e06b9f324903 Mon Sep 17 00:00:00 2001 From: Altai-man Date: Fri, 1 May 2020 16:58:42 +0300 Subject: [PATCH] Revert "Merge pull request #3500 from vrurg/rakudo_3499" This reverts commit d43261de95ec8a65460e769e9e0c11b1738c1992, reversing changes made to 8b70bfb843e20bae39c452e9768654df04ac3236. --- src/Perl6/Metamodel/Dispatchers.nqp | 191 +++++++++---------- src/Perl6/Metamodel/MultiMethodContainer.nqp | 1 - src/Perl6/bootstrap.c/BOOTSTRAP.nqp | 16 -- src/core.c/Routine.pm6 | 112 ++++------- 4 files changed, 131 insertions(+), 189 deletions(-) diff --git a/src/Perl6/Metamodel/Dispatchers.nqp b/src/Perl6/Metamodel/Dispatchers.nqp index b6de877ffe8..e2e00042116 100644 --- a/src/Perl6/Metamodel/Dispatchers.nqp +++ b/src/Perl6/Metamodel/Dispatchers.nqp @@ -3,25 +3,40 @@ class Perl6::Metamodel::BaseDispatcher { has $!idx; has $!next_dispatcher; # The dispatcher we must pass control to when own queue exhausts - method candidates() { @!candidates } + method candidates() { @!candidates } - method exhausted() { $!idx >= +@!candidates && (!nqp::isconcrete($!next_dispatcher) || $!next_dispatcher.exhausted()) } + method exhausted() { $!idx >= +@!candidates && (!nqp::isconcrete($!next_dispatcher) || $!next_dispatcher.exhausted()) } - method last_candidate() { $!idx >= +@!candidates } + method last() { @!candidates := [] } - method last() { @!candidates := [] } - - method set_next_dispatcher($next_dispatcher) - { $!next_dispatcher := $next_dispatcher } + method set_next_dispatcher($next_dispatcher) { $!next_dispatcher := $next_dispatcher } # Wrapper-like dispatchers don't set dispatcher for the last candidate. method is_wrapper_like() { 0 } method get_call() { # Returns [$call, $is_dispatcher] - my $call := @!candidates[$!idx]; - ++$!idx; - my $next_disp := self.set_call_dispatcher($call); - [$call, $next_disp] + my $call := @!candidates[$!idx++]; + + my $disp; + try { + # XXX Are there any better way to determine a invocation handler with own dispatcher in $!dispatcher? + $disp := nqp::getattr($call, nqp::what($call), '$!dispatcher'); # If $call is a handler. But there must be better way to deal with this. + $disp := nqp::null() unless nqp::istype($disp, Perl6::Metamodel::BaseDispatcher); # Protect from multi-Routine dispatcher attribute + } + if nqp::isconcrete($disp) { + return [$disp, 1]; + } + else { + my $last_candidate := $!idx >= +@!candidates; + if $last_candidate && nqp::isconcrete($!next_dispatcher) { + nqp::setdispatcherfor($!next_dispatcher, $call); + $!next_dispatcher := nqp::null(); + } + else { + nqp::setdispatcherfor(self, $call) unless $last_candidate && self.is_wrapper_like; + } + } + [$call, 0] } # By default we just set next call dispatcher to ourselves. @@ -40,79 +55,32 @@ class Perl6::Metamodel::BaseDispatcher { } method call_with_args(*@pos, *%named) { - if self.last_candidate { - if $!next_dispatcher { - $!next_dispatcher.call_with_args(|@pos, |%named); - } - else { - die(self.HOW.shortname(self) ~ " is already exhausted"); - } + my @call := self.get_call; + if @call[1] { + return @call[0].enter_with_args(@pos, %named, :next_dispatcher(self)); + } + if self.has_invocant { + my $inv := self.invocant; + @call[0]($inv, |@pos, |%named); } else { - my @call := self.get_call; - my $*NEXT-DISPATCHER := @call[1]; - if self.has_invocant { - @call[0](self.invocant, |@pos, |%named); - } - else { - @call[0](|@pos, |%named); - } + @call[0](|@pos, |%named); } } method call_with_capture($capture) { - if self.last_candidate { - if $!next_dispatcher { - $!next_dispatcher.call_with_capture($capture) - } - else { - die(self.HOW.shortname(self) ~ " is already exhausted"); - } - } - else { - my @call := self.get_call; - my $*NEXT-DISPATCHER := @call[1]; - nqp::invokewithcapture(@call[0], $capture); + my @call := self.get_call; + if @call[1] { # Got a dispatcher + return @call[0].enter_with_capture($capture, :next_dispatcher(self)); } + nqp::invokewithcapture(@call[0], $capture); } method shift_callee() { my $callee := @!candidates[$!idx]; - ++$!idx; + $!idx := $!idx + 1; nqp::decont($callee) } - - method add_from_mro(@methods, $class, $sub, :$skip_first = 0) { - my @mro := nqp::can($class.HOW, 'mro_unhidden') - ?? $class.HOW.mro_unhidden($class) - !! $class.HOW.mro($class); - my $name := $sub.name; - my %seen; - for @mro { - my $mt := nqp::hllize($_.HOW.method_table($_)); - if nqp::existskey($mt, $name) { - my $meth := nqp::atkey($mt, $name); - if $meth.is_dispatcher { - my $proto_pkg_id := nqp::objectid($meth.package); - # Skip proto if it's been seen before. Prevents from multiple dispatching over the same multi - # candidates. - $meth := nqp::null() if %seen{$proto_pkg_id}; - %seen{$proto_pkg_id} := 1 - } - # Skipping the first method obtained from MRO because either it should have been handled already by - # vivify_for. - nqp::if( - nqp::isgt_i($skip_first, 0), - (--$skip_first), - nqp::unless( - nqp::isnull($meth), - nqp::push(@methods, $meth) - ) - ) - } - } - @methods - } } class Perl6::Metamodel::MethodDispatcher is Perl6::Metamodel::BaseDispatcher { @@ -128,8 +96,17 @@ class Perl6::Metamodel::MethodDispatcher is Perl6::Metamodel::BaseDispatcher { method vivify_for($sub, $lexpad, $args) { my $obj := $lexpad; - my $class := nqp::getlexrel($lexpad, '::?CLASS'); - my @methods := self.add_from_mro([], $class, $sub); + my $name := $sub.name; + my @mro := nqp::can($obj.HOW, 'mro_unhidden') + ?? $obj.HOW.mro_unhidden($obj) + !! $obj.HOW.mro($obj); + my @methods; + for @mro { + my %mt := nqp::hllize($_.HOW.method_table($_)); + if nqp::existskey(%mt, $name) { + @methods.push(%mt{$name}); + } + } self.new(:candidates(@methods), :obj($obj), :idx(1)) } @@ -141,11 +118,10 @@ class Perl6::Metamodel::MultiDispatcher is Perl6::Metamodel::BaseDispatcher { has $!has_invocant; has $!invocant; - method new(:@candidates, :$idx, :$invocant, :$has_invocant, :$next_dispatcher) { + method new(:@candidates, :$idx, :$invocant, :$has_invocant) { my $disp := nqp::create(self); nqp::bindattr($disp, Perl6::Metamodel::BaseDispatcher, '@!candidates', @candidates); nqp::bindattr($disp, Perl6::Metamodel::BaseDispatcher, '$!idx', $idx); - nqp::bindattr($disp, Perl6::Metamodel::BaseDispatcher, '$!next_dispatcher', $next_dispatcher); nqp::bindattr($disp, Perl6::Metamodel::MultiDispatcher, '$!invocant', $invocant); nqp::bindattr($disp, Perl6::Metamodel::MultiDispatcher, '$!has_invocant', $has_invocant); $disp @@ -154,19 +130,10 @@ class Perl6::Metamodel::MultiDispatcher is Perl6::Metamodel::BaseDispatcher { method vivify_for($sub, $lexpad, $args) { my $disp := $sub.dispatcher(); my $has_invocant := nqp::existskey($lexpad, 'self'); - my @cands := $disp.find_best_dispatchee($args, 1); my $invocant := $has_invocant && $lexpad; - my $next_dispatcher := nqp::getlexreldyn($lexpad, '$*NEXT-DISPATCHER'); - # The first candidate has already been invoked, throw it away from the list; - # If called in a method then only take control if MethodDispatcher is in charge. - if $has_invocant && !nqp::isconcrete($next_dispatcher) { - my $class := nqp::getlexrel($lexpad, '::?CLASS'); - self.add_from_mro(@cands, $class, $sub, :skip_first(1)); - Perl6::Metamodel::MethodDispatcher.new(:candidates(@cands), :idx(1), :obj($invocant)) - } - else { - self.new(:candidates(@cands), :idx(1), :$invocant, :$has_invocant, :$next_dispatcher) - } + my @cands := $disp.find_best_dispatchee($args, 1); + self.new(:candidates(@cands), :idx(1), :invocant($invocant), + :has_invocant($has_invocant)) } method has_invocant() { $!has_invocant } @@ -174,21 +141,53 @@ class Perl6::Metamodel::MultiDispatcher is Perl6::Metamodel::BaseDispatcher { } class Perl6::Metamodel::WrapDispatcher is Perl6::Metamodel::BaseDispatcher { - method new(:@candidates, :$idx, :$invocant, :$has_invocant, :$next_dispatcher) { + method new(:@candidates, :$idx, :$invocant, :$has_invocant) { my $disp := nqp::create(self); nqp::bindattr($disp, Perl6::Metamodel::BaseDispatcher, '@!candidates', @candidates); nqp::bindattr($disp, Perl6::Metamodel::BaseDispatcher, '$!idx', 1); - nqp::bindattr($disp, Perl6::Metamodel::BaseDispatcher, '$!next_dispatcher', $next_dispatcher); $disp } - method vivify_for($sub, $lexpad, $capture) { - my @candidates := $sub.wrappers; - my $next_dispatcher := nqp::getlexreldyn($lexpad, '$*NEXT-DISPATCHER'); - self.new(:@candidates, :idx(1), :$next_dispatcher) - } - method has_invocant() { 0 } - method invocant() { NQPMu } + method is_wrapper_like() { 1 } + + method add($wrapper) { + self.candidates.unshift($wrapper) + } + + method remove($wrapper) { + my @cands := self.candidates; + my $i := 0; + while $i < +@cands { + if nqp::decont(@cands[$i]) =:= nqp::decont($wrapper) { + nqp::splice(@cands, [], $i, 1); + return 1; + } + $i := $i + 1; + } + return 0; + } + + method get_first($next_dispatcher) { + my $fresh := nqp::clone(self); + $fresh.set_next_dispatcher($next_dispatcher) if $next_dispatcher; + my $first := self.candidates[0]; + nqp::setdispatcherfor($fresh, $first); + $first + } + + # This method is a bridge between Perl6 and NQP. + method enter(*@pos, *%named) { + self.enter_with_args(@pos, %named); + } + + method enter_with_args(@pos, %named, :$next_dispatcher?) { + self.get_first($next_dispatcher)(|@pos, |%named) + } + + method enter_with_capture($capture, :$next_dispatcher?) { + my $first := self.get_first($next_dispatcher); + nqp::invokewithcapture($first, $capture); + } } diff --git a/src/Perl6/Metamodel/MultiMethodContainer.nqp b/src/Perl6/Metamodel/MultiMethodContainer.nqp index 2717395a388..88d88b284dd 100644 --- a/src/Perl6/Metamodel/MultiMethodContainer.nqp +++ b/src/Perl6/Metamodel/MultiMethodContainer.nqp @@ -95,7 +95,6 @@ role Perl6::Metamodel::MultiMethodContainer { nqp::hash('T', $obj)); $proto.set_name($name); $proto.add_dispatchee($code); - $proto.'!set_package'($obj); self.add_method($obj, $name, $proto); nqp::push(@new_protos, $proto); } diff --git a/src/Perl6/bootstrap.c/BOOTSTRAP.nqp b/src/Perl6/bootstrap.c/BOOTSTRAP.nqp index f428fd01bd1..ced2b1cb196 100644 --- a/src/Perl6/bootstrap.c/BOOTSTRAP.nqp +++ b/src/Perl6/bootstrap.c/BOOTSTRAP.nqp @@ -2253,19 +2253,12 @@ BEGIN { Routine.HOW.add_attribute(Routine, Attribute.new(:name<$!onlystar>, :type(int), :package(Routine))); Routine.HOW.add_attribute(Routine, scalar_attr('@!dispatch_order', List, Routine, :!auto_viv_container)); Routine.HOW.add_attribute(Routine, Attribute.new(:name<$!dispatch_cache>, :type(Mu), :package(Routine))); - Routine.HOW.add_attribute(Routine, Attribute.new(:name<$!wrappers>, :type(Mu), :package(Routine))); Routine.HOW.add_method(Routine, 'is_dispatcher', nqp::getstaticcode(sub ($self) { my $dc_self := nqp::decont($self); my $disp_list := nqp::getattr($dc_self, Routine, '@!dispatchees'); nqp::hllboolfor(nqp::defined($disp_list), "Raku"); })); - Routine.HOW.add_method(Routine, 'is_wrapped', nqp::getstaticcode(sub ($self) { - nqp::hllboolfor( - nqp::defined( - nqp::getattr(nqp::decont($self), Routine, '$!wrappers')), - "Raku"); - })); Routine.HOW.add_method(Routine, 'add_dispatchee', nqp::getstaticcode(sub ($self, $dispatchee) { my $dc_self := nqp::decont($self); my $disp_list := nqp::getattr($dc_self, Routine, '@!dispatchees'); @@ -2299,10 +2292,6 @@ BEGIN { nqp::getattr(nqp::decont($self), Routine, '@!dispatchees') })); - Routine.HOW.add_method(Routine, 'wrappers', nqp::getstaticcode(sub ($self) { - nqp::hllize(nqp::getattr(nqp::decont($self), - Routine, '$!wrappers')) - })); Routine.HOW.add_method(Routine, '!configure_positional_bind_failover', nqp::getstaticcode(sub ($self, $Positional, $PositionalBindFailover) { nqp::bindhllsym('Raku', 'MD_Pos', $Positional); @@ -3256,11 +3245,6 @@ BEGIN { nqp::bindattr_i($dcself, Routine, '$!onlystar', 1); $dcself })); - Routine.HOW.add_method(Routine, '!set_package', nqp::getstaticcode(sub ($self, $package) { - my $dcself := nqp::decont($self); - nqp::bindattr($dcself, Routine, '$!package', $package); - $dcself - })); Routine.HOW.compose_repr(Routine); Routine.HOW.set_multi_invocation_attrs(Routine, Routine, '$!onlystar', '$!dispatch_cache'); Routine.HOW.compose_invocation(Routine); diff --git a/src/core.c/Routine.pm6 b/src/core.c/Routine.pm6 index d348df4704f..a05f560fdfe 100644 --- a/src/core.c/Routine.pm6 +++ b/src/core.c/Routine.pm6 @@ -79,36 +79,34 @@ my class Routine { # declared in BOOTSTRAP method soft( --> Nil ) { } - my class WrapHandle { - has &.wrapper; - has &.wrappee; - - method restore { - &.wrappee.unwrap(self) - } - } - method wrap(&wrapper) { - my \wrp := nqp::clone(&wrapper); - my $handle = WrapHandle.new: :wrapper(wrp), :wrappee(self); - - if $*W { - my sub wrp-fixup() { self!do_wrap(wrp) }; - $*W.add_object_if_no_sc(wrp); - $*W.add_object_if_no_sc(&wrp-fixup); - $*W.add_fixup_task( - :fixup_ast( - QAST::Op.new(:op, QAST::WVal.new(:value(&wrp-fixup))) - )); + my class WrapHandle { + has $!dispatcher; + has $!wrapper; + method restore() { + nqp::hllbool($!dispatcher.remove($!wrapper)); + } } - else { - self!do_wrap(wrp); + my role Wrapped { + has $!dispatcher; + method UNSHIFT_WRAPPER(&wrapper) { + # Add candidate. + $!dispatcher := WrapDispatcher.new() + unless nqp::isconcrete($!dispatcher); + $!dispatcher.add(&wrapper); + + # Return a handle. + my $handle := nqp::create(WrapHandle); + nqp::bindattr($handle, WrapHandle, '$!dispatcher', $!dispatcher); + nqp::bindattr($handle, WrapHandle, '$!wrapper', &wrapper); + $handle + } + method CALL-ME(|c) is raw { + $!dispatcher.enter(|c); + } + method soft(--> True) { } } - $handle - } - - method !do_wrap(\wrp) { # We can't wrap a hardened routine (that is, one that's been # marked inlinable). if nqp::istype(self, HardRoutine) { @@ -116,60 +114,22 @@ my class Routine { # declared in BOOTSTRAP "use the 'soft' pragma to avoid marking routines as hard."; } - # Use clone to make it possible for user to use same wrapper for different routines. - my \wrp-do := nqp::getattr(wrp, Code, '$!do'); - if nqp::defined($!wrappers) { - # Insert next to onlywrap - nqp::splice($!wrappers, nqp::list(wrp), 1, 0); - } - else { - my \onlywrap := sub onlywrap(|) is raw is hidden-from-backtrace { - $/ := nqp::getlexcaller('$/'); - my Mu $dispatcher := Metamodel::WrapDispatcher.vivify_for(self, nqp::ctx(), nqp::usecapture()); - $*DISPATCHER := $dispatcher; - $dispatcher.call_with_capture(nqp::usecapture()) - }; - # onlywrap.set_name(self.name); - my \me = nqp::clone(self); - if $*W { - $*W.add_object_if_no_sc(me) - } - # Make static code point to the cloned object until original is fully unwrapped. If not done we end up with - # static code on `me` pointing at the original Routine instance, which has $!do from onlywrap. It results in - # dispatchers vivified from `me` receive onlywrap as $sub parameter. - nqp::setcodeobj(nqp::getattr(me, Code, '$!do'), me); - $!wrappers := nqp::list(onlywrap, wrp, me); - my \onlywrap-do := nqp::getattr(onlywrap, Code, '$!do'); - nqp::setcodeobj(onlywrap-do, self); - nqp::bindattr(self, Code, '$!do', onlywrap-do); + # If we're not wrapped already, do the initial dispatcher + # creation. + unless nqp::istype(self, Wrapped) { + my $orig = self.clone(); + self does Wrapped; + $!onlystar = 0; # disable optimization if no body there + self.UNSHIFT_WRAPPER($orig); } + + # Add this wrapper. + self.UNSHIFT_WRAPPER(&wrapper); } method unwrap($handle) { - X::Routine::Unwrap.new.throw unless nqp::istype($handle, WrapHandle); - my $succeed; - if $!wrappers { - my $idx = 0; - my $count = nqp::elems($!wrappers) - 1; - my &wrapper := nqp::decont($handle.wrapper); - while ++$idx < $count { - my &w := nqp::atpos($!wrappers, $idx); - if &w === &wrapper { - # Also strip off all wrappers put on top of this. - nqp::splice($!wrappers, nqp::list(), $idx, 1); - $succeed := 1; - last; - } - } - if $succeed && $count == 2 { - # We just have removed the last user wrapper, restore the original code. - my \orig-do := nqp::getattr(nqp::atpos($!wrappers, 1), Code, '$!do'); - nqp::bindattr(self, Code, '$!do', orig-do); - nqp::setcodeobj(orig-do, self); - $!wrappers := nqp::null(); - } - } - X::Routine::Unwrap.new.throw unless $succeed; + $handle.can('restore') && $handle.restore() || + X::Routine::Unwrap.new.throw } method package() { $!package }