forked from pmichaud/pmtcl
-
Notifications
You must be signed in to change notification settings - Fork 0
/
Actions.pm
91 lines (78 loc) · 2.75 KB
/
Actions.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
use NQPHLL;
class StringGlob::Actions is HLL::Actions {
method TOP($/) {
my $ast := $<termish>.ast;
# globs are anchored on both ends.
$ast.unshift(PAST::Regex.new( :pasttype('anchor'), :subtype('bos'), :node($/) ));
$ast.push(PAST::Regex.new( :pasttype('anchor'), :subtype('eos'), :node($/) ));
my $past := buildsub( $ast );
$past.node($/);
make $past;
}
method termish($/) {
my $past := PAST::Regex.new( :pasttype('concat'), :node($/) );
my $lastlit := 0;
for $<noun> {
my $ast := $_.ast;
if $ast {
if $lastlit && $ast.pasttype eq 'literal'
&& !PAST::Node.ACCEPTS($ast[0]) {
$lastlit[0] := $lastlit[0] ~ $ast[0];
}
else {
$past.push($ast);
$lastlit := $ast.pasttype eq 'literal'
&& !PAST::Node.ACCEPTS($ast[0])
?? $ast !! 0;
}
}
}
make $past;
}
method atom($/) {
my $past := $<metachar>
?? $<metachar>.ast
!! PAST::Regex.new( ~$/, :pasttype<literal>, :node($/) );
make $past;
}
method metachar:sym<*>($/) {
my $ast := PAST::Regex.new( :pasttype<quant>, :node($/) );
$ast.unshift(PAST::Regex.new( :pasttype<charclass>, :subtype<.>, :node($/)));
make $ast;
}
method metachar:sym<?>($/) {
make PAST::Regex.new( :pasttype<charclass>, :subtype<.>, :node($/) );
}
method metachar:sym<back>($/) {
make PAST::Regex.new( ~$<char>, :pasttype<literal>, :node($/) );
}
method metachar:sym<[>($/) {
my $str := '';
for $<charspec> {
if $_[1] {
my $a := nqp::ord($_[0]);
my $b := nqp::ord(~$_[1][0]);
while $a <= $b { $str := $str ~ nqp::chr($a); $a++; }
}
else { $str := $str ~ $_[0]; }
}
my $past := PAST::Regex.new( $str, :pasttype<enumcharlist>, :node($/) );
make $past;
}
method backslash:sym<w>($/) {
}
sub buildsub($rpast, $block = PAST::Block.new() ) {
$rpast := PAST::Regex.new(
PAST::Regex.new( :pasttype('scan') ),
$rpast,
PAST::Regex.new( :pasttype('pass') ),
:pasttype('concat'),
);
unless $block.symbol('$¢') { $block.symbol('$¢', :scope<lexical>); }
unless $block.symbol('$/') { $block.symbol('$/', :scope<lexical>); }
$block.push($rpast);
$block.blocktype('method');
$block;
}
}
# vim: expandtab shiftwidth=4 ft=perl6: