Skip to content

Commit

Permalink
Revert "Merge pull request #3500 from vrurg/rakudo_3499"
Browse files Browse the repository at this point in the history 
This reverts commit d43261d, reversing
changes made to 8b70bfb.
  • Loading branch information
@Altai-man
Altai-man committed May 1, 2020
1 parent 0dc04da commit 7fd0a25
Show file tree
Hide file tree
Showing 4 changed files with 131 additions and 189 deletions.
191 changes: 95 additions & 96 deletions src/Perl6/Metamodel/Dispatchers.nqp
View file
Expand Up @@ -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.
Expand All @@ -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 {
Expand All @@ -128,8 +96,17 @@ class Perl6::Metamodel::MethodDispatcher is Perl6::Metamodel::BaseDispatcher {

method vivify_for($sub, $lexpad, $args) {
my $obj := $lexpad<self>;
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))
}

Expand All @@ -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
Expand All @@ -154,41 +130,64 @@ 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<self>;
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 }
method invocant() { $!invocant }
}

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);
}
}
1 change: 0 additions & 1 deletion src/Perl6/Metamodel/MultiMethodContainer.nqp
View file
Expand Up @@ -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);
}
Expand Down
16 changes: 0 additions & 16 deletions src/Perl6/bootstrap.c/BOOTSTRAP.nqp
View file
Expand Up @@ -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');
Expand Down Expand Up @@ -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);
Expand Down Expand Up @@ -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);
Expand Down

0 comments on commit 7fd0a25

Please sign in to comment.