-
-
Notifications
You must be signed in to change notification settings - Fork 373
/
Match.pm
97 lines (88 loc) · 2.21 KB
/
Match.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
my class Match is Capture is Cool {
has $.orig;
has int $.from;
has int $.to;
has $.CURSOR;
has $.ast;
multi method Str(Match:D:) {
$!to > $!from ?? $!orig.substr($!from, $!to-$!from) !! ''
}
multi method Numeric(Match:D:) {
self.Str.Numeric
}
multi method Bool(Match:D:) {
$!to >= $!from
}
multi method ACCEPTS(Match:D: Any $) { self }
method prematch(Match:D:) {
$!orig.substr(0, $!from);
}
method postmatch(Match:D:) {
$!orig.substr($!to)
}
method caps(Match:D:) {
my @caps;
for self.pairs -> $p {
if $p.value ~~ Parcel {
@caps.push: $p.key => $_ for $p.value.list
} else {
@caps.push: $p;
}
}
@caps.sort: -> $p { $p.value.from }
}
method chunks(Match:D:) {
my $prev = $!from;
gather {
for self.caps {
if .value.from > $prev {
take '~' => $!orig.substr($prev, .value.from - $prev)
}
take $_;
$prev = .value.to;
}
take '~' => $!orig.substr($prev, $!to - $prev) if $prev < $!to;
}
}
multi method perl(Match:D:) {
my %attrs;
for <orig from to ast list hash> {
%attrs{$_} = self."$_"().perl;
}
'Match.new('
~ %attrs.fmt('%s => %s', ', ')
~ ')'
}
multi method gist (Match:D: $d = 0) {
return "#<failed match>" unless self;
my $s = ' ' x ($d + 1);
my $r = ("=> " if $d) ~ "\x[FF62]{self}\x[FF63]\n";
for @.caps {
$r ~= $s ~ (.key // '?') ~ ' ' ~ .value.gist($d + 1)
}
$r;
}
method make(Match:D: Mu $ast) {
$!ast = $ast;
nqp::bindattr(
nqp::p6decont(self.CURSOR),
Cursor,
'$!ast',
$ast
);
}
}
sub make(Mu $ast) {
nqp::bindattr(
nqp::p6decont(pir::find_caller_lex__Ps('$/')),
Match,
'$!ast',
$ast
);
nqp::bindattr(
nqp::p6decont(pir::find_caller_lex__Ps('$/').CURSOR),
Cursor,
'$!ast',
$ast
);
}