-
-
Notifications
You must be signed in to change notification settings - Fork 373
/
Routine.pm
120 lines (104 loc) · 3.32 KB
/
Routine.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
116
117
118
119
120
my class X::Routine::Unwrap { ... }
my role HardRoutine {
method soft() { False }
}
my role SoftRoutine {
method soft() { True }
}
my class Routine {
method of() { self.signature.returns }
method returns() { self.signature.returns }
method rw() { $!rw }
method onlystar() { nqp::p6bool($!onlystar) }
method assuming($r: *@curried_pos, *%curried_named) {
return sub CURRIED (*@pos, *%named) {
$r(|@curried_pos, |@pos, |%curried_named, |%named)
}
}
method candidates() {
self.is_dispatcher ??
nqp::p6type($!dispatchees) !!
(self,)
}
method cando(Capture $c) {
my $disp;
if self.is_dispatcher {
$disp := self;
}
else {
$disp := nqp::create(self);
nqp::bindattr($disp, Routine, '$!dispatchees', nqp::list(self));
}
# Call this lexical sub to get rid of 'self' in the signature.
sub checker(|) {
my Mu $cap := pir::find_lex__Ps('call_sig');
nqp::p6type($disp.find_best_dispatchee($cap, 1))
}
checker(|$c);
}
method multi() {
self.dispatcher.defined
}
multi method perl(Routine:D:) {
my $perl = self.^name.lc();
if self.name() -> $n {
$perl ~= " $n";
}
$perl ~= self.signature().perl.substr(1);
$perl ~= ' { ... }';
$perl
}
method soft() {
Mu
}
method wrap(&wrapper) {
my class WrapHandle {
has $!dispatcher;
has $!wrapper;
method restore() {
nqp::p6bool($!dispatcher.remove($!wrapper));
}
}
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 postcircumfix:<( )>($c) {
$!dispatcher.enter(|$c);
}
method soft() { True }
}
# We can't wrap a hardened routine (that is, one that's been
# marked inlinable).
if nqp::istype(self, HardRoutine) {
die "Cannot wrap a HardRoutine, since it may have been inlined; " ~
"use the 'soft' pragma to avoid marking routines as hard.";
}
# If we're not wrapped already, do the initial dispatcher
# creation.
unless nqp::istype(self, Wrapped) {
my $orig = self.clone();
self does Wrapped;
self.UNSHIFT_WRAPPER($orig);
}
# Add this wrapper.
self.UNSHIFT_WRAPPER(&wrapper);
}
method unwrap($handle) {
$handle.can('restore') && $handle.restore() ||
X::Routine::Unwrap.new.throw
}
method yada() {
nqp::p6bool(nqp::getattr_i(self, Routine, '$!yada'))
}
method package() { $!package }
}