-
-
Notifications
You must be signed in to change notification settings - Fork 373
/
Dispatchers.pm
115 lines (98 loc) · 3.24 KB
/
Dispatchers.pm
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
class Perl6::Metamodel::BaseDispatcher {
has @!candidates;
has $!idx;
method candidates() { @!candidates }
method exhausted() { $!idx >= +@!candidates }
method last() { @!candidates := [] }
method call_with_args(*@pos, *%named) {
my $call := @!candidates[$!idx];
$!idx := $!idx + 1;
if self.has_invocant {
my $inv := self.invocant;
pir::perl6_set_dispatcher_for_callee__vP(self);
$call($inv, |@pos, |%named);
}
else {
pir::perl6_set_dispatcher_for_callee__vP(self);
$call(|@pos, |%named);
}
}
method call_with_capture($capture) {
# Extract parts of the capture.
my @pos;
my %named;
my $i := 0;
while $i < nqp::elems($capture) {
@pos[$i] := $capture[$i];
$i := $i + 1;
}
for pir::getattribute__PPs($capture, 'named') {
%named{$_} := $capture{$_};
}
# Call.
my $call := @!candidates[$!idx];
$!idx := $!idx + 1;
pir::perl6_set_dispatcher_for_callee__vP(self);
$call(|@pos, |%named);
}
}
class Perl6::Metamodel::MethodDispatcher is Perl6::Metamodel::BaseDispatcher {
has $!obj;
method vivify_for($sub, $lexpad) {
my $obj := $lexpad<self>;
my $name := $sub.name;
my @mro := $obj.HOW.mro($obj);
my @methods;
for @mro {
my %mt := $_.HOW.method_table($_);
if pir::exists(%mt, $name) {
@methods.push(%mt{$name});
}
}
self.new(:candidates(@methods), :obj($obj), :idx(1))
}
method has_invocant() { 1 }
method invocant() { $!obj }
}
class Perl6::Metamodel::MultiDispatcher is Perl6::Metamodel::BaseDispatcher {
has $!has_invocant;
has $!invocant;
method vivify_for($sub, $lexpad) {
my $disp := $sub.dispatcher();
my $args := $lexpad<call_sig>;
my $has_invocant := pir::exists($lexpad, 'self');
my $invocant := $has_invocant && $lexpad<self>;
my @cands := pir::perl6_get_matching_multis__PPP($disp, $args);
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() {
self.bless(:candidates([]), :idx(1))
}
method has_invocant() { 0 }
method add($wrapper) {
self.candidates.unshift($wrapper)
}
method remove($wrapper) {
my @cands := self.candidates;
my $i := 0;
while $i < +@cands {
if pir::perl6_decontainerize__PP(@cands[$i]) =:= pir::perl6_decontainerize__PP($wrapper) {
nqp::splice(@cands, [], $i, 1);
return 1;
}
$i := $i + 1;
}
return 0;
}
method enter(*@pos, *%named) {
my $fresh := pir::repr_clone__PP(self);
my $first := self.candidates[0];
pir::perl6_set_dispatcher_for_callee__vP($fresh);
$first(|@pos, |%named)
}
}