-
-
Notifications
You must be signed in to change notification settings - Fork 373
/
Signature.pm
114 lines (100 loc) · 3.58 KB
/
Signature.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
augment class Signature {
method ACCEPTS(Signature) {
die("Sorry, smart-matching a Signature against a Signature is not yet implemented.");
}
method ACCEPTS(Callable) {
die("Sorry, smart-matching a Callable against a Signature is not yet implemented.");
}
method ACCEPTS(Capture $c) {
my $result = Bool::False;
try {
self!BIND($c);
$result = Bool::True;
}
$result
}
method ACCEPTS($any) {
my $result = Bool::False;
try {
self!BIND((|$any).Capture);
$result = Bool::True;
}
$result
}
method perl() {
my @parts = gather {
take ':(';
my $sep = '';
my $last_was_multi_inv = True;
for $.params -> $param {
# First, separator, if any.
if $last_was_multi_inv && !$param.multi_invocant { $sep = ';; ' }
take ~$sep;
$sep = ', ';
# First the type.
my $name = $param.name;
if !$param.slurpy {
my $sigil = $name.substr(0, 1);
my $perl = $param.type.perl;
if $sigil eq '$' {
take $perl ~ ' ';
}
elsif $sigil eq '@' {
if $perl ne 'Positional' {
take $perl.substr(11, $perl.chars - 12) ~ ' ';
}
}
elsif $sigil eq '%' {
if $perl ne 'Associative' {
take $perl.substr(12, $perl.chars - 13) ~ ' ';
}
}
elsif $perl.substr(0, 8) eq 'Callable' {
if $perl ne 'Callable' {
take $perl.substr(9, $perl.chars - 10) ~ ' ';
}
}
else {
take $perl ~ ' ';
}
}
# Any type captures.
for @($param.type_captures) -> $name {
take '::' ~ $name ~ ' ';
}
# Slurpiness, namedness, then the name.
if $param.slurpy { take '*' }
if $param.capture { take '|' }
if $param.parcel { take '\|' }
my @names = @($param.named_names);
for @names -> $name {
take ':' ~ $name ~ '(';
}
take $name;
take ')' x +@names;
# Optionality.
if $param.optional && !$param.named && !$param.default { take '?' }
elsif !$param.optional && $param.named && !$param.slurpy { take '!' }
# Any constraints?
my $cons_perl = $param.constraints.perl;
if $cons_perl ne 'Bool::True' {
take ' where ' ~ $cons_perl;
}
# Any sub-signature?
if $param.signature {
take ' ' ~ $param.signature.perl.substr(1);
}
# Default.
if $param.default {
take ' = ' ~ $param.default.perl;
}
# Invocant/multi invocant marking.
if $param.invocant { $sep = ': '; }
$last_was_multi_inv = $param.multi_invocant;
}
take ')';
};
return @parts.join('');
}
}
# vim: ft=perl6