line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Text::Xslate::Parser; |
2
|
172
|
|
|
172
|
|
222871
|
use Mouse; |
|
172
|
|
|
|
|
130245
|
|
|
172
|
|
|
|
|
1005
|
|
3
|
|
|
|
|
|
|
|
4
|
172
|
|
|
172
|
|
48869
|
use Scalar::Util (); |
|
172
|
|
|
|
|
370
|
|
|
172
|
|
|
|
|
3165
|
|
5
|
|
|
|
|
|
|
|
6
|
172
|
|
|
172
|
|
93445
|
use Text::Xslate::Symbol; |
|
172
|
|
|
|
|
18277
|
|
|
172
|
|
|
|
|
7578
|
|
7
|
172
|
|
|
|
|
30030
|
use Text::Xslate::Util qw( |
8
|
|
|
|
|
|
|
$DEBUG |
9
|
|
|
|
|
|
|
$STRING $NUMBER |
10
|
|
|
|
|
|
|
is_int any_in |
11
|
|
|
|
|
|
|
neat |
12
|
|
|
|
|
|
|
literal_to_value |
13
|
|
|
|
|
|
|
make_error |
14
|
|
|
|
|
|
|
p |
15
|
172
|
|
|
172
|
|
1097
|
); |
|
172
|
|
|
|
|
316
|
|
16
|
|
|
|
|
|
|
|
17
|
172
|
|
|
172
|
|
1036
|
use constant _DUMP_PROTO => scalar($DEBUG =~ /\b dump=proto \b/xmsi); |
|
172
|
|
|
|
|
319
|
|
|
172
|
|
|
|
|
12186
|
|
18
|
172
|
|
|
172
|
|
868
|
use constant _DUMP_TOKEN => scalar($DEBUG =~ /\b dump=token \b/xmsi); |
|
172
|
|
|
|
|
327
|
|
|
172
|
|
|
|
|
2016264
|
|
19
|
|
|
|
|
|
|
|
20
|
|
|
|
|
|
|
our @CARP_NOT = qw(Text::Xslate::Compiler Text::Xslate::Symbol); |
21
|
|
|
|
|
|
|
|
22
|
|
|
|
|
|
|
my $CODE = qr/ (?: $STRING | [^'"] ) /xms; |
23
|
|
|
|
|
|
|
my $COMMENT = qr/\# [^\n;]* (?= [;\n] | \z)/xms; |
24
|
|
|
|
|
|
|
|
25
|
|
|
|
|
|
|
# Operator tokens that the parser recognizes. |
26
|
|
|
|
|
|
|
# All the single characters are tokenized as an operator. |
27
|
|
|
|
|
|
|
my $OPERATOR_TOKEN = sprintf '(?:%s|[^ \t\r\n])', join('|', map{ quotemeta } qw( |
28
|
|
|
|
|
|
|
... |
29
|
|
|
|
|
|
|
.. |
30
|
|
|
|
|
|
|
== != <=> <= >= |
31
|
|
|
|
|
|
|
<< >> |
32
|
|
|
|
|
|
|
+= -= *= /= %= ~= |
33
|
|
|
|
|
|
|
&&= ||= //= |
34
|
|
|
|
|
|
|
~~ =~ |
35
|
|
|
|
|
|
|
|
36
|
|
|
|
|
|
|
&& || // |
37
|
|
|
|
|
|
|
-> => |
38
|
|
|
|
|
|
|
:: |
39
|
|
|
|
|
|
|
++ -- |
40
|
|
|
|
|
|
|
+| +& +^ +< +> +~ |
41
|
|
|
|
|
|
|
), ','); |
42
|
|
|
|
|
|
|
|
43
|
|
|
|
|
|
|
my %shortcut_table = ( |
44
|
|
|
|
|
|
|
'=' => 'print', |
45
|
|
|
|
|
|
|
); |
46
|
|
|
|
|
|
|
|
47
|
|
|
|
|
|
|
my $CHOMP_FLAGS = qr/-/xms; |
48
|
|
|
|
|
|
|
|
49
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
has identity_pattern => ( |
51
|
|
|
|
|
|
|
is => 'ro', |
52
|
|
|
|
|
|
|
isa => 'RegexpRef', |
53
|
|
|
|
|
|
|
|
54
|
|
|
|
|
|
|
builder => '_build_identity_pattern', |
55
|
|
|
|
|
|
|
init_arg => undef, |
56
|
|
|
|
|
|
|
); |
57
|
|
|
|
|
|
|
|
58
|
|
|
|
|
|
|
sub _build_identity_pattern { |
59
|
182
|
|
|
182
|
|
29605
|
return qr/(?: (?:[A-Za-z_]|\$\~?) [A-Za-z0-9_]* )/xms; |
60
|
|
|
|
|
|
|
} |
61
|
|
|
|
|
|
|
|
62
|
|
|
|
|
|
|
has [qw(compiler engine)] => ( |
63
|
|
|
|
|
|
|
is => 'rw', |
64
|
|
|
|
|
|
|
required => 0, |
65
|
|
|
|
|
|
|
weak_ref => 1, |
66
|
|
|
|
|
|
|
); |
67
|
|
|
|
|
|
|
|
68
|
|
|
|
|
|
|
has symbol_table => ( # the global symbol table |
69
|
|
|
|
|
|
|
is => 'ro', |
70
|
|
|
|
|
|
|
isa => 'HashRef', |
71
|
|
|
|
|
|
|
|
72
|
|
|
|
|
|
|
default => sub{ {} }, |
73
|
|
|
|
|
|
|
|
74
|
|
|
|
|
|
|
init_arg => undef, |
75
|
|
|
|
|
|
|
); |
76
|
|
|
|
|
|
|
|
77
|
|
|
|
|
|
|
has iterator_element => ( |
78
|
|
|
|
|
|
|
is => 'ro', |
79
|
|
|
|
|
|
|
isa => 'HashRef', |
80
|
|
|
|
|
|
|
|
81
|
|
|
|
|
|
|
lazy => 1, |
82
|
|
|
|
|
|
|
builder => '_build_iterator_element', |
83
|
|
|
|
|
|
|
|
84
|
|
|
|
|
|
|
init_arg => undef, |
85
|
|
|
|
|
|
|
); |
86
|
|
|
|
|
|
|
|
87
|
|
|
|
|
|
|
has scope => ( |
88
|
|
|
|
|
|
|
is => 'rw', |
89
|
|
|
|
|
|
|
isa => 'ArrayRef[HashRef]', |
90
|
|
|
|
|
|
|
|
91
|
|
|
|
|
|
|
clearer => 'init_scope', |
92
|
|
|
|
|
|
|
|
93
|
|
|
|
|
|
|
lazy => 1, |
94
|
|
|
|
|
|
|
default => sub{ [ {} ] }, |
95
|
|
|
|
|
|
|
|
96
|
|
|
|
|
|
|
init_arg => undef, |
97
|
|
|
|
|
|
|
); |
98
|
|
|
|
|
|
|
|
99
|
|
|
|
|
|
|
has token => ( |
100
|
|
|
|
|
|
|
is => 'rw', |
101
|
|
|
|
|
|
|
isa => 'Maybe[Object]', |
102
|
|
|
|
|
|
|
|
103
|
|
|
|
|
|
|
init_arg => undef, |
104
|
|
|
|
|
|
|
); |
105
|
|
|
|
|
|
|
|
106
|
|
|
|
|
|
|
has next_token => ( # to peek the next token |
107
|
|
|
|
|
|
|
is => 'rw', |
108
|
|
|
|
|
|
|
isa => 'Maybe[ArrayRef]', |
109
|
|
|
|
|
|
|
|
110
|
|
|
|
|
|
|
init_arg => undef, |
111
|
|
|
|
|
|
|
); |
112
|
|
|
|
|
|
|
|
113
|
|
|
|
|
|
|
has statement_is_finished => ( |
114
|
|
|
|
|
|
|
is => 'rw', |
115
|
|
|
|
|
|
|
isa => 'Bool', |
116
|
|
|
|
|
|
|
|
117
|
|
|
|
|
|
|
init_arg => undef, |
118
|
|
|
|
|
|
|
); |
119
|
|
|
|
|
|
|
|
120
|
|
|
|
|
|
|
has following_newline => ( |
121
|
|
|
|
|
|
|
is => 'rw', |
122
|
|
|
|
|
|
|
isa => 'Int', |
123
|
|
|
|
|
|
|
|
124
|
|
|
|
|
|
|
default => 0, |
125
|
|
|
|
|
|
|
init_arg => undef, |
126
|
|
|
|
|
|
|
); |
127
|
|
|
|
|
|
|
|
128
|
|
|
|
|
|
|
has input => ( |
129
|
|
|
|
|
|
|
is => 'rw', |
130
|
|
|
|
|
|
|
isa => 'Str', |
131
|
|
|
|
|
|
|
|
132
|
|
|
|
|
|
|
init_arg => undef, |
133
|
|
|
|
|
|
|
); |
134
|
|
|
|
|
|
|
|
135
|
|
|
|
|
|
|
has line_start => ( |
136
|
|
|
|
|
|
|
is => 'ro', |
137
|
|
|
|
|
|
|
isa => 'Maybe[Str]', |
138
|
|
|
|
|
|
|
builder => '_build_line_start', |
139
|
|
|
|
|
|
|
); |
140
|
176
|
|
|
176
|
|
6711
|
sub _build_line_start { ':' } |
141
|
|
|
|
|
|
|
|
142
|
|
|
|
|
|
|
has tag_start => ( |
143
|
|
|
|
|
|
|
is => 'ro', |
144
|
|
|
|
|
|
|
isa => 'Str', |
145
|
|
|
|
|
|
|
builder => '_build_tag_start', |
146
|
|
|
|
|
|
|
); |
147
|
177
|
|
|
177
|
|
6467
|
sub _build_tag_start { '<:' } |
148
|
|
|
|
|
|
|
|
149
|
|
|
|
|
|
|
has tag_end => ( |
150
|
|
|
|
|
|
|
is => 'ro', |
151
|
|
|
|
|
|
|
isa => 'Str', |
152
|
|
|
|
|
|
|
builder => '_build_tag_end', |
153
|
|
|
|
|
|
|
); |
154
|
177
|
|
|
177
|
|
6514
|
sub _build_tag_end { ':>' } |
155
|
|
|
|
|
|
|
|
156
|
|
|
|
|
|
|
has comment_pattern => ( |
157
|
|
|
|
|
|
|
is => 'ro', |
158
|
|
|
|
|
|
|
isa => 'RegexpRef', |
159
|
|
|
|
|
|
|
builder => '_build_comment_pattern', |
160
|
|
|
|
|
|
|
); |
161
|
241
|
|
|
241
|
|
7177
|
sub _build_comment_pattern { $COMMENT } |
162
|
|
|
|
|
|
|
|
163
|
|
|
|
|
|
|
has shortcut_table => ( |
164
|
|
|
|
|
|
|
is => 'ro', |
165
|
|
|
|
|
|
|
isa => 'HashRef[Str]', |
166
|
|
|
|
|
|
|
builder => '_build_shortcut_table', |
167
|
|
|
|
|
|
|
); |
168
|
241
|
|
|
241
|
|
5638
|
sub _build_shortcut_table { \%shortcut_table } |
169
|
|
|
|
|
|
|
|
170
|
|
|
|
|
|
|
has in_given => ( |
171
|
|
|
|
|
|
|
is => 'rw', |
172
|
|
|
|
|
|
|
isa => 'Bool', |
173
|
|
|
|
|
|
|
init_arg => undef, |
174
|
|
|
|
|
|
|
); |
175
|
|
|
|
|
|
|
|
176
|
|
|
|
|
|
|
# attributes for error messages |
177
|
|
|
|
|
|
|
|
178
|
|
|
|
|
|
|
has near_token => ( |
179
|
|
|
|
|
|
|
is => 'rw', |
180
|
|
|
|
|
|
|
|
181
|
|
|
|
|
|
|
init_arg => undef, |
182
|
|
|
|
|
|
|
); |
183
|
|
|
|
|
|
|
|
184
|
|
|
|
|
|
|
has file => ( |
185
|
|
|
|
|
|
|
is => 'rw', |
186
|
|
|
|
|
|
|
required => 0, |
187
|
|
|
|
|
|
|
); |
188
|
|
|
|
|
|
|
|
189
|
|
|
|
|
|
|
has line => ( |
190
|
|
|
|
|
|
|
is => 'rw', |
191
|
|
|
|
|
|
|
required => 0, |
192
|
|
|
|
|
|
|
); |
193
|
|
|
|
|
|
|
|
194
|
|
|
|
|
|
|
has input_layer => ( |
195
|
|
|
|
|
|
|
is => 'ro', |
196
|
|
|
|
|
|
|
default => ':utf8', |
197
|
|
|
|
|
|
|
); |
198
|
|
|
|
|
|
|
|
199
|
|
|
|
|
|
|
sub symbol_class() { 'Text::Xslate::Symbol' } |
200
|
|
|
|
|
|
|
|
201
|
|
|
|
|
|
|
# the entry point |
202
|
|
|
|
|
|
|
sub parse { |
203
|
3459
|
|
|
3459
|
0
|
34831
|
my($parser, $input, %args) = @_; |
204
|
|
|
|
|
|
|
|
205
|
3459
|
|
100
|
|
|
16522
|
local $parser->{file} = $args{file} || \$input; |
206
|
3459
|
|
50
|
|
|
17569
|
local $parser->{line} = $args{line} || 1; |
207
|
3459
|
|
|
|
|
8468
|
local $parser->{in_given} = 0; |
208
|
3459
|
|
|
|
|
6190
|
local $parser->{scope} = [ map { +{ %{$_} } } @{ $parser->scope } ]; |
|
3459
|
|
|
|
|
6049
|
|
|
3459
|
|
|
|
|
20470
|
|
|
3459
|
|
|
|
|
15361
|
|
209
|
3459
|
|
|
|
|
6681
|
local $parser->{symbol_table} = { %{ $parser->symbol_table } }; |
|
3459
|
|
|
|
|
183573
|
|
210
|
3459
|
|
|
|
|
29887
|
local $parser->{near_token}; |
211
|
3459
|
|
|
|
|
8167
|
local $parser->{next_token}; |
212
|
3459
|
|
|
|
|
7974
|
local $parser->{token}; |
213
|
3459
|
|
|
|
|
7935
|
local $parser->{input}; |
214
|
|
|
|
|
|
|
|
215
|
3459
|
|
|
|
|
11810
|
$parser->input( $parser->preprocess($input) ); |
216
|
|
|
|
|
|
|
|
217
|
3454
|
|
|
|
|
11247
|
$parser->next_token( $parser->tokenize() ); |
218
|
3454
|
|
|
|
|
10856
|
$parser->advance(); |
219
|
3453
|
|
|
|
|
10553
|
my $ast = $parser->statements(); |
220
|
|
|
|
|
|
|
|
221
|
3412
|
100
|
|
|
|
14280
|
if(my $input_pos = pos $parser->{input}) { |
222
|
3409
|
100
|
|
|
|
13053
|
if($input_pos != length($parser->{input})) { |
223
|
2
|
|
|
|
|
9
|
$parser->_error("Syntax error", $parser->token); |
224
|
|
|
|
|
|
|
} |
225
|
|
|
|
|
|
|
} |
226
|
|
|
|
|
|
|
|
227
|
3410
|
|
|
|
|
79232
|
return $ast; |
228
|
|
|
|
|
|
|
} |
229
|
|
|
|
|
|
|
|
230
|
|
|
|
|
|
|
sub trim_code { |
231
|
5198
|
|
|
5198
|
0
|
10412
|
my($parser, $s) = @_; |
232
|
|
|
|
|
|
|
|
233
|
5198
|
|
|
|
|
15971
|
$s =~ s/\A [ \t]+ //xms; |
234
|
5198
|
|
|
|
|
22366
|
$s =~ s/ [ \t]+ \n?\z//xms; |
235
|
|
|
|
|
|
|
|
236
|
5198
|
|
|
|
|
15542
|
return $s; |
237
|
|
|
|
|
|
|
} |
238
|
|
|
|
|
|
|
|
239
|
|
|
|
|
|
|
sub auto_chomp { |
240
|
10379
|
|
|
10379
|
0
|
20006
|
my($parser, $tokens_ref, $i, $s_ref) = @_; |
241
|
|
|
|
|
|
|
|
242
|
10379
|
|
|
|
|
14775
|
my $p; |
243
|
10379
|
|
|
|
|
16279
|
my $nl = 0; |
244
|
|
|
|
|
|
|
|
245
|
|
|
|
|
|
|
# postchomp |
246
|
10379
|
100
|
100
|
|
|
52083
|
if($i >= 1 |
247
|
|
|
|
|
|
|
and ($p = $tokens_ref->[$i-1])->[0] eq 'postchomp') { |
248
|
|
|
|
|
|
|
# [ CODE ][*][ TEXT ] |
249
|
|
|
|
|
|
|
# <: ... -:> \nfoobar |
250
|
|
|
|
|
|
|
# ^^^^ |
251
|
391
|
|
|
|
|
456
|
${$s_ref} =~ s/\A [ \t]* (\n)//xms; |
|
391
|
|
|
|
|
1578
|
|
252
|
391
|
100
|
|
|
|
1276
|
if($1) { |
253
|
386
|
|
|
|
|
564
|
$nl++; |
254
|
|
|
|
|
|
|
} |
255
|
|
|
|
|
|
|
} |
256
|
|
|
|
|
|
|
|
257
|
|
|
|
|
|
|
# prechomp |
258
|
10379
|
100
|
100
|
|
|
17584
|
if(($i+1) < @{$tokens_ref} |
|
10379
|
100
|
100
|
|
|
59651
|
|
|
|
|
66
|
|
|
|
|
|
|
|
100
|
|
|
|
|
259
|
|
|
|
|
|
|
and ($p = $tokens_ref->[$i+1])->[0] eq 'prechomp') { |
260
|
51
|
100
|
|
|
|
69
|
if(${$s_ref} !~ / [^ \t] /xms) { |
|
51
|
|
|
|
|
164
|
|
261
|
|
|
|
|
|
|
# HERE |
262
|
|
|
|
|
|
|
# [ TEXT ][*][ CODE ] |
263
|
|
|
|
|
|
|
# <:- ... :> |
264
|
|
|
|
|
|
|
# ^^^^^^^^ |
265
|
34
|
|
|
|
|
48
|
${$s_ref} = ''; |
|
34
|
|
|
|
|
66
|
|
266
|
|
|
|
|
|
|
} |
267
|
|
|
|
|
|
|
else { |
268
|
|
|
|
|
|
|
# HERE |
269
|
|
|
|
|
|
|
# [ TEXT ][*][ CODE ] |
270
|
|
|
|
|
|
|
# \n<:- ... :> |
271
|
|
|
|
|
|
|
# ^^ |
272
|
17
|
|
|
|
|
26
|
$nl += chomp ${$s_ref}; |
|
17
|
|
|
|
|
57
|
|
273
|
|
|
|
|
|
|
} |
274
|
|
|
|
|
|
|
} |
275
|
10328
|
|
|
|
|
64799
|
elsif(($i+2) < @{$tokens_ref} |
276
|
|
|
|
|
|
|
and ($p = $tokens_ref->[$i+2])->[0] eq 'prechomp' |
277
|
|
|
|
|
|
|
and ($p = $tokens_ref->[$i+1])->[0] eq 'text' |
278
|
|
|
|
|
|
|
and $p->[1] !~ / [^ \t] /xms) { |
279
|
|
|
|
|
|
|
# HERE |
280
|
|
|
|
|
|
|
# [ TEXT ][ TEXT ][*][ CODE ] |
281
|
|
|
|
|
|
|
# \n <:- ... :> |
282
|
|
|
|
|
|
|
# ^^^^^^^^^^ |
283
|
16
|
|
|
|
|
27
|
$p->[1] = ''; |
284
|
16
|
|
|
|
|
24
|
$nl += (${$s_ref} =~ s/\n\z//xms); |
|
16
|
|
|
|
|
48
|
|
285
|
|
|
|
|
|
|
} |
286
|
10379
|
|
|
|
|
28525
|
return $nl; |
287
|
|
|
|
|
|
|
} |
288
|
|
|
|
|
|
|
|
289
|
|
|
|
|
|
|
# split templates by tags before tokenizing |
290
|
|
|
|
|
|
|
sub split :method { |
291
|
3459
|
|
|
3459
|
0
|
6336
|
my $parser = shift; |
292
|
3459
|
|
|
|
|
8595
|
local($_) = @_; |
293
|
|
|
|
|
|
|
|
294
|
3459
|
|
|
|
|
6359
|
my @tokens; |
295
|
|
|
|
|
|
|
|
296
|
3459
|
|
|
|
|
10941
|
my $line_start = $parser->line_start; |
297
|
3459
|
|
|
|
|
10019
|
my $tag_start = $parser->tag_start; |
298
|
3459
|
|
|
|
|
10060
|
my $tag_end = $parser->tag_end; |
299
|
|
|
|
|
|
|
|
300
|
3459
|
|
66
|
|
|
38291
|
my $lex_line_code = defined($line_start) |
301
|
|
|
|
|
|
|
&& qr/\A ^ [ \t]* \Q$line_start\E ([^\n]* \n?) /xms; |
302
|
|
|
|
|
|
|
|
303
|
3459
|
|
|
|
|
20579
|
my $lex_tag_start = qr/\A \Q$tag_start\E ($CHOMP_FLAGS?)/xms; |
304
|
|
|
|
|
|
|
|
305
|
|
|
|
|
|
|
# 'text' is a something without newlines |
306
|
|
|
|
|
|
|
# following a newline, $tag_start, or end of the input |
307
|
3459
|
|
|
|
|
19713
|
my $lex_text = qr/\A ( [^\n]*? (?: \n | (?= \Q$tag_start\E ) | \z ) ) /xms; |
308
|
|
|
|
|
|
|
|
309
|
3459
|
|
|
|
|
11165
|
my $lex_comment = $parser->comment_pattern; |
310
|
3459
|
|
|
|
|
30261
|
my $lex_code = qr/(?: $lex_comment | $CODE )/xms; |
311
|
|
|
|
|
|
|
|
312
|
3459
|
|
|
|
|
7577
|
my $in_tag = 0; |
313
|
|
|
|
|
|
|
|
314
|
3459
|
|
|
|
|
11082
|
while($_ ne '') { |
315
|
18248
|
100
|
100
|
|
|
3204720
|
if($in_tag) { |
|
|
100
|
66
|
|
|
|
|
|
|
100
|
100
|
|
|
|
|
|
|
50
|
|
|
|
|
|
316
|
2653
|
|
|
|
|
5181
|
my $start = 0; |
317
|
2653
|
|
|
|
|
5004
|
my $pos; |
318
|
2653
|
|
|
|
|
11602
|
while( ($pos = index $_, $tag_end, $start) >= 0 ) { |
319
|
2652
|
|
|
|
|
8489
|
my $code = substr $_, 0, $pos; |
320
|
2652
|
|
|
|
|
47785
|
$code =~ s/$lex_code//xmsg; |
321
|
2652
|
100
|
|
|
|
8945
|
if(length($code) == 0) { |
322
|
2649
|
|
|
|
|
7923
|
last; |
323
|
|
|
|
|
|
|
} |
324
|
3
|
|
|
|
|
11
|
$start = $pos + 1; |
325
|
|
|
|
|
|
|
} |
326
|
|
|
|
|
|
|
|
327
|
2653
|
100
|
|
|
|
7037
|
if($pos >= 0) { |
328
|
2649
|
|
|
|
|
9396
|
my $code = substr $_, 0, $pos, ''; |
329
|
2649
|
|
|
|
|
16446
|
$code =~ s/($CHOMP_FLAGS?) \z//xmso; |
330
|
2649
|
|
|
|
|
7185
|
my $chomp = $1; |
331
|
|
|
|
|
|
|
|
332
|
2649
|
50
|
|
|
|
16611
|
s/\A \Q$tag_end\E //xms or die "Oops!"; |
333
|
|
|
|
|
|
|
|
334
|
2649
|
|
|
|
|
9275
|
push @tokens, [ code => $code ]; |
335
|
2649
|
100
|
|
|
|
7875
|
if($chomp) { |
336
|
393
|
|
|
|
|
1007
|
push @tokens, [ postchomp => $chomp ]; |
337
|
|
|
|
|
|
|
} |
338
|
2649
|
|
|
|
|
14264
|
$in_tag = 0; |
339
|
|
|
|
|
|
|
} |
340
|
|
|
|
|
|
|
else { |
341
|
4
|
|
|
|
|
11
|
last; # the end tag is not found |
342
|
|
|
|
|
|
|
} |
343
|
|
|
|
|
|
|
} |
344
|
|
|
|
|
|
|
# not $in_tag |
345
|
|
|
|
|
|
|
elsif($lex_line_code |
346
|
|
|
|
|
|
|
&& (@tokens == 0 || $tokens[-1][1] =~ /\n\z/xms) |
347
|
|
|
|
|
|
|
&& s/$lex_line_code//xms) { |
348
|
2554
|
|
|
|
|
12847
|
push @tokens, [ code => $1 ]; |
349
|
|
|
|
|
|
|
} |
350
|
|
|
|
|
|
|
elsif(s/$lex_tag_start//xms) { |
351
|
2654
|
|
|
|
|
5456
|
$in_tag = 1; |
352
|
|
|
|
|
|
|
|
353
|
2654
|
|
|
|
|
6868
|
my $chomp = $1; |
354
|
2654
|
100
|
|
|
|
13531
|
if($chomp) { |
355
|
60
|
|
|
|
|
295
|
push @tokens, [ prechomp => $chomp ]; |
356
|
|
|
|
|
|
|
} |
357
|
|
|
|
|
|
|
} |
358
|
|
|
|
|
|
|
elsif(s/$lex_text//xms) { |
359
|
10387
|
|
|
|
|
59238
|
push @tokens, [ text => $1 ]; |
360
|
|
|
|
|
|
|
} |
361
|
|
|
|
|
|
|
else { |
362
|
0
|
|
|
|
|
0
|
confess "Oops: Unreached code, near" . p($_); |
363
|
|
|
|
|
|
|
} |
364
|
|
|
|
|
|
|
} |
365
|
|
|
|
|
|
|
|
366
|
3459
|
100
|
|
|
|
9347
|
if($in_tag) { |
367
|
|
|
|
|
|
|
# calculate line number |
368
|
5
|
|
|
|
|
11
|
my $orig_src = $_[0]; |
369
|
5
|
|
|
|
|
28
|
substr $orig_src, -length($_), length($_), ''; |
370
|
5
|
|
|
|
|
14
|
my $line = ($orig_src =~ tr/\n/\n/); |
371
|
5
|
|
|
|
|
50
|
$parser->_error("Malformed templates detected", |
372
|
|
|
|
|
|
|
neat((split /\n/, $_)[0]), ++$line, |
373
|
|
|
|
|
|
|
); |
374
|
|
|
|
|
|
|
} |
375
|
|
|
|
|
|
|
#p(\@tokens); |
376
|
3454
|
|
|
|
|
20619
|
return \@tokens; |
377
|
|
|
|
|
|
|
} |
378
|
|
|
|
|
|
|
|
379
|
|
|
|
|
|
|
sub preprocess { |
380
|
3459
|
|
|
3459
|
0
|
7330
|
my($parser, $input) = @_; |
381
|
|
|
|
|
|
|
|
382
|
|
|
|
|
|
|
# tokenization |
383
|
|
|
|
|
|
|
|
384
|
3459
|
|
|
|
|
10399
|
my $tokens_ref = $parser->split($input); |
385
|
3454
|
|
|
|
|
7621
|
my $code = ''; |
386
|
|
|
|
|
|
|
|
387
|
3454
|
|
|
|
|
11405
|
my $shortcut_table = $parser->shortcut_table; |
388
|
3454
|
|
|
|
|
9195
|
my $shortcut = join('|', map{ quotemeta } keys %shortcut_table); |
|
3454
|
|
|
|
|
13911
|
|
389
|
3454
|
|
|
|
|
17324
|
my $shortcut_rx = qr/\A ($shortcut)/xms; |
390
|
|
|
|
|
|
|
|
391
|
3454
|
|
|
|
|
7694
|
for(my $i = 0; $i < @{$tokens_ref}; $i++) { |
|
19488
|
|
|
|
|
65495
|
|
392
|
16034
|
|
|
|
|
23404
|
my($type, $s) = @{ $tokens_ref->[$i] }; |
|
16034
|
|
|
|
|
44615
|
|
393
|
|
|
|
|
|
|
|
394
|
16034
|
100
|
|
|
|
44019
|
if($type eq 'text') { |
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
395
|
10379
|
|
|
|
|
28640
|
my $nl = $parser->auto_chomp($tokens_ref, $i, \$s); |
396
|
|
|
|
|
|
|
|
397
|
10379
|
|
|
|
|
25967
|
$s =~ s/(["\\])/\\$1/gxms; # " for poor editors |
398
|
|
|
|
|
|
|
|
399
|
|
|
|
|
|
|
# $s may have single new line |
400
|
10379
|
|
|
|
|
35774
|
$nl += ($s =~ s/\n/\\n/xms); |
401
|
|
|
|
|
|
|
|
402
|
10379
|
|
|
|
|
30318
|
$code .= qq{print_raw "$s";}; # must set even if $s is empty |
403
|
10379
|
100
|
|
|
|
47592
|
$code .= qq{\n} if $nl > 0; |
404
|
|
|
|
|
|
|
} |
405
|
|
|
|
|
|
|
elsif($type eq 'code') { |
406
|
|
|
|
|
|
|
# shortcut commands |
407
|
5202
|
50
|
|
|
|
27314
|
$s =~ s/$shortcut_rx/$shortcut_table->{$1}/xms |
408
|
|
|
|
|
|
|
if $shortcut; |
409
|
|
|
|
|
|
|
|
410
|
5202
|
|
|
|
|
14835
|
$s = $parser->trim_code($s); |
411
|
|
|
|
|
|
|
|
412
|
5202
|
100
|
|
|
|
25212
|
if($s =~ /\A \s* [}] \s* \z/xms){ |
|
|
100
|
|
|
|
|
|
413
|
546
|
|
|
|
|
1268
|
$code .= $s; |
414
|
|
|
|
|
|
|
} |
415
|
|
|
|
|
|
|
elsif($s =~ s/\n\z//xms) { |
416
|
2028
|
|
|
|
|
6555
|
$code .= qq{$s\n}; |
417
|
|
|
|
|
|
|
} |
418
|
|
|
|
|
|
|
else { |
419
|
2628
|
|
|
|
|
15056
|
$code .= qq{$s;}; # auto semicolon insertion |
420
|
|
|
|
|
|
|
} |
421
|
|
|
|
|
|
|
} |
422
|
|
|
|
|
|
|
elsif($type eq 'prechomp') { |
423
|
|
|
|
|
|
|
# noop, just a marker |
424
|
|
|
|
|
|
|
} |
425
|
|
|
|
|
|
|
elsif($type eq 'postchomp') { |
426
|
|
|
|
|
|
|
# noop, just a marker |
427
|
|
|
|
|
|
|
} |
428
|
|
|
|
|
|
|
else { |
429
|
0
|
|
|
|
|
0
|
$parser->_error("Oops: Unknown token: $s ($type)"); |
430
|
|
|
|
|
|
|
} |
431
|
|
|
|
|
|
|
} |
432
|
3454
|
|
|
|
|
6087
|
print STDOUT $code, "\n" if _DUMP_PROTO; |
433
|
3454
|
|
|
|
|
28350
|
return $code; |
434
|
|
|
|
|
|
|
} |
435
|
|
|
|
|
|
|
|
436
|
|
|
|
|
|
|
sub BUILD { |
437
|
241
|
|
|
241
|
1
|
2305
|
my($parser) = @_; |
438
|
241
|
|
|
|
|
3637
|
$parser->_init_basic_symbols(); |
439
|
241
|
|
|
|
|
3498
|
$parser->init_symbols(); |
440
|
241
|
|
|
|
|
7088
|
return; |
441
|
|
|
|
|
|
|
} |
442
|
|
|
|
|
|
|
|
443
|
|
|
|
|
|
|
# The grammer |
444
|
|
|
|
|
|
|
|
445
|
|
|
|
|
|
|
sub _init_basic_symbols { |
446
|
241
|
|
|
241
|
|
2259
|
my($parser) = @_; |
447
|
|
|
|
|
|
|
|
448
|
241
|
|
|
|
|
3345
|
$parser->symbol('(end)')->is_block_end(1); # EOF |
449
|
|
|
|
|
|
|
|
450
|
|
|
|
|
|
|
# prototypes of value symbols |
451
|
241
|
|
|
|
|
2344
|
foreach my $type (qw(name variable literal)) { |
452
|
723
|
|
|
|
|
7879
|
my $s = $parser->symbol("($type)"); |
453
|
723
|
|
|
|
|
7784
|
$s->arity($type); |
454
|
723
|
|
|
|
|
18361
|
$s->set_nud( $parser->can("nud_$type") ); |
455
|
|
|
|
|
|
|
} |
456
|
|
|
|
|
|
|
|
457
|
|
|
|
|
|
|
# common separators |
458
|
241
|
|
|
|
|
2562
|
$parser->symbol(';')->set_nud(\&nud_separator); |
459
|
241
|
|
|
|
|
3228
|
$parser->define_pair('(' => ')'); |
460
|
241
|
|
|
|
|
2622
|
$parser->define_pair('{' => '}'); |
461
|
241
|
|
|
|
|
2382
|
$parser->define_pair('[' => ']'); |
462
|
241
|
|
|
|
|
2679
|
$parser->symbol(',') ->is_comma(1); |
463
|
241
|
|
|
|
|
2435
|
$parser->symbol('=>') ->is_comma(1); |
464
|
|
|
|
|
|
|
|
465
|
|
|
|
|
|
|
# common commands |
466
|
241
|
|
|
|
|
2512
|
$parser->symbol('print') ->set_std(\&std_print); |
467
|
241
|
|
|
|
|
2563
|
$parser->symbol('print_raw')->set_std(\&std_print); |
468
|
|
|
|
|
|
|
|
469
|
|
|
|
|
|
|
# special literals |
470
|
241
|
|
|
|
|
3229
|
$parser->define_literal(nil => undef); |
471
|
241
|
|
|
|
|
2401
|
$parser->define_literal(true => 1); |
472
|
241
|
|
|
|
|
2491
|
$parser->define_literal(false => 0); |
473
|
|
|
|
|
|
|
|
474
|
|
|
|
|
|
|
# special tokens |
475
|
241
|
|
|
|
|
2502
|
$parser->symbol('__FILE__')->set_nud(\&nud_current_file); |
476
|
241
|
|
|
|
|
2561
|
$parser->symbol('__LINE__')->set_nud(\&nud_current_line); |
477
|
241
|
|
|
|
|
2517
|
$parser->symbol('__ROOT__')->set_nud(\&nud_current_vars); |
478
|
|
|
|
|
|
|
|
479
|
241
|
|
|
|
|
4876
|
return; |
480
|
|
|
|
|
|
|
} |
481
|
|
|
|
|
|
|
|
482
|
|
|
|
|
|
|
sub init_basic_operators { |
483
|
241
|
|
|
241
|
0
|
2669
|
my($parser) = @_; |
484
|
|
|
|
|
|
|
|
485
|
|
|
|
|
|
|
# define operator precedence |
486
|
|
|
|
|
|
|
|
487
|
241
|
|
|
|
|
3738
|
$parser->prefix('{', 256, \&nud_brace); |
488
|
241
|
|
|
|
|
2719
|
$parser->prefix('[', 256, \&nud_brace); |
489
|
|
|
|
|
|
|
|
490
|
241
|
|
|
|
|
3379
|
$parser->infix('(', 256, \&led_call); |
491
|
241
|
|
|
|
|
3374
|
$parser->infix('.', 256, \&led_dot); |
492
|
241
|
|
|
|
|
3240
|
$parser->infix('[', 256, \&led_fetch); |
493
|
|
|
|
|
|
|
|
494
|
241
|
|
|
|
|
4200
|
$parser->prefix('(', 256, \&nud_paren); |
495
|
|
|
|
|
|
|
|
496
|
241
|
|
|
|
|
3370
|
$parser->prefix('!', 200)->is_logical(1); |
497
|
241
|
|
|
|
|
3296
|
$parser->prefix('+', 200); |
498
|
241
|
|
|
|
|
2467
|
$parser->prefix('-', 200); |
499
|
241
|
|
|
|
|
2723
|
$parser->prefix('+^', 200); # numeric bitwise negate |
500
|
|
|
|
|
|
|
|
501
|
241
|
|
|
|
|
2473
|
$parser->infix('*', 190); |
502
|
241
|
|
|
|
|
2515
|
$parser->infix('/', 190); |
503
|
241
|
|
|
|
|
2995
|
$parser->infix('%', 190); |
504
|
241
|
|
|
|
|
2501
|
$parser->infix('x', 190); |
505
|
241
|
|
|
|
|
2620
|
$parser->infix('+&', 190); # numeric bitwise and |
506
|
|
|
|
|
|
|
|
507
|
241
|
|
|
|
|
2747
|
$parser->infix('+', 180); |
508
|
241
|
|
|
|
|
2980
|
$parser->infix('-', 180); |
509
|
241
|
|
|
|
|
2503
|
$parser->infix('~', 180); # connect |
510
|
241
|
|
|
|
|
2708
|
$parser->infix('+|', 180); # numeric bitwise or |
511
|
241
|
|
|
|
|
2854
|
$parser->infix('+^', 180); # numeric bitwise xor |
512
|
|
|
|
|
|
|
|
513
|
|
|
|
|
|
|
|
514
|
241
|
|
|
|
|
3080
|
$parser->prefix('defined', 170, \&nud_defined); # named unary operator |
515
|
|
|
|
|
|
|
|
516
|
241
|
|
|
|
|
2473
|
$parser->infix('<', 160)->is_logical(1); |
517
|
241
|
|
|
|
|
2925
|
$parser->infix('<=', 160)->is_logical(1); |
518
|
241
|
|
|
|
|
2583
|
$parser->infix('>', 160)->is_logical(1); |
519
|
241
|
|
|
|
|
2615
|
$parser->infix('>=', 160)->is_logical(1); |
520
|
|
|
|
|
|
|
|
521
|
241
|
|
|
|
|
2640
|
$parser->infix('==', 150)->is_logical(1); |
522
|
241
|
|
|
|
|
2653
|
$parser->infix('!=', 150)->is_logical(1); |
523
|
241
|
|
|
|
|
2459
|
$parser->infix('<=>', 150); |
524
|
241
|
|
|
|
|
2712
|
$parser->infix('cmp', 150); |
525
|
241
|
|
|
|
|
2624
|
$parser->infix('~~', 150); |
526
|
|
|
|
|
|
|
|
527
|
241
|
|
|
|
|
2839
|
$parser->infix('|', 140, \&led_pipe); |
528
|
|
|
|
|
|
|
|
529
|
241
|
|
|
|
|
2499
|
$parser->infix('&&', 130)->is_logical(1); |
530
|
|
|
|
|
|
|
|
531
|
241
|
|
|
|
|
2605
|
$parser->infix('||', 120)->is_logical(1); |
532
|
241
|
|
|
|
|
2716
|
$parser->infix('//', 120)->is_logical(1); |
533
|
241
|
|
|
|
|
2470
|
$parser->infix('min', 120); |
534
|
241
|
|
|
|
|
2502
|
$parser->infix('max', 120); |
535
|
|
|
|
|
|
|
|
536
|
241
|
|
|
|
|
3081
|
$parser->infix('..', 110, \&led_range); |
537
|
|
|
|
|
|
|
|
538
|
241
|
|
|
|
|
2596
|
$parser->symbol(':'); |
539
|
241
|
|
|
|
|
3528
|
$parser->infixr('?', 100, \&led_ternary); |
540
|
|
|
|
|
|
|
|
541
|
241
|
|
|
|
|
4408
|
$parser->assignment('=', 90); |
542
|
241
|
|
|
|
|
2635
|
$parser->assignment('+=', 90); |
543
|
241
|
|
|
|
|
2798
|
$parser->assignment('-=', 90); |
544
|
241
|
|
|
|
|
2607
|
$parser->assignment('*=', 90); |
545
|
241
|
|
|
|
|
2750
|
$parser->assignment('/=', 90); |
546
|
241
|
|
|
|
|
2487
|
$parser->assignment('%=', 90); |
547
|
241
|
|
|
|
|
2519
|
$parser->assignment('~=', 90); |
548
|
241
|
|
|
|
|
2395
|
$parser->assignment('&&=', 90); |
549
|
241
|
|
|
|
|
2883
|
$parser->assignment('||=', 90); |
550
|
241
|
|
|
|
|
2575
|
$parser->assignment('//=', 90); |
551
|
|
|
|
|
|
|
|
552
|
241
|
|
|
|
|
3439
|
$parser->make_alias('!' => 'not')->ubp(70); |
553
|
241
|
|
|
|
|
3821
|
$parser->make_alias('&&' => 'and')->lbp(60); |
554
|
241
|
|
|
|
|
2692
|
$parser->make_alias('||' => 'or') ->lbp(50); |
555
|
241
|
|
|
|
|
4093
|
return; |
556
|
|
|
|
|
|
|
} |
557
|
|
|
|
|
|
|
|
558
|
|
|
|
|
|
|
sub init_symbols { |
559
|
182
|
|
|
182
|
0
|
2420
|
my($parser) = @_; |
560
|
182
|
|
|
|
|
2438
|
my $s; |
561
|
|
|
|
|
|
|
|
562
|
|
|
|
|
|
|
# syntax specific separators |
563
|
182
|
|
|
|
|
2574
|
$parser->symbol('{'); |
564
|
182
|
|
|
|
|
2396
|
$parser->symbol('}')->is_block_end(1); # block end |
565
|
182
|
|
|
|
|
2399
|
$parser->symbol('->'); |
566
|
182
|
|
|
|
|
2411
|
$parser->symbol('else'); |
567
|
182
|
|
|
|
|
2390
|
$parser->symbol('with'); |
568
|
182
|
|
|
|
|
2808
|
$parser->symbol('::'); |
569
|
|
|
|
|
|
|
|
570
|
|
|
|
|
|
|
# operators |
571
|
182
|
|
|
|
|
3230
|
$parser->init_basic_operators(); |
572
|
|
|
|
|
|
|
|
573
|
|
|
|
|
|
|
# statements |
574
|
182
|
|
|
|
|
2203
|
$s = $parser->symbol('if'); |
575
|
182
|
|
|
|
|
2489
|
$s->set_std(\&std_if); |
576
|
182
|
|
|
|
|
2646
|
$s->can_be_modifier(1); |
577
|
|
|
|
|
|
|
|
578
|
182
|
|
|
|
|
2279
|
$parser->symbol('for') ->set_std(\&std_for); |
579
|
182
|
|
|
|
|
2264
|
$parser->symbol('while' ) ->set_std(\&std_while); |
580
|
182
|
|
|
|
|
2369
|
$parser->symbol('given') ->set_std(\&std_given); |
581
|
182
|
|
|
|
|
2268
|
$parser->symbol('when') ->set_std(\&std_when); |
582
|
182
|
|
|
|
|
2194
|
$parser->symbol('default') ->set_std(\&std_when); |
583
|
|
|
|
|
|
|
|
584
|
182
|
|
|
|
|
2204
|
$parser->symbol('include') ->set_std(\&std_include); |
585
|
|
|
|
|
|
|
|
586
|
182
|
|
|
|
|
2266
|
$parser->symbol('last') ->set_std(\&std_last); |
587
|
182
|
|
|
|
|
2239
|
$parser->symbol('next') ->set_std(\&std_next); |
588
|
|
|
|
|
|
|
|
589
|
|
|
|
|
|
|
# macros |
590
|
|
|
|
|
|
|
|
591
|
182
|
|
|
|
|
2177
|
$parser->symbol('cascade') ->set_std(\&std_cascade); |
592
|
182
|
|
|
|
|
2185
|
$parser->symbol('macro') ->set_std(\&std_proc); |
593
|
182
|
|
|
|
|
2265
|
$parser->symbol('around') ->set_std(\&std_proc); |
594
|
182
|
|
|
|
|
2317
|
$parser->symbol('before') ->set_std(\&std_proc); |
595
|
182
|
|
|
|
|
2192
|
$parser->symbol('after') ->set_std(\&std_proc); |
596
|
182
|
|
|
|
|
2251
|
$parser->symbol('block') ->set_std(\&std_macro_block); |
597
|
182
|
|
|
|
|
2341
|
$parser->symbol('super') ->set_std(\&std_super); |
598
|
182
|
|
|
|
|
2232
|
$parser->symbol('override') ->set_std(\&std_override); |
599
|
|
|
|
|
|
|
|
600
|
182
|
|
|
|
|
2261
|
$parser->symbol('->') ->set_nud(\&nud_lambda); |
601
|
|
|
|
|
|
|
|
602
|
|
|
|
|
|
|
# lexical variables/constants stuff |
603
|
182
|
|
|
|
|
2281
|
$parser->symbol('constant')->set_nud(\&nud_constant); |
604
|
182
|
|
|
|
|
2317
|
$parser->symbol('my' )->set_nud(\&nud_constant); |
605
|
|
|
|
|
|
|
|
606
|
182
|
|
|
|
|
3816
|
return; |
607
|
|
|
|
|
|
|
} |
608
|
|
|
|
|
|
|
|
609
|
|
|
|
|
|
|
sub _build_iterator_element { |
610
|
|
|
|
|
|
|
return { |
611
|
4
|
|
|
4
|
|
92
|
index => \&iterator_index, |
612
|
|
|
|
|
|
|
count => \&iterator_count, |
613
|
|
|
|
|
|
|
is_first => \&iterator_is_first, |
614
|
|
|
|
|
|
|
is_last => \&iterator_is_last, |
615
|
|
|
|
|
|
|
body => \&iterator_body, |
616
|
|
|
|
|
|
|
size => \&iterator_size, |
617
|
|
|
|
|
|
|
max_index => \&iterator_max_index, |
618
|
|
|
|
|
|
|
peek_next => \&iterator_peek_next, |
619
|
|
|
|
|
|
|
peek_prev => \&iterator_peek_prev, |
620
|
|
|
|
|
|
|
cycle => \&iterator_cycle, |
621
|
|
|
|
|
|
|
}; |
622
|
|
|
|
|
|
|
} |
623
|
|
|
|
|
|
|
|
624
|
|
|
|
|
|
|
|
625
|
|
|
|
|
|
|
sub symbol { |
626
|
52957
|
|
|
52957
|
0
|
304673
|
my($parser, $id, $lbp) = @_; |
627
|
|
|
|
|
|
|
|
628
|
52957
|
|
|
|
|
333424
|
my $stash = $parser->symbol_table; |
629
|
52957
|
|
|
|
|
304909
|
my $s = $stash->{$id}; |
630
|
52957
|
100
|
|
|
|
318892
|
if(defined $s) { |
631
|
25242
|
100
|
|
|
|
104204
|
if(defined $lbp) { |
632
|
1205
|
|
|
|
|
32727
|
$s->lbp($lbp); |
633
|
|
|
|
|
|
|
} |
634
|
|
|
|
|
|
|
} |
635
|
|
|
|
|
|
|
else { # create a new symbol |
636
|
27715
|
|
100
|
|
|
532631
|
$s = $parser->symbol_class->new(id => $id, lbp => $lbp || 0); |
637
|
27715
|
|
|
|
|
496869
|
$stash->{$id} = $s; |
638
|
|
|
|
|
|
|
} |
639
|
|
|
|
|
|
|
|
640
|
52957
|
|
|
|
|
613426
|
return $s; |
641
|
|
|
|
|
|
|
} |
642
|
|
|
|
|
|
|
|
643
|
|
|
|
|
|
|
sub define_pair { |
644
|
723
|
|
|
723
|
0
|
6313
|
my($parser, $left, $right) = @_; |
645
|
723
|
|
|
|
|
6918
|
$parser->symbol($left) ->counterpart($right); |
646
|
723
|
|
|
|
|
6926
|
$parser->symbol($right)->counterpart($left); |
647
|
723
|
|
|
|
|
11462
|
return; |
648
|
|
|
|
|
|
|
} |
649
|
|
|
|
|
|
|
|
650
|
|
|
|
|
|
|
# the low-level tokenizer. Don't use it directly, use advance() instead. |
651
|
|
|
|
|
|
|
sub tokenize { |
652
|
64606
|
|
|
64606
|
0
|
105495
|
my($parser) = @_; |
653
|
|
|
|
|
|
|
|
654
|
64606
|
|
|
|
|
144040
|
local *_ = \$parser->{input}; |
655
|
|
|
|
|
|
|
|
656
|
64606
|
|
|
|
|
157394
|
my $comment_rx = $parser->comment_pattern; |
657
|
64606
|
|
|
|
|
143754
|
my $id_rx = $parser->identity_pattern; |
658
|
64606
|
|
|
|
|
96240
|
my $count = 0; |
659
|
|
|
|
|
|
|
TRY: { |
660
|
64606
|
|
|
|
|
95399
|
/\G (\s*) /xmsgc; |
|
64652
|
|
|
|
|
178529
|
|
661
|
64652
|
|
|
|
|
146850
|
$count += ( $1 =~ tr/\n/\n/); |
662
|
64652
|
|
|
|
|
173263
|
$parser->following_newline( $count ); |
663
|
|
|
|
|
|
|
|
664
|
64652
|
100
|
|
|
|
624648
|
if(/\G $comment_rx /xmsgc) { |
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
665
|
46
|
|
|
|
|
116
|
redo TRY; # retry |
666
|
|
|
|
|
|
|
} |
667
|
|
|
|
|
|
|
elsif(/\G ($id_rx)/xmsgc){ |
668
|
19450
|
|
|
|
|
128094
|
return [ name => $1 ]; |
669
|
|
|
|
|
|
|
} |
670
|
|
|
|
|
|
|
elsif(/\G ($NUMBER | $STRING)/xmsogc){ |
671
|
17593
|
|
|
|
|
109476
|
return [ literal => $1 ]; |
672
|
|
|
|
|
|
|
} |
673
|
|
|
|
|
|
|
elsif(/\G ($OPERATOR_TOKEN)/xmsogc){ |
674
|
24146
|
|
|
|
|
145613
|
return [ operator => $1 ]; |
675
|
|
|
|
|
|
|
} |
676
|
|
|
|
|
|
|
elsif(/\G (\S+)/xmsgc) { |
677
|
0
|
|
|
|
|
0
|
Carp::confess("Oops: Unexpected token '$1'"); |
678
|
|
|
|
|
|
|
} |
679
|
|
|
|
|
|
|
else { # empty |
680
|
3417
|
|
|
|
|
20827
|
return [ special => '(end)' ]; |
681
|
|
|
|
|
|
|
} |
682
|
|
|
|
|
|
|
} |
683
|
|
|
|
|
|
|
} |
684
|
|
|
|
|
|
|
|
685
|
|
|
|
|
|
|
sub next_token_is { |
686
|
19489
|
|
|
19489
|
0
|
35685
|
my($parser, $token) = @_; |
687
|
19489
|
|
|
|
|
120858
|
return $parser->next_token->[1] eq $token; |
688
|
|
|
|
|
|
|
} |
689
|
|
|
|
|
|
|
|
690
|
|
|
|
|
|
|
# the high-level tokenizer |
691
|
|
|
|
|
|
|
sub advance { |
692
|
64577
|
|
|
64577
|
0
|
110436
|
my($parser, $expect) = @_; |
693
|
|
|
|
|
|
|
|
694
|
64577
|
|
|
|
|
147479
|
my $t = $parser->token; |
695
|
64577
|
100
|
100
|
|
|
184996
|
if(defined($expect) && $t->id ne $expect) { |
696
|
7
|
|
|
|
|
25
|
$parser->_unexpected(neat($expect), $t); |
697
|
|
|
|
|
|
|
} |
698
|
|
|
|
|
|
|
|
699
|
64570
|
|
|
|
|
155053
|
$parser->near_token($t); |
700
|
|
|
|
|
|
|
|
701
|
64570
|
|
|
|
|
267125
|
my $stash = $parser->symbol_table; |
702
|
|
|
|
|
|
|
|
703
|
64570
|
|
|
|
|
149433
|
$t = $parser->next_token; |
704
|
|
|
|
|
|
|
|
705
|
64570
|
100
|
|
|
|
166750
|
if($t->[0] eq 'special') { |
706
|
3418
|
|
|
|
|
19587
|
return $parser->token( $stash->{ $t->[1] } ); |
707
|
|
|
|
|
|
|
} |
708
|
61152
|
|
|
|
|
213285
|
$parser->statement_is_finished( $parser->following_newline != 0 ); |
709
|
61152
|
|
|
|
|
247986
|
my $line = $parser->line( $parser->line + $parser->following_newline ); |
710
|
|
|
|
|
|
|
|
711
|
61152
|
|
|
|
|
145842
|
$parser->next_token( $parser->tokenize() ); |
712
|
|
|
|
|
|
|
|
713
|
61152
|
|
|
|
|
100190
|
my($arity, $id) = @{$t}; |
|
61152
|
|
|
|
|
155714
|
|
714
|
61152
|
100
|
100
|
|
|
195265
|
if( $arity eq "name" && $parser->next_token_is("=>") ) { |
715
|
63
|
|
|
|
|
109
|
$arity = "literal"; |
716
|
|
|
|
|
|
|
} |
717
|
|
|
|
|
|
|
|
718
|
61152
|
|
|
|
|
85571
|
print STDOUT "[$arity => $id] #$line\n" if _DUMP_TOKEN; |
719
|
|
|
|
|
|
|
|
720
|
61152
|
|
|
|
|
81720
|
my $symbol; |
721
|
61152
|
100
|
|
|
|
155638
|
if($arity eq "literal") { |
|
|
100
|
|
|
|
|
|
722
|
17655
|
|
|
|
|
42124
|
$symbol = $parser->symbol('(literal)')->clone( |
723
|
|
|
|
|
|
|
id => $id, |
724
|
|
|
|
|
|
|
value => $parser->parse_literal($id) |
725
|
|
|
|
|
|
|
); |
726
|
|
|
|
|
|
|
} |
727
|
|
|
|
|
|
|
elsif($arity eq "operator") { |
728
|
24117
|
|
|
|
|
48406
|
$symbol = $stash->{$id}; |
729
|
24117
|
100
|
|
|
|
56292
|
if(not defined $symbol) { |
730
|
3
|
|
|
|
|
12
|
$parser->_error("Unknown operator '$id'"); |
731
|
|
|
|
|
|
|
} |
732
|
24114
|
|
|
|
|
74467
|
$symbol = $symbol->clone( |
733
|
|
|
|
|
|
|
arity => $arity, # to make error messages clearer |
734
|
|
|
|
|
|
|
); |
735
|
|
|
|
|
|
|
} |
736
|
|
|
|
|
|
|
else { # name |
737
|
|
|
|
|
|
|
# find_or_create() returns a cloned symbol, |
738
|
|
|
|
|
|
|
# so there's not need to clone() here |
739
|
19380
|
|
|
|
|
47302
|
$symbol = $parser->find_or_create($id); |
740
|
|
|
|
|
|
|
} |
741
|
|
|
|
|
|
|
|
742
|
61149
|
|
|
|
|
902447
|
$symbol->line($line); |
743
|
61149
|
|
|
|
|
287076
|
return $parser->token($symbol); |
744
|
|
|
|
|
|
|
} |
745
|
|
|
|
|
|
|
|
746
|
|
|
|
|
|
|
sub parse_literal { |
747
|
17655
|
|
|
17655
|
0
|
29594
|
my($parser, $literal) = @_; |
748
|
17655
|
|
|
|
|
53314
|
return literal_to_value($literal); |
749
|
|
|
|
|
|
|
} |
750
|
|
|
|
|
|
|
|
751
|
|
|
|
|
|
|
sub nud_name { |
752
|
341
|
|
|
341
|
0
|
552
|
my($parser, $symbol) = @_; |
753
|
341
|
|
|
|
|
939
|
return $symbol->clone( |
754
|
|
|
|
|
|
|
arity => 'name', |
755
|
|
|
|
|
|
|
); |
756
|
|
|
|
|
|
|
} |
757
|
|
|
|
|
|
|
sub nud_variable { |
758
|
2775
|
|
|
2775
|
0
|
6010
|
my($parser, $symbol) = @_; |
759
|
2775
|
|
|
|
|
8940
|
return $symbol->clone( |
760
|
|
|
|
|
|
|
arity => 'variable', |
761
|
|
|
|
|
|
|
); |
762
|
|
|
|
|
|
|
} |
763
|
|
|
|
|
|
|
sub nud_literal { |
764
|
17634
|
|
|
17634
|
0
|
28077
|
my($parser, $symbol) = @_; |
765
|
17634
|
|
|
|
|
48168
|
return $symbol->clone( |
766
|
|
|
|
|
|
|
arity => 'literal', |
767
|
|
|
|
|
|
|
); |
768
|
|
|
|
|
|
|
} |
769
|
|
|
|
|
|
|
|
770
|
|
|
|
|
|
|
sub default_nud { |
771
|
377
|
|
|
377
|
0
|
558
|
my($parser, $symbol) = @_; |
772
|
377
|
|
|
|
|
1009
|
return $symbol->clone(); # as is |
773
|
|
|
|
|
|
|
} |
774
|
|
|
|
|
|
|
|
775
|
|
|
|
|
|
|
sub default_led { |
776
|
0
|
|
|
0
|
0
|
0
|
my($parser, $symbol) = @_; |
777
|
0
|
|
|
|
|
0
|
$parser->near_token($parser->token); |
778
|
0
|
|
|
|
|
0
|
$parser->_error( |
779
|
|
|
|
|
|
|
sprintf 'Missing operator (%s): %s', |
780
|
|
|
|
|
|
|
$symbol->arity, $symbol->id); |
781
|
|
|
|
|
|
|
} |
782
|
|
|
|
|
|
|
|
783
|
|
|
|
|
|
|
sub default_std { |
784
|
0
|
|
|
0
|
0
|
0
|
my($parser, $symbol) = @_; |
785
|
0
|
|
|
|
|
0
|
$parser->near_token($parser->token); |
786
|
0
|
|
|
|
|
0
|
$parser->_error( |
787
|
|
|
|
|
|
|
sprintf 'Not a statement (%s): %s', |
788
|
|
|
|
|
|
|
$symbol->arity, $symbol->id); |
789
|
|
|
|
|
|
|
} |
790
|
|
|
|
|
|
|
|
791
|
|
|
|
|
|
|
sub expression { |
792
|
21886
|
|
|
21886
|
0
|
35469
|
my($parser, $rbp) = @_; |
793
|
|
|
|
|
|
|
|
794
|
21886
|
|
|
|
|
49678
|
my $t = $parser->token; |
795
|
|
|
|
|
|
|
|
796
|
21886
|
|
|
|
|
46600
|
$parser->advance(); |
797
|
|
|
|
|
|
|
|
798
|
21886
|
|
|
|
|
67428
|
my $left = $t->nud($parser); |
799
|
|
|
|
|
|
|
|
800
|
21871
|
|
|
|
|
545521
|
while($rbp < $parser->token->lbp) { |
801
|
1923
|
|
|
|
|
9466
|
$t = $parser->token; |
802
|
1923
|
|
|
|
|
5090
|
$parser->advance(); |
803
|
1923
|
|
|
|
|
5683
|
$left = $t->led($parser, $left); |
804
|
|
|
|
|
|
|
} |
805
|
|
|
|
|
|
|
|
806
|
21853
|
|
|
|
|
90278
|
return $left; |
807
|
|
|
|
|
|
|
} |
808
|
|
|
|
|
|
|
|
809
|
|
|
|
|
|
|
sub expression_list { |
810
|
12214
|
|
|
12214
|
0
|
21337
|
my($parser) = @_; |
811
|
12214
|
|
|
|
|
19081
|
my @list; |
812
|
12214
|
|
|
|
|
19095
|
while(1) { |
813
|
17524
|
100
|
|
|
|
71023
|
if($parser->token->is_value) { |
814
|
17276
|
|
|
|
|
41589
|
push @list, $parser->expression(0); |
815
|
|
|
|
|
|
|
} |
816
|
|
|
|
|
|
|
|
817
|
17524
|
100
|
|
|
|
74148
|
if(!$parser->token->is_comma) { |
818
|
12214
|
|
|
|
|
27585
|
last; |
819
|
|
|
|
|
|
|
} |
820
|
|
|
|
|
|
|
|
821
|
5310
|
|
|
|
|
10517
|
$parser->advance(); # comma |
822
|
|
|
|
|
|
|
} |
823
|
12214
|
|
|
|
|
40920
|
return \@list; |
824
|
|
|
|
|
|
|
} |
825
|
|
|
|
|
|
|
|
826
|
|
|
|
|
|
|
# for left associative infix operators |
827
|
|
|
|
|
|
|
sub led_infix { |
828
|
863
|
|
|
863
|
0
|
1265
|
my($parser, $symbol, $left) = @_; |
829
|
863
|
|
|
|
|
2831
|
return $parser->binary( $symbol, $left, $parser->expression($symbol->lbp) ); |
830
|
|
|
|
|
|
|
} |
831
|
|
|
|
|
|
|
|
832
|
|
|
|
|
|
|
sub infix { |
833
|
6989
|
|
|
6989
|
0
|
67276
|
my($parser, $id, $bp, $led) = @_; |
834
|
|
|
|
|
|
|
|
835
|
6989
|
|
|
|
|
69551
|
my $symbol = $parser->symbol($id, $bp); |
836
|
6989
|
|
100
|
|
|
88802
|
$symbol->set_led($led || \&led_infix); |
837
|
6989
|
|
|
|
|
125667
|
return $symbol; |
838
|
|
|
|
|
|
|
} |
839
|
|
|
|
|
|
|
|
840
|
|
|
|
|
|
|
# for right associative infix operators |
841
|
|
|
|
|
|
|
sub led_infixr { |
842
|
26
|
|
|
26
|
0
|
49
|
my($parser, $symbol, $left) = @_; |
843
|
26
|
|
|
|
|
136
|
return $parser->binary( $symbol, $left, $parser->expression($symbol->lbp - 1) ); |
844
|
|
|
|
|
|
|
} |
845
|
|
|
|
|
|
|
|
846
|
|
|
|
|
|
|
sub infixr { |
847
|
241
|
|
|
241
|
0
|
2806
|
my($parser, $id, $bp, $led) = @_; |
848
|
|
|
|
|
|
|
|
849
|
241
|
|
|
|
|
4885
|
my $symbol = $parser->symbol($id, $bp); |
850
|
241
|
|
50
|
|
|
3482
|
$symbol->set_led($led || \&led_infixr); |
851
|
241
|
|
|
|
|
4573
|
return $symbol; |
852
|
|
|
|
|
|
|
} |
853
|
|
|
|
|
|
|
|
854
|
|
|
|
|
|
|
# for prefix operators |
855
|
|
|
|
|
|
|
sub prefix { |
856
|
1928
|
|
|
1928
|
0
|
18233
|
my($parser, $id, $bp, $nud) = @_; |
857
|
|
|
|
|
|
|
|
858
|
1928
|
|
|
|
|
18833
|
my $symbol = $parser->symbol($id); |
859
|
1928
|
|
|
|
|
21451
|
$symbol->ubp($bp); |
860
|
1928
|
|
100
|
|
|
44073
|
$symbol->set_nud($nud || \&nud_prefix); |
861
|
1928
|
|
|
|
|
34898
|
return $symbol; |
862
|
|
|
|
|
|
|
} |
863
|
|
|
|
|
|
|
|
864
|
|
|
|
|
|
|
sub nud_prefix { |
865
|
51
|
|
|
51
|
0
|
96
|
my($parser, $symbol) = @_; |
866
|
51
|
|
|
|
|
250
|
my $un = $symbol->clone(arity => 'unary'); |
867
|
51
|
|
|
|
|
1079
|
$parser->reserve($un); |
868
|
51
|
|
|
|
|
200
|
$un->first($parser->expression($symbol->ubp)); |
869
|
50
|
|
|
|
|
120
|
return $un; |
870
|
|
|
|
|
|
|
} |
871
|
|
|
|
|
|
|
|
872
|
|
|
|
|
|
|
sub led_assignment { |
873
|
11
|
|
|
11
|
0
|
21
|
my($parser, $symbol, $left) = @_; |
874
|
|
|
|
|
|
|
|
875
|
11
|
|
|
|
|
42
|
$parser->_error("Assignment ($symbol) is forbidden", $left); |
876
|
|
|
|
|
|
|
} |
877
|
|
|
|
|
|
|
|
878
|
|
|
|
|
|
|
sub assignment { |
879
|
1820
|
|
|
1820
|
0
|
22410
|
my($parser, $id, $bp) = @_; |
880
|
|
|
|
|
|
|
|
881
|
1820
|
|
|
|
|
24166
|
$parser->symbol($id, $bp)->set_led(\&led_assignment); |
882
|
1820
|
|
|
|
|
38136
|
return; |
883
|
|
|
|
|
|
|
} |
884
|
|
|
|
|
|
|
|
885
|
|
|
|
|
|
|
# the ternary is a right associative operator |
886
|
|
|
|
|
|
|
sub led_ternary { |
887
|
115
|
|
|
115
|
0
|
184
|
my($parser, $symbol, $left) = @_; |
888
|
|
|
|
|
|
|
|
889
|
115
|
|
|
|
|
329
|
my $if = $symbol->clone(arity => 'if'); |
890
|
|
|
|
|
|
|
|
891
|
115
|
|
|
|
|
2280
|
$if->first($left); |
892
|
115
|
|
|
|
|
459
|
$if->second([$parser->expression( $symbol->lbp - 1 )]); |
893
|
113
|
|
|
|
|
307
|
$parser->advance(":"); |
894
|
113
|
|
|
|
|
426
|
$if->third([$parser->expression( $symbol->lbp - 1 )]); |
895
|
113
|
|
|
|
|
617
|
return $if; |
896
|
|
|
|
|
|
|
} |
897
|
|
|
|
|
|
|
|
898
|
|
|
|
|
|
|
sub is_valid_field { |
899
|
447
|
|
|
447
|
0
|
663
|
my($parser, $token) = @_; |
900
|
447
|
|
|
|
|
1174
|
my $arity = $token->arity; |
901
|
|
|
|
|
|
|
|
902
|
447
|
100
|
|
|
|
1133
|
if($arity eq "name") { |
|
|
100
|
|
|
|
|
|
903
|
409
|
|
|
|
|
1434
|
return 1; |
904
|
|
|
|
|
|
|
} |
905
|
|
|
|
|
|
|
elsif($arity eq "literal") { |
906
|
9
|
|
|
|
|
40
|
return is_int($token->id); |
907
|
|
|
|
|
|
|
} |
908
|
29
|
|
|
|
|
279
|
return 0; |
909
|
|
|
|
|
|
|
} |
910
|
|
|
|
|
|
|
|
911
|
|
|
|
|
|
|
sub led_dot { |
912
|
447
|
|
|
447
|
0
|
738
|
my($parser, $symbol, $left) = @_; |
913
|
|
|
|
|
|
|
|
914
|
447
|
|
|
|
|
1044
|
my $t = $parser->token; |
915
|
447
|
50
|
|
|
|
1254
|
if(!$parser->is_valid_field($t)) { |
916
|
0
|
|
|
|
|
0
|
$parser->_unexpected("a field name", $t); |
917
|
|
|
|
|
|
|
} |
918
|
|
|
|
|
|
|
|
919
|
447
|
|
|
|
|
1520
|
my $dot = $symbol->clone( |
920
|
|
|
|
|
|
|
arity => "field", |
921
|
|
|
|
|
|
|
first => $left, |
922
|
|
|
|
|
|
|
second => $t->clone(arity => 'literal'), |
923
|
|
|
|
|
|
|
); |
924
|
|
|
|
|
|
|
|
925
|
447
|
|
|
|
|
9922
|
$t = $parser->advance(); |
926
|
447
|
100
|
|
|
|
1747
|
if($t->id eq "(") { |
927
|
230
|
|
|
|
|
632
|
$parser->advance(); # "(" |
928
|
230
|
|
|
|
|
623
|
$dot->third( $parser->expression_list() ); |
929
|
230
|
|
|
|
|
602
|
$parser->advance(")"); |
930
|
230
|
|
|
|
|
680
|
$dot->arity("methodcall"); |
931
|
|
|
|
|
|
|
} |
932
|
|
|
|
|
|
|
|
933
|
447
|
|
|
|
|
3287
|
return $dot; |
934
|
|
|
|
|
|
|
} |
935
|
|
|
|
|
|
|
|
936
|
|
|
|
|
|
|
sub led_fetch { # $h[$field] |
937
|
90
|
|
|
90
|
0
|
164
|
my($parser, $symbol, $left) = @_; |
938
|
|
|
|
|
|
|
|
939
|
90
|
|
|
|
|
282
|
my $fetch = $symbol->clone( |
940
|
|
|
|
|
|
|
arity => "field", |
941
|
|
|
|
|
|
|
first => $left, |
942
|
|
|
|
|
|
|
second => $parser->expression(0), |
943
|
|
|
|
|
|
|
); |
944
|
90
|
|
|
|
|
2169
|
$parser->advance("]"); |
945
|
90
|
|
|
|
|
530
|
return $fetch; |
946
|
|
|
|
|
|
|
} |
947
|
|
|
|
|
|
|
|
948
|
|
|
|
|
|
|
sub call { |
949
|
193
|
|
|
193
|
0
|
403
|
my($parser, $function, @args) = @_; |
950
|
193
|
100
|
|
|
|
568
|
if(not ref $function) { |
951
|
4
|
|
|
|
|
9
|
$function = $parser->symbol('(name)')->clone( |
952
|
|
|
|
|
|
|
arity => 'name', |
953
|
|
|
|
|
|
|
id => $function, |
954
|
|
|
|
|
|
|
line => $parser->line, |
955
|
|
|
|
|
|
|
); |
956
|
|
|
|
|
|
|
} |
957
|
|
|
|
|
|
|
|
958
|
193
|
|
|
|
|
586
|
return $parser->symbol('(call)')->clone( |
959
|
|
|
|
|
|
|
arity => 'call', |
960
|
|
|
|
|
|
|
first => $function, |
961
|
|
|
|
|
|
|
second => \@args, |
962
|
|
|
|
|
|
|
); |
963
|
|
|
|
|
|
|
} |
964
|
|
|
|
|
|
|
|
965
|
|
|
|
|
|
|
sub led_call { |
966
|
295
|
|
|
295
|
0
|
497
|
my($parser, $symbol, $left) = @_; |
967
|
|
|
|
|
|
|
|
968
|
295
|
|
|
|
|
837
|
my $call = $symbol->clone(arity => 'call'); |
969
|
295
|
|
|
|
|
6158
|
$call->first($left); |
970
|
295
|
|
|
|
|
799
|
$call->second( $parser->expression_list() ); |
971
|
295
|
|
|
|
|
699
|
$parser->advance(")"); |
972
|
|
|
|
|
|
|
|
973
|
294
|
|
|
|
|
1675
|
return $call; |
974
|
|
|
|
|
|
|
} |
975
|
|
|
|
|
|
|
|
976
|
|
|
|
|
|
|
sub led_pipe { # filter |
977
|
64
|
|
|
64
|
0
|
106
|
my($parser, $symbol, $left) = @_; |
978
|
|
|
|
|
|
|
# a | b -> b(a) |
979
|
64
|
|
|
|
|
241
|
return $parser->call($parser->expression($symbol->lbp), $left); |
980
|
|
|
|
|
|
|
} |
981
|
|
|
|
|
|
|
|
982
|
|
|
|
|
|
|
sub led_range { # x .. y |
983
|
7
|
|
|
7
|
0
|
12
|
my($parser, $symbol, $left) = @_; |
984
|
7
|
|
|
|
|
24
|
return $symbol->clone( |
985
|
|
|
|
|
|
|
arity => 'range', |
986
|
|
|
|
|
|
|
first => $left, |
987
|
|
|
|
|
|
|
second => $parser->expression(0), |
988
|
|
|
|
|
|
|
); |
989
|
|
|
|
|
|
|
} |
990
|
|
|
|
|
|
|
|
991
|
|
|
|
|
|
|
sub nil { |
992
|
26
|
|
|
26
|
0
|
117
|
my($parser) = @_; |
993
|
26
|
|
|
|
|
80
|
return $parser->symbol('nil')->nud($parser); |
994
|
|
|
|
|
|
|
} |
995
|
|
|
|
|
|
|
|
996
|
|
|
|
|
|
|
sub nud_defined { |
997
|
23
|
|
|
23
|
0
|
42
|
my($parser, $symbol) = @_; |
998
|
23
|
|
|
|
|
62
|
$parser->reserve( $symbol->clone() ); |
999
|
|
|
|
|
|
|
# prefix: is a syntactic sugar to $a != nil |
1000
|
23
|
|
|
|
|
143
|
return $parser->binary( |
1001
|
|
|
|
|
|
|
'!=', |
1002
|
|
|
|
|
|
|
$parser->expression($symbol->ubp), |
1003
|
|
|
|
|
|
|
$parser->nil, |
1004
|
|
|
|
|
|
|
); |
1005
|
|
|
|
|
|
|
} |
1006
|
|
|
|
|
|
|
|
1007
|
|
|
|
|
|
|
# for special literals (e.g. nil, true, false) |
1008
|
|
|
|
|
|
|
sub nud_special { |
1009
|
170
|
|
|
170
|
0
|
307
|
my($parser, $symbol) = @_; |
1010
|
170
|
|
|
|
|
670
|
return $symbol->first; |
1011
|
|
|
|
|
|
|
} |
1012
|
|
|
|
|
|
|
|
1013
|
|
|
|
|
|
|
sub define_literal { # special literals |
1014
|
723
|
|
|
723
|
0
|
6501
|
my($parser, $id, $value) = @_; |
1015
|
|
|
|
|
|
|
|
1016
|
723
|
|
|
|
|
6889
|
my $symbol = $parser->symbol($id); |
1017
|
723
|
100
|
|
|
|
8813
|
$symbol->first( $symbol->clone( |
1018
|
|
|
|
|
|
|
arity => defined($value) ? 'literal' : 'nil', |
1019
|
|
|
|
|
|
|
value => $value, |
1020
|
|
|
|
|
|
|
) ); |
1021
|
723
|
|
|
|
|
15235
|
$symbol->set_nud(\&nud_special); |
1022
|
723
|
|
|
|
|
7716
|
$symbol->is_defined(1); |
1023
|
723
|
|
|
|
|
11404
|
return $symbol; |
1024
|
|
|
|
|
|
|
} |
1025
|
|
|
|
|
|
|
|
1026
|
|
|
|
|
|
|
sub new_scope { |
1027
|
918
|
|
|
918
|
0
|
1347
|
my($parser) = @_; |
1028
|
918
|
|
|
|
|
1178
|
push @{ $parser->scope }, {}; |
|
918
|
|
|
|
|
2954
|
|
1029
|
918
|
|
|
|
|
1722
|
return; |
1030
|
|
|
|
|
|
|
} |
1031
|
|
|
|
|
|
|
|
1032
|
|
|
|
|
|
|
sub pop_scope { |
1033
|
901
|
|
|
901
|
0
|
1355
|
my($parser) = @_; |
1034
|
901
|
|
|
|
|
1157
|
pop @{ $parser->scope }; |
|
901
|
|
|
|
|
2341
|
|
1035
|
901
|
|
|
|
|
2574
|
return; |
1036
|
|
|
|
|
|
|
} |
1037
|
|
|
|
|
|
|
|
1038
|
|
|
|
|
|
|
sub undefined_name { |
1039
|
3616
|
|
|
3616
|
0
|
7766
|
my($parser, $name) = @_; |
1040
|
3616
|
100
|
|
|
|
12738
|
if($name =~ /\A \$/xms) { |
1041
|
2845
|
|
|
|
|
13936
|
return $parser->symbol_table->{'(variable)'}->clone( |
1042
|
|
|
|
|
|
|
id => $name, |
1043
|
|
|
|
|
|
|
); |
1044
|
|
|
|
|
|
|
} |
1045
|
|
|
|
|
|
|
else { |
1046
|
771
|
|
|
|
|
3368
|
return $parser->symbol_table->{'(name)'}->clone( |
1047
|
|
|
|
|
|
|
id => $name, |
1048
|
|
|
|
|
|
|
); |
1049
|
|
|
|
|
|
|
} |
1050
|
|
|
|
|
|
|
} |
1051
|
|
|
|
|
|
|
|
1052
|
|
|
|
|
|
|
sub find_or_create { # find a name from all the scopes |
1053
|
19439
|
|
|
19439
|
0
|
36405
|
my($parser, $name) = @_; |
1054
|
19439
|
|
|
|
|
29127
|
my $s; |
1055
|
19439
|
|
|
|
|
29622
|
foreach my $scope(reverse @{$parser->scope}){ |
|
19439
|
|
|
|
|
70791
|
|
1056
|
22632
|
|
|
|
|
43160
|
$s = $scope->{$name}; |
1057
|
22632
|
100
|
|
|
|
67679
|
if(defined $s) { |
1058
|
6016
|
|
|
|
|
19586
|
return $s->clone(); |
1059
|
|
|
|
|
|
|
} |
1060
|
|
|
|
|
|
|
} |
1061
|
13423
|
|
|
|
|
43805
|
$s = $parser->symbol_table->{$name}; |
1062
|
13423
|
100
|
|
|
|
48983
|
return defined($s) ? $s : $parser->undefined_name($name); |
1063
|
|
|
|
|
|
|
} |
1064
|
|
|
|
|
|
|
|
1065
|
|
|
|
|
|
|
sub reserve { # reserve a name to the scope |
1066
|
13817
|
|
|
13817
|
0
|
25693
|
my($parser, $symbol) = @_; |
1067
|
13817
|
100
|
100
|
|
|
97042
|
if($symbol->arity ne 'name' or $symbol->is_reserved) { |
1068
|
13246
|
|
|
|
|
24809
|
return $symbol; |
1069
|
|
|
|
|
|
|
} |
1070
|
|
|
|
|
|
|
|
1071
|
571
|
|
|
|
|
5433
|
my $top = $parser->scope->[-1]; |
1072
|
571
|
|
|
|
|
5479
|
my $t = $top->{$symbol->id}; |
1073
|
571
|
50
|
|
|
|
5099
|
if($t) { |
1074
|
0
|
0
|
|
|
|
0
|
if($t->is_reserved) { |
1075
|
0
|
|
|
|
|
0
|
return $symbol; |
1076
|
|
|
|
|
|
|
} |
1077
|
0
|
0
|
|
|
|
0
|
if($t->arity eq "name") { |
1078
|
0
|
|
|
|
|
0
|
$parser->_error("Already defined: $symbol"); |
1079
|
|
|
|
|
|
|
} |
1080
|
|
|
|
|
|
|
} |
1081
|
571
|
|
|
|
|
5523
|
$top->{$symbol->id} = $symbol; |
1082
|
571
|
|
|
|
|
5709
|
$symbol->is_reserved(1); |
1083
|
|
|
|
|
|
|
#$symbol->scope($top); |
1084
|
571
|
|
|
|
|
8255
|
return $symbol; |
1085
|
|
|
|
|
|
|
} |
1086
|
|
|
|
|
|
|
|
1087
|
|
|
|
|
|
|
sub define { # define a name to the scope |
1088
|
595
|
|
|
595
|
0
|
938
|
my($parser, $symbol) = @_; |
1089
|
595
|
|
|
|
|
1514
|
my $top = $parser->scope->[-1]; |
1090
|
|
|
|
|
|
|
|
1091
|
595
|
|
|
|
|
1598
|
my $t = $top->{$symbol->id}; |
1092
|
595
|
100
|
|
|
|
1453
|
if(defined $t) { |
1093
|
1
|
50
|
|
|
|
8
|
$parser->_error($t->is_reserved ? "Already is_reserved: $t" : "Already defined: $t"); |
1094
|
|
|
|
|
|
|
} |
1095
|
|
|
|
|
|
|
|
1096
|
594
|
|
|
|
|
1940
|
$top->{$symbol->id} = $symbol; |
1097
|
|
|
|
|
|
|
|
1098
|
594
|
|
|
|
|
1619
|
$symbol->is_defined(1); |
1099
|
594
|
|
|
|
|
1801
|
$symbol->is_reserved(0); |
1100
|
594
|
|
|
|
|
1507
|
$symbol->remove_nud(); |
1101
|
594
|
|
|
|
|
1405
|
$symbol->remove_led(); |
1102
|
594
|
|
|
|
|
1313
|
$symbol->remove_std(); |
1103
|
594
|
|
|
|
|
1322
|
$symbol->lbp(0); |
1104
|
|
|
|
|
|
|
#$symbol->scope($top); |
1105
|
594
|
|
|
|
|
1173
|
return $symbol; |
1106
|
|
|
|
|
|
|
} |
1107
|
|
|
|
|
|
|
|
1108
|
|
|
|
|
|
|
sub print { |
1109
|
1223
|
|
|
1223
|
0
|
2549
|
my($parser, @args) = @_; |
1110
|
1223
|
|
|
|
|
2965
|
return $parser->symbol('print')->clone( |
1111
|
|
|
|
|
|
|
arity => 'print', |
1112
|
|
|
|
|
|
|
first => \@args, |
1113
|
|
|
|
|
|
|
line => $parser->line, |
1114
|
|
|
|
|
|
|
); |
1115
|
|
|
|
|
|
|
} |
1116
|
|
|
|
|
|
|
|
1117
|
|
|
|
|
|
|
sub binary { |
1118
|
994
|
|
|
994
|
0
|
1902
|
my($parser, $symbol, $lhs, $rhs) = @_; |
1119
|
994
|
100
|
|
|
|
2353
|
if(!ref $symbol) { |
1120
|
|
|
|
|
|
|
# operator |
1121
|
109
|
|
|
|
|
249
|
$symbol = $parser->symbol($symbol); |
1122
|
|
|
|
|
|
|
} |
1123
|
994
|
50
|
|
|
|
2165
|
if(!ref $lhs) { |
1124
|
|
|
|
|
|
|
# literal |
1125
|
0
|
|
|
|
|
0
|
$lhs = $parser->symbol('(literal)')->clone( |
1126
|
|
|
|
|
|
|
id => $lhs, |
1127
|
|
|
|
|
|
|
); |
1128
|
|
|
|
|
|
|
} |
1129
|
994
|
100
|
|
|
|
2165
|
if(!ref $rhs) { |
1130
|
|
|
|
|
|
|
# literal |
1131
|
39
|
|
|
|
|
81
|
$rhs = $parser->symbol('(literal)')->clone( |
1132
|
|
|
|
|
|
|
id => $rhs, |
1133
|
|
|
|
|
|
|
); |
1134
|
|
|
|
|
|
|
} |
1135
|
994
|
|
|
|
|
3708
|
return $symbol->clone( |
1136
|
|
|
|
|
|
|
arity => 'binary', |
1137
|
|
|
|
|
|
|
first => $lhs, |
1138
|
|
|
|
|
|
|
second => $rhs, |
1139
|
|
|
|
|
|
|
); |
1140
|
|
|
|
|
|
|
} |
1141
|
|
|
|
|
|
|
|
1142
|
|
|
|
|
|
|
sub define_function { |
1143
|
497
|
|
|
497
|
0
|
12645
|
my($parser, @names) = @_; |
1144
|
|
|
|
|
|
|
|
1145
|
497
|
|
|
|
|
2851
|
foreach my $name(@names) { |
1146
|
6035
|
|
|
|
|
53680
|
my $s = $parser->symbol($name); |
1147
|
6035
|
|
|
|
|
111482
|
$s->set_nud(\&nud_name); |
1148
|
6035
|
|
|
|
|
60735
|
$s->is_defined(1); |
1149
|
|
|
|
|
|
|
} |
1150
|
497
|
|
|
|
|
6943
|
return; |
1151
|
|
|
|
|
|
|
} |
1152
|
|
|
|
|
|
|
|
1153
|
|
|
|
|
|
|
sub finish_statement { |
1154
|
14066
|
|
|
14066
|
0
|
27663
|
my($parser, $expr) = @_; |
1155
|
|
|
|
|
|
|
|
1156
|
14066
|
|
|
|
|
37288
|
my $t = $parser->token; |
1157
|
14066
|
100
|
|
|
|
47286
|
if($t->can_be_modifier) { |
1158
|
30
|
|
|
|
|
63
|
$parser->advance(); |
1159
|
30
|
|
|
|
|
93
|
$expr = $t->std($parser, $expr); |
1160
|
30
|
|
|
|
|
78
|
$t = $parser->token; |
1161
|
|
|
|
|
|
|
} |
1162
|
|
|
|
|
|
|
|
1163
|
14066
|
100
|
100
|
|
|
107437
|
if($t->is_block_end or $parser->statement_is_finished) { |
|
|
100
|
|
|
|
|
|
1164
|
|
|
|
|
|
|
# noop |
1165
|
|
|
|
|
|
|
} |
1166
|
|
|
|
|
|
|
elsif($t->id eq ";") { |
1167
|
12617
|
|
|
|
|
30915
|
$parser->advance(); |
1168
|
|
|
|
|
|
|
} |
1169
|
|
|
|
|
|
|
else { |
1170
|
4
|
|
|
|
|
28
|
$parser->_unexpected("a semicolon or block end", $t); |
1171
|
|
|
|
|
|
|
} |
1172
|
14060
|
|
|
|
|
140305
|
return $expr; |
1173
|
|
|
|
|
|
|
} |
1174
|
|
|
|
|
|
|
|
1175
|
|
|
|
|
|
|
sub statement { # process one or more statements |
1176
|
15329
|
|
|
15329
|
0
|
25862
|
my($parser) = @_; |
1177
|
15329
|
|
|
|
|
37400
|
my $t = $parser->token; |
1178
|
|
|
|
|
|
|
|
1179
|
15329
|
100
|
|
|
|
52559
|
if($t->id eq ";"){ |
1180
|
448
|
|
|
|
|
941
|
$parser->advance(); # ";" |
1181
|
448
|
|
|
|
|
2230
|
return; |
1182
|
|
|
|
|
|
|
} |
1183
|
|
|
|
|
|
|
|
1184
|
14881
|
100
|
|
|
|
49253
|
if($t->has_std) { # is $t a statement? |
1185
|
13655
|
|
|
|
|
34457
|
$parser->reserve($t); |
1186
|
13655
|
|
|
|
|
32820
|
$parser->advance(); |
1187
|
|
|
|
|
|
|
|
1188
|
|
|
|
|
|
|
# std() can return a list of nodes |
1189
|
13655
|
|
|
|
|
44585
|
return $t->std($parser); |
1190
|
|
|
|
|
|
|
} |
1191
|
|
|
|
|
|
|
|
1192
|
1226
|
|
|
|
|
3056
|
my $expr = $parser->auto_command( $parser->expression(0) ); |
1193
|
1200
|
|
|
|
|
25609
|
return $parser->finish_statement($expr); |
1194
|
|
|
|
|
|
|
} |
1195
|
|
|
|
|
|
|
|
1196
|
|
|
|
|
|
|
sub auto_command { |
1197
|
1200
|
|
|
1200
|
0
|
1930
|
my($parser, $expr) = @_; |
1198
|
1200
|
100
|
|
|
|
3817
|
if($expr->is_statement) { |
1199
|
|
|
|
|
|
|
# expressions can produce pure statements (e.g. assignment ) |
1200
|
81
|
|
|
|
|
154
|
return $expr; |
1201
|
|
|
|
|
|
|
} |
1202
|
|
|
|
|
|
|
else { |
1203
|
1119
|
|
|
|
|
3129
|
return $parser->print($expr); |
1204
|
|
|
|
|
|
|
} |
1205
|
|
|
|
|
|
|
} |
1206
|
|
|
|
|
|
|
|
1207
|
|
|
|
|
|
|
sub statements { # process statements |
1208
|
4317
|
|
|
4317
|
0
|
7599
|
my($parser) = @_; |
1209
|
4317
|
|
|
|
|
7370
|
my @a; |
1210
|
|
|
|
|
|
|
|
1211
|
4317
|
|
|
|
|
20841
|
for(my $t = $parser->token; !$t->is_block_end; $t = $parser->token) { |
1212
|
15279
|
|
|
|
|
40652
|
push @a, $parser->statement(); |
1213
|
|
|
|
|
|
|
} |
1214
|
|
|
|
|
|
|
|
1215
|
4266
|
|
|
|
|
13799
|
return \@a; |
1216
|
|
|
|
|
|
|
} |
1217
|
|
|
|
|
|
|
|
1218
|
|
|
|
|
|
|
sub block { |
1219
|
212
|
|
|
212
|
0
|
317
|
my($parser) = @_; |
1220
|
212
|
|
|
|
|
490
|
$parser->new_scope(); |
1221
|
212
|
|
|
|
|
447
|
$parser->advance("{"); |
1222
|
212
|
|
|
|
|
458
|
my $a = $parser->statements(); |
1223
|
212
|
|
|
|
|
486
|
$parser->advance("}"); |
1224
|
211
|
|
|
|
|
478
|
$parser->pop_scope(); |
1225
|
211
|
|
|
|
|
648
|
return $a; |
1226
|
|
|
|
|
|
|
} |
1227
|
|
|
|
|
|
|
|
1228
|
|
|
|
|
|
|
sub nud_paren { |
1229
|
121
|
|
|
121
|
0
|
198
|
my($parser, $symbol) = @_; |
1230
|
121
|
|
|
|
|
329
|
my $expr = $parser->expression(0); |
1231
|
121
|
|
|
|
|
462
|
$parser->advance( $symbol->counterpart ); |
1232
|
121
|
|
|
|
|
272
|
return $expr; |
1233
|
|
|
|
|
|
|
} |
1234
|
|
|
|
|
|
|
|
1235
|
|
|
|
|
|
|
# for object literals |
1236
|
|
|
|
|
|
|
sub nud_brace { |
1237
|
141
|
|
|
141
|
0
|
251
|
my($parser, $symbol) = @_; |
1238
|
|
|
|
|
|
|
|
1239
|
141
|
|
|
|
|
429
|
my $list = $parser->expression_list(); |
1240
|
|
|
|
|
|
|
|
1241
|
141
|
|
|
|
|
567
|
$parser->advance($symbol->counterpart); |
1242
|
141
|
|
|
|
|
470
|
return $symbol->clone( |
1243
|
|
|
|
|
|
|
arity => 'composer', |
1244
|
|
|
|
|
|
|
first => $list, |
1245
|
|
|
|
|
|
|
); |
1246
|
|
|
|
|
|
|
} |
1247
|
|
|
|
|
|
|
|
1248
|
|
|
|
|
|
|
# iterator variables ($~iterator) |
1249
|
|
|
|
|
|
|
# $~iterator . NAME | NAME() |
1250
|
|
|
|
|
|
|
sub nud_iterator { |
1251
|
55
|
|
|
55
|
0
|
111
|
my($parser, $symbol) = @_; |
1252
|
|
|
|
|
|
|
|
1253
|
55
|
|
|
|
|
140
|
my $iterator = $symbol->clone(); |
1254
|
55
|
100
|
|
|
|
1262
|
if($parser->token->id eq ".") { |
1255
|
51
|
|
|
|
|
111
|
$parser->advance(); |
1256
|
|
|
|
|
|
|
|
1257
|
51
|
|
|
|
|
183
|
my $t = $parser->token; |
1258
|
51
|
50
|
|
|
|
229
|
if(!any_in($t->arity, qw(variable name))) { |
1259
|
0
|
|
|
|
|
0
|
$parser->_unexpected("a field name", $t); |
1260
|
|
|
|
|
|
|
} |
1261
|
|
|
|
|
|
|
|
1262
|
51
|
|
|
|
|
424
|
my $generator = $parser->iterator_element->{$t->value}; |
1263
|
51
|
50
|
|
|
|
189
|
if(!$generator) { |
1264
|
0
|
|
|
|
|
0
|
$parser->_error("Undefined iterator element: $t"); |
1265
|
|
|
|
|
|
|
} |
1266
|
|
|
|
|
|
|
|
1267
|
51
|
|
|
|
|
118
|
$parser->advance(); # element name |
1268
|
|
|
|
|
|
|
|
1269
|
51
|
|
|
|
|
64
|
my $args; |
1270
|
51
|
100
|
|
|
|
224
|
if($parser->token->id eq "(") { |
1271
|
15
|
|
|
|
|
35
|
$parser->advance(); |
1272
|
15
|
|
|
|
|
35
|
$args = $parser->expression_list(); |
1273
|
15
|
|
|
|
|
37
|
$parser->advance(")"); |
1274
|
|
|
|
|
|
|
} |
1275
|
|
|
|
|
|
|
|
1276
|
51
|
|
|
|
|
146
|
$iterator->second($t); |
1277
|
51
|
|
|
|
|
66
|
return $generator->($parser, $iterator, @{$args}); |
|
51
|
|
|
|
|
173
|
|
1278
|
|
|
|
|
|
|
} |
1279
|
4
|
|
|
|
|
10
|
return $iterator; |
1280
|
|
|
|
|
|
|
} |
1281
|
|
|
|
|
|
|
|
1282
|
|
|
|
|
|
|
sub nud_constant { |
1283
|
70
|
|
|
70
|
0
|
112
|
my($parser, $symbol) = @_; |
1284
|
70
|
|
|
|
|
176
|
my $t = $parser->token; |
1285
|
|
|
|
|
|
|
|
1286
|
70
|
50
|
|
|
|
318
|
my $expect = $symbol->id eq 'constant' ? 'name' |
|
|
100
|
|
|
|
|
|
1287
|
|
|
|
|
|
|
: $symbol->id eq 'my' ? 'variable' |
1288
|
|
|
|
|
|
|
: die "Oops: $symbol"; |
1289
|
|
|
|
|
|
|
|
1290
|
70
|
50
|
|
|
|
245
|
if($t->arity ne $expect) { |
1291
|
0
|
|
|
|
|
0
|
$parser->_unexpected("a $expect", $t); |
1292
|
|
|
|
|
|
|
} |
1293
|
70
|
|
|
|
|
200
|
$parser->define($t)->arity("name"); |
1294
|
|
|
|
|
|
|
|
1295
|
69
|
|
|
|
|
152
|
$parser->advance(); |
1296
|
69
|
|
|
|
|
153
|
$parser->advance("="); |
1297
|
|
|
|
|
|
|
|
1298
|
69
|
|
|
|
|
182
|
return $symbol->clone( |
1299
|
|
|
|
|
|
|
arity => 'constant', |
1300
|
|
|
|
|
|
|
first => $t, |
1301
|
|
|
|
|
|
|
second => $parser->expression(0), |
1302
|
|
|
|
|
|
|
is_statement => 1, |
1303
|
|
|
|
|
|
|
); |
1304
|
|
|
|
|
|
|
} |
1305
|
|
|
|
|
|
|
|
1306
|
|
|
|
|
|
|
my $lambda_id = 0; |
1307
|
|
|
|
|
|
|
sub lambda { |
1308
|
56
|
|
|
56
|
0
|
556
|
my($parser, $proto) = @_; |
1309
|
56
|
|
|
|
|
146
|
my $name = $parser->symbol('(name)')->clone( |
1310
|
|
|
|
|
|
|
id => sprintf('lambda@%s:%d', $parser->file, $lambda_id++), |
1311
|
|
|
|
|
|
|
); |
1312
|
|
|
|
|
|
|
|
1313
|
56
|
|
|
|
|
1187
|
return $parser->symbol('(name)')->clone( |
1314
|
|
|
|
|
|
|
arity => 'proc', |
1315
|
|
|
|
|
|
|
id => 'macro', |
1316
|
|
|
|
|
|
|
first => $name, |
1317
|
|
|
|
|
|
|
line => $proto->line, |
1318
|
|
|
|
|
|
|
); |
1319
|
|
|
|
|
|
|
} |
1320
|
|
|
|
|
|
|
|
1321
|
|
|
|
|
|
|
# -> $x { ... } |
1322
|
|
|
|
|
|
|
sub nud_lambda { |
1323
|
39
|
|
|
39
|
0
|
61
|
my($parser, $symbol) = @_; |
1324
|
|
|
|
|
|
|
|
1325
|
39
|
|
|
|
|
114
|
my $pointy = $parser->lambda($symbol); |
1326
|
|
|
|
|
|
|
|
1327
|
39
|
|
|
|
|
963
|
$parser->new_scope(); |
1328
|
39
|
|
|
|
|
49
|
my @params; |
1329
|
39
|
50
|
|
|
|
178
|
if($parser->token->id ne "{") { # has params |
1330
|
39
|
|
|
|
|
125
|
my $paren = ($parser->token->id eq "("); |
1331
|
|
|
|
|
|
|
|
1332
|
39
|
50
|
|
|
|
89
|
$parser->advance("(") if $paren; # optional |
1333
|
|
|
|
|
|
|
|
1334
|
39
|
|
|
|
|
83
|
my $t = $parser->token; |
1335
|
39
|
|
|
|
|
150
|
while($t->arity eq "variable") { |
1336
|
54
|
|
|
|
|
93
|
push @params, $t; |
1337
|
54
|
|
|
|
|
132
|
$parser->define($t); |
1338
|
|
|
|
|
|
|
|
1339
|
54
|
|
|
|
|
116
|
$t = $parser->advance(); |
1340
|
54
|
100
|
|
|
|
183
|
if($t->id eq ",") { |
1341
|
15
|
|
|
|
|
30
|
$t = $parser->advance(); # "," |
1342
|
|
|
|
|
|
|
} |
1343
|
|
|
|
|
|
|
else { |
1344
|
39
|
|
|
|
|
61
|
last; |
1345
|
|
|
|
|
|
|
} |
1346
|
|
|
|
|
|
|
} |
1347
|
|
|
|
|
|
|
|
1348
|
39
|
50
|
|
|
|
107
|
$parser->advance(")") if $paren; |
1349
|
|
|
|
|
|
|
} |
1350
|
39
|
|
|
|
|
140
|
$pointy->second( \@params ); |
1351
|
|
|
|
|
|
|
|
1352
|
39
|
|
|
|
|
92
|
$parser->advance("{"); |
1353
|
39
|
|
|
|
|
103
|
$pointy->third($parser->statements()); |
1354
|
39
|
|
|
|
|
91
|
$parser->advance("}"); |
1355
|
39
|
|
|
|
|
94
|
$parser->pop_scope(); |
1356
|
|
|
|
|
|
|
|
1357
|
39
|
|
|
|
|
112
|
return $symbol->clone( |
1358
|
|
|
|
|
|
|
arity => 'lambda', |
1359
|
|
|
|
|
|
|
first => $pointy, |
1360
|
|
|
|
|
|
|
); |
1361
|
|
|
|
|
|
|
} |
1362
|
|
|
|
|
|
|
|
1363
|
|
|
|
|
|
|
sub nud_current_file { |
1364
|
1
|
|
|
1
|
0
|
3
|
my($self, $symbol) = @_; |
1365
|
1
|
|
|
|
|
7
|
my $file = $self->file; |
1366
|
1
|
50
|
|
|
|
6
|
return $symbol->clone( |
1367
|
|
|
|
|
|
|
arity => 'literal', |
1368
|
|
|
|
|
|
|
value => ref($file) ? '' : $file, |
1369
|
|
|
|
|
|
|
); |
1370
|
|
|
|
|
|
|
} |
1371
|
|
|
|
|
|
|
|
1372
|
|
|
|
|
|
|
sub nud_current_line { |
1373
|
14
|
|
|
14
|
0
|
29
|
my($self, $symbol) = @_; |
1374
|
14
|
|
|
|
|
54
|
return $symbol->clone( |
1375
|
|
|
|
|
|
|
arity => 'literal', |
1376
|
|
|
|
|
|
|
value => $symbol->line, |
1377
|
|
|
|
|
|
|
); |
1378
|
|
|
|
|
|
|
} |
1379
|
|
|
|
|
|
|
|
1380
|
|
|
|
|
|
|
sub nud_current_vars { |
1381
|
5
|
|
|
5
|
0
|
10
|
my($self, $symbol) = @_; |
1382
|
5
|
|
|
|
|
14
|
return $symbol->clone( |
1383
|
|
|
|
|
|
|
arity => 'vars', |
1384
|
|
|
|
|
|
|
); |
1385
|
|
|
|
|
|
|
} |
1386
|
|
|
|
|
|
|
|
1387
|
|
|
|
|
|
|
sub nud_separator { |
1388
|
4
|
|
|
4
|
0
|
6
|
my($self, $symbol) = @_; |
1389
|
4
|
|
|
|
|
12
|
$self->_error("Invalid expression found", $symbol); |
1390
|
|
|
|
|
|
|
} |
1391
|
|
|
|
|
|
|
|
1392
|
|
|
|
|
|
|
# -> VARS { STATEMENTS } |
1393
|
|
|
|
|
|
|
# -> { STATEMENTS } |
1394
|
|
|
|
|
|
|
# { STATEMENTS } |
1395
|
|
|
|
|
|
|
sub pointy { |
1396
|
436
|
|
|
436
|
0
|
790
|
my($parser, $pointy, $in_for) = @_; |
1397
|
|
|
|
|
|
|
|
1398
|
436
|
|
|
|
|
556
|
my @params; |
1399
|
|
|
|
|
|
|
|
1400
|
436
|
|
|
|
|
1200
|
$parser->new_scope(); |
1401
|
|
|
|
|
|
|
|
1402
|
436
|
100
|
|
|
|
2028
|
if($parser->token->id eq "->") { |
1403
|
416
|
|
|
|
|
880
|
$parser->advance(); |
1404
|
416
|
100
|
|
|
|
2054
|
if($parser->token->id ne "{") { |
1405
|
225
|
|
|
|
|
835
|
my $paren = ($parser->token->id eq "("); |
1406
|
|
|
|
|
|
|
|
1407
|
225
|
100
|
|
|
|
654
|
$parser->advance("(") if $paren; |
1408
|
|
|
|
|
|
|
|
1409
|
225
|
|
|
|
|
549
|
my $t = $parser->token; |
1410
|
225
|
|
|
|
|
867
|
while($t->arity eq "variable") { |
1411
|
231
|
|
|
|
|
447
|
push @params, $t; |
1412
|
231
|
|
|
|
|
692
|
$parser->define($t); |
1413
|
|
|
|
|
|
|
|
1414
|
231
|
100
|
|
|
|
564
|
if($in_for) { |
1415
|
149
|
|
|
|
|
492
|
$parser->define_iterator($t); |
1416
|
|
|
|
|
|
|
} |
1417
|
|
|
|
|
|
|
|
1418
|
231
|
|
|
|
|
548
|
$t = $parser->advance(); |
1419
|
|
|
|
|
|
|
|
1420
|
231
|
100
|
|
|
|
1056
|
if($t->id eq ",") { |
1421
|
7
|
|
|
|
|
22
|
$t = $parser->advance(); # "," |
1422
|
|
|
|
|
|
|
} |
1423
|
|
|
|
|
|
|
else { |
1424
|
224
|
|
|
|
|
350
|
last; |
1425
|
|
|
|
|
|
|
} |
1426
|
|
|
|
|
|
|
} |
1427
|
|
|
|
|
|
|
|
1428
|
225
|
100
|
|
|
|
709
|
$parser->advance(")") if $paren; |
1429
|
|
|
|
|
|
|
} |
1430
|
|
|
|
|
|
|
} |
1431
|
434
|
|
|
|
|
1606
|
$pointy->second( \@params ); |
1432
|
|
|
|
|
|
|
|
1433
|
434
|
|
|
|
|
1213
|
$parser->advance("{"); |
1434
|
432
|
|
|
|
|
1156
|
$pointy->third($parser->statements()); |
1435
|
422
|
|
|
|
|
1057
|
$parser->advance("}"); |
1436
|
422
|
|
|
|
|
1298
|
$parser->pop_scope(); |
1437
|
|
|
|
|
|
|
|
1438
|
422
|
|
|
|
|
779
|
return; |
1439
|
|
|
|
|
|
|
} |
1440
|
|
|
|
|
|
|
|
1441
|
|
|
|
|
|
|
sub iterator_name { |
1442
|
149
|
|
|
149
|
0
|
224
|
my($parser, $var) = @_; |
1443
|
|
|
|
|
|
|
# $foo -> $~foo |
1444
|
149
|
|
|
|
|
1194
|
(my $it_name = $var->id) =~ s/\A (\$?) /${1}~/xms; |
1445
|
149
|
|
|
|
|
603
|
return $it_name; |
1446
|
|
|
|
|
|
|
} |
1447
|
|
|
|
|
|
|
|
1448
|
|
|
|
|
|
|
sub define_iterator { |
1449
|
184
|
|
|
184
|
0
|
370
|
my($parser, $var) = @_; |
1450
|
|
|
|
|
|
|
|
1451
|
184
|
|
|
|
|
592
|
my $it = $parser->symbol( $parser->iterator_name($var) )->clone( |
1452
|
|
|
|
|
|
|
arity => 'iterator', |
1453
|
|
|
|
|
|
|
first => $var, |
1454
|
|
|
|
|
|
|
); |
1455
|
184
|
|
|
|
|
4046
|
$parser->define($it); |
1456
|
184
|
|
|
|
|
1236
|
$it->set_nud(\&nud_iterator); |
1457
|
184
|
|
|
|
|
425
|
return $it; |
1458
|
|
|
|
|
|
|
} |
1459
|
|
|
|
|
|
|
|
1460
|
|
|
|
|
|
|
sub std_for { |
1461
|
149
|
|
|
149
|
0
|
296
|
my($parser, $symbol) = @_; |
1462
|
|
|
|
|
|
|
|
1463
|
149
|
|
|
|
|
482
|
my $proc = $symbol->clone(arity => 'for'); |
1464
|
149
|
|
|
|
|
3181
|
$proc->first( $parser->expression(0) ); |
1465
|
149
|
|
|
|
|
610
|
$parser->pointy($proc, 1); |
1466
|
|
|
|
|
|
|
|
1467
|
|
|
|
|
|
|
# for-else support |
1468
|
139
|
100
|
|
|
|
2114
|
if($parser->token eq 'else') { |
1469
|
5
|
|
|
|
|
13
|
$parser->advance(); |
1470
|
5
|
|
|
|
|
19
|
my $else = $parser->block(); |
1471
|
5
|
|
|
|
|
20
|
$proc = $symbol->clone( arity => 'for_else', |
1472
|
|
|
|
|
|
|
first => $proc, |
1473
|
|
|
|
|
|
|
second => $else, |
1474
|
|
|
|
|
|
|
) |
1475
|
|
|
|
|
|
|
} |
1476
|
139
|
|
|
|
|
1048
|
return $proc; |
1477
|
|
|
|
|
|
|
} |
1478
|
|
|
|
|
|
|
|
1479
|
|
|
|
|
|
|
sub std_while { |
1480
|
15
|
|
|
15
|
0
|
23
|
my($parser, $symbol) = @_; |
1481
|
|
|
|
|
|
|
|
1482
|
15
|
|
|
|
|
51
|
my $proc = $symbol->clone(arity => 'while'); |
1483
|
15
|
|
|
|
|
321
|
$proc->first( $parser->expression(0) ); |
1484
|
15
|
|
|
|
|
46
|
$parser->pointy($proc); |
1485
|
15
|
|
|
|
|
97
|
return $proc; |
1486
|
|
|
|
|
|
|
} |
1487
|
|
|
|
|
|
|
|
1488
|
|
|
|
|
|
|
# macro name -> { ... } |
1489
|
|
|
|
|
|
|
sub std_proc { |
1490
|
150
|
|
|
150
|
0
|
379
|
my($parser, $symbol) = @_; |
1491
|
|
|
|
|
|
|
|
1492
|
150
|
|
|
|
|
458
|
my $macro = $symbol->clone(arity => "proc"); |
1493
|
150
|
|
|
|
|
3009
|
my $name = $parser->token; |
1494
|
|
|
|
|
|
|
|
1495
|
150
|
50
|
|
|
|
688
|
if($name->arity ne "name") { |
1496
|
0
|
|
|
|
|
0
|
$parser->_unexpected("a name", $name); |
1497
|
|
|
|
|
|
|
} |
1498
|
|
|
|
|
|
|
|
1499
|
150
|
|
|
|
|
572
|
$parser->define_function($name->id); |
1500
|
150
|
|
|
|
|
409
|
$macro->first($name); |
1501
|
150
|
|
|
|
|
346
|
$parser->advance(); |
1502
|
150
|
|
|
|
|
473
|
$parser->pointy($macro); |
1503
|
146
|
|
|
|
|
881
|
return $macro; |
1504
|
|
|
|
|
|
|
} |
1505
|
|
|
|
|
|
|
|
1506
|
|
|
|
|
|
|
# block name -> { ... } |
1507
|
|
|
|
|
|
|
# block name | filter -> { ... } |
1508
|
|
|
|
|
|
|
sub std_macro_block { |
1509
|
92
|
|
|
92
|
0
|
169
|
my($parser, $symbol) = @_; |
1510
|
|
|
|
|
|
|
|
1511
|
92
|
|
|
|
|
295
|
my $macro = $symbol->clone(arity => "proc"); |
1512
|
92
|
|
|
|
|
1907
|
my $name = $parser->token; |
1513
|
|
|
|
|
|
|
|
1514
|
92
|
50
|
|
|
|
418
|
if($name->arity ne "name") { |
1515
|
0
|
|
|
|
|
0
|
$parser->_unexpected("a name", $name); |
1516
|
|
|
|
|
|
|
} |
1517
|
|
|
|
|
|
|
|
1518
|
|
|
|
|
|
|
# auto filters |
1519
|
92
|
|
|
|
|
137
|
my @filters; |
1520
|
92
|
|
|
|
|
262
|
my $t = $parser->advance(); |
1521
|
92
|
|
|
|
|
420
|
while($t->id eq "|") { |
1522
|
11
|
|
|
|
|
48
|
$t = $parser->advance(); |
1523
|
|
|
|
|
|
|
|
1524
|
11
|
50
|
|
|
|
63
|
if($t->arity ne "name") { |
1525
|
0
|
|
|
|
|
0
|
$parser->_unexpected("a name", $name); |
1526
|
|
|
|
|
|
|
} |
1527
|
11
|
|
|
|
|
35
|
my $filter = $t->clone(); |
1528
|
11
|
|
|
|
|
184
|
$t = $parser->advance(); |
1529
|
|
|
|
|
|
|
|
1530
|
11
|
|
|
|
|
15
|
my $args; |
1531
|
11
|
100
|
|
|
|
42
|
if($t->id eq "(") { |
1532
|
2
|
|
|
|
|
6
|
$parser->advance(); |
1533
|
2
|
|
|
|
|
6
|
$args = $parser->expression_list(); |
1534
|
2
|
|
|
|
|
7
|
$t = $parser->advance(")"); |
1535
|
|
|
|
|
|
|
} |
1536
|
|
|
|
|
|
|
push @filters, $args |
1537
|
11
|
100
|
|
|
|
85
|
? $parser->call($filter, @{$args}) |
|
2
|
|
|
|
|
8
|
|
1538
|
|
|
|
|
|
|
: $filter; |
1539
|
|
|
|
|
|
|
} |
1540
|
|
|
|
|
|
|
|
1541
|
92
|
|
|
|
|
387
|
$parser->define_function($name->id); |
1542
|
92
|
|
|
|
|
246
|
$macro->first($name); |
1543
|
92
|
|
|
|
|
288
|
$parser->pointy($macro); |
1544
|
|
|
|
|
|
|
|
1545
|
92
|
|
|
|
|
478
|
my $call = $parser->call($macro->first); |
1546
|
92
|
100
|
|
|
|
2059
|
if(@filters) { |
1547
|
9
|
|
|
|
|
18
|
foreach my $filter(@filters) { # apply filters |
1548
|
11
|
|
|
|
|
63
|
$call = $parser->call($filter, $call); |
1549
|
|
|
|
|
|
|
} |
1550
|
|
|
|
|
|
|
} |
1551
|
|
|
|
|
|
|
# std() can return a list |
1552
|
92
|
|
|
|
|
502
|
return( $macro, $parser->print($call) ); |
1553
|
|
|
|
|
|
|
} |
1554
|
|
|
|
|
|
|
|
1555
|
|
|
|
|
|
|
sub std_override { # synonym to 'around' |
1556
|
6
|
|
|
6
|
0
|
13
|
my($parser, $symbol) = @_; |
1557
|
|
|
|
|
|
|
|
1558
|
6
|
|
|
|
|
20
|
return $parser->std_proc($symbol->clone(id => 'around')); |
1559
|
|
|
|
|
|
|
} |
1560
|
|
|
|
|
|
|
|
1561
|
|
|
|
|
|
|
sub std_if { |
1562
|
112
|
|
|
112
|
0
|
186
|
my($parser, $symbol, $expr) = @_; |
1563
|
|
|
|
|
|
|
|
1564
|
112
|
|
|
|
|
317
|
my $if = $symbol->clone(arity => "if"); |
1565
|
|
|
|
|
|
|
|
1566
|
112
|
|
|
|
|
2317
|
$if->first( $parser->expression(0) ); |
1567
|
|
|
|
|
|
|
|
1568
|
112
|
100
|
|
|
|
291
|
if(defined $expr) { # statement modifier |
1569
|
13
|
|
|
|
|
47
|
$if->second([$expr]); |
1570
|
13
|
|
|
|
|
35
|
return $if; |
1571
|
|
|
|
|
|
|
} |
1572
|
|
|
|
|
|
|
|
1573
|
99
|
|
|
|
|
293
|
$if->second( $parser->block() ); |
1574
|
|
|
|
|
|
|
|
1575
|
98
|
|
|
|
|
128
|
my $top_if = $if; |
1576
|
|
|
|
|
|
|
|
1577
|
98
|
|
|
|
|
227
|
my $t = $parser->token; |
1578
|
98
|
|
|
|
|
375
|
while($t->id eq "elsif") { |
1579
|
3
|
|
|
|
|
8
|
$parser->reserve($t); |
1580
|
3
|
|
|
|
|
7
|
$parser->advance(); # "elsif" |
1581
|
|
|
|
|
|
|
|
1582
|
3
|
|
|
|
|
10
|
my $elsif = $t->clone(arity => "if"); |
1583
|
3
|
|
|
|
|
57
|
$elsif->first( $parser->expression(0) ); |
1584
|
3
|
|
|
|
|
9
|
$elsif->second( $parser->block() ); |
1585
|
3
|
|
|
|
|
11
|
$if->third([$elsif]); |
1586
|
3
|
|
|
|
|
3
|
$if = $elsif; |
1587
|
3
|
|
|
|
|
14
|
$t = $parser->token; |
1588
|
|
|
|
|
|
|
} |
1589
|
|
|
|
|
|
|
|
1590
|
98
|
100
|
|
|
|
356
|
if($t->id eq "else") { |
1591
|
56
|
|
|
|
|
146
|
$parser->reserve($t); |
1592
|
56
|
|
|
|
|
117
|
$t = $parser->advance(); # "else" |
1593
|
|
|
|
|
|
|
|
1594
|
56
|
100
|
|
|
|
263
|
$if->third( $t->id eq "if" |
1595
|
|
|
|
|
|
|
? [$parser->statement()] |
1596
|
|
|
|
|
|
|
: $parser->block()); |
1597
|
|
|
|
|
|
|
} |
1598
|
98
|
|
|
|
|
762
|
return $top_if; |
1599
|
|
|
|
|
|
|
} |
1600
|
|
|
|
|
|
|
|
1601
|
|
|
|
|
|
|
sub std_given { |
1602
|
30
|
|
|
30
|
0
|
46
|
my($parser, $symbol) = @_; |
1603
|
|
|
|
|
|
|
|
1604
|
30
|
|
|
|
|
85
|
my $given = $symbol->clone(arity => 'given'); |
1605
|
30
|
|
|
|
|
616
|
$given->first( $parser->expression(0) ); |
1606
|
|
|
|
|
|
|
|
1607
|
30
|
|
|
|
|
68
|
local $parser->{in_given} = 1; |
1608
|
30
|
|
|
|
|
85
|
$parser->pointy($given); |
1609
|
|
|
|
|
|
|
|
1610
|
30
|
100
|
66
|
|
|
124
|
if(!(defined $given->second && @{$given->second})) { # if no topic vars |
|
30
|
|
|
|
|
164
|
|
1611
|
14
|
|
|
|
|
39
|
$given->second([ |
1612
|
|
|
|
|
|
|
$parser->symbol('($_)')->clone(arity => 'variable' ) |
1613
|
|
|
|
|
|
|
]); |
1614
|
|
|
|
|
|
|
} |
1615
|
|
|
|
|
|
|
|
1616
|
30
|
|
|
|
|
435
|
$parser->build_given_body($given, "when"); |
1617
|
30
|
|
|
|
|
196
|
return $given; |
1618
|
|
|
|
|
|
|
} |
1619
|
|
|
|
|
|
|
|
1620
|
|
|
|
|
|
|
# when/default |
1621
|
|
|
|
|
|
|
sub std_when { |
1622
|
60
|
|
|
60
|
0
|
84
|
my($parser, $symbol) = @_; |
1623
|
|
|
|
|
|
|
|
1624
|
60
|
50
|
|
|
|
205
|
if(!$parser->in_given) { |
1625
|
0
|
|
|
|
|
0
|
$parser->_error("You cannot use $symbol blocks outside given blocks"); |
1626
|
|
|
|
|
|
|
} |
1627
|
60
|
|
|
|
|
163
|
my $proc = $symbol->clone(arity => 'when'); |
1628
|
60
|
100
|
|
|
|
1240
|
if($symbol->id eq "when") { |
1629
|
31
|
|
|
|
|
204
|
$proc->first( $parser->expression(0) ); |
1630
|
|
|
|
|
|
|
} |
1631
|
60
|
|
|
|
|
139
|
$proc->second( $parser->block() ); |
1632
|
60
|
|
|
|
|
338
|
return $proc; |
1633
|
|
|
|
|
|
|
} |
1634
|
|
|
|
|
|
|
|
1635
|
|
|
|
|
|
|
sub _only_white_spaces { |
1636
|
21
|
|
|
21
|
|
31
|
my($s) = @_; |
1637
|
21
|
|
33
|
|
|
230
|
return $s->arity eq "literal" |
1638
|
|
|
|
|
|
|
&& $s->value =~ m{\A [ \t\r\n]* \z}xms |
1639
|
|
|
|
|
|
|
} |
1640
|
|
|
|
|
|
|
|
1641
|
|
|
|
|
|
|
sub build_given_body { |
1642
|
40
|
|
|
40
|
0
|
75
|
my($parser, $given, $expect) = @_; |
1643
|
40
|
|
|
|
|
47
|
my($topic) = @{$given->second}; |
|
40
|
|
|
|
|
127
|
|
1644
|
|
|
|
|
|
|
|
1645
|
|
|
|
|
|
|
# make if-elsif-else chain from given-when |
1646
|
40
|
|
|
|
|
55
|
my $if; |
1647
|
|
|
|
|
|
|
my $elsif; |
1648
|
0
|
|
|
|
|
0
|
my $else; |
1649
|
40
|
|
|
|
|
61
|
foreach my $when(@{$given->third}) { |
|
40
|
|
|
|
|
122
|
|
1650
|
101
|
100
|
|
|
|
309
|
if($when->arity ne $expect) { |
1651
|
|
|
|
|
|
|
# ignore white space |
1652
|
22
|
100
|
66
|
|
|
81
|
if($when->id eq "print_raw" |
1653
|
21
|
|
|
|
|
39
|
&& !grep { !_only_white_spaces($_) } @{$when->first}) { |
|
21
|
|
|
|
|
49
|
|
1654
|
21
|
|
|
|
|
38
|
next; |
1655
|
|
|
|
|
|
|
} |
1656
|
1
|
|
|
|
|
5
|
$parser->_unexpected("$expect blocks", $when); |
1657
|
|
|
|
|
|
|
} |
1658
|
79
|
|
|
|
|
184
|
$when->arity("if"); # change the arity |
1659
|
|
|
|
|
|
|
|
1660
|
79
|
100
|
|
|
|
221
|
if(defined(my $test = $when->first)) { # when |
1661
|
43
|
100
|
|
|
|
143
|
if(!$test->is_logical) { |
1662
|
31
|
|
|
|
|
86
|
$when->first( $parser->binary('~~', $topic, $test) ); |
1663
|
|
|
|
|
|
|
} |
1664
|
|
|
|
|
|
|
} |
1665
|
|
|
|
|
|
|
else { # default |
1666
|
36
|
|
|
|
|
96
|
$when->first( $parser->symbol('true')->nud($parser) ); |
1667
|
36
|
|
|
|
|
50
|
$else = $when; |
1668
|
36
|
|
|
|
|
81
|
next; |
1669
|
|
|
|
|
|
|
} |
1670
|
|
|
|
|
|
|
|
1671
|
43
|
100
|
|
|
|
733
|
if(!defined $if) { |
1672
|
35
|
|
|
|
|
39
|
$if = $when; |
1673
|
35
|
|
|
|
|
63
|
$elsif = $when; |
1674
|
|
|
|
|
|
|
} |
1675
|
|
|
|
|
|
|
else { |
1676
|
8
|
|
|
|
|
25
|
$elsif->third([$when]); |
1677
|
8
|
|
|
|
|
17
|
$elsif = $when; |
1678
|
|
|
|
|
|
|
} |
1679
|
|
|
|
|
|
|
} |
1680
|
39
|
100
|
|
|
|
101
|
if(defined $else) { # default |
1681
|
36
|
100
|
|
|
|
81
|
if(defined $elsif) { |
1682
|
33
|
|
|
|
|
97
|
$elsif->third([$else]); |
1683
|
|
|
|
|
|
|
} |
1684
|
|
|
|
|
|
|
else { |
1685
|
3
|
|
|
|
|
8
|
$if = $else; # only default |
1686
|
|
|
|
|
|
|
} |
1687
|
|
|
|
|
|
|
} |
1688
|
39
|
100
|
|
|
|
138
|
$given->third(defined $if ? [$if] : undef); |
1689
|
39
|
|
|
|
|
133
|
return; |
1690
|
|
|
|
|
|
|
} |
1691
|
|
|
|
|
|
|
|
1692
|
|
|
|
|
|
|
sub std_include { |
1693
|
1253
|
|
|
1253
|
0
|
1917
|
my($parser, $symbol) = @_; |
1694
|
|
|
|
|
|
|
|
1695
|
1253
|
|
|
|
|
2727
|
my $arg = $parser->barename(); |
1696
|
1253
|
|
|
|
|
2865
|
my $vars = $parser->localize_vars(); |
1697
|
1253
|
|
|
|
|
3589
|
my $stmt = $symbol->clone( |
1698
|
|
|
|
|
|
|
first => $arg, |
1699
|
|
|
|
|
|
|
second => $vars, |
1700
|
|
|
|
|
|
|
arity => 'include', |
1701
|
|
|
|
|
|
|
); |
1702
|
1253
|
|
|
|
|
27609
|
return $parser->finish_statement($stmt); |
1703
|
|
|
|
|
|
|
} |
1704
|
|
|
|
|
|
|
|
1705
|
|
|
|
|
|
|
sub std_print { |
1706
|
11518
|
|
|
11518
|
0
|
21695
|
my($parser, $symbol) = @_; |
1707
|
11518
|
|
|
|
|
18756
|
my $args; |
1708
|
11518
|
50
|
|
|
|
54060
|
if($parser->token->id ne ";") { |
1709
|
11518
|
|
|
|
|
29691
|
$args = $parser->expression_list(); |
1710
|
|
|
|
|
|
|
} |
1711
|
11518
|
|
|
|
|
39173
|
my $stmt = $symbol->clone( |
1712
|
|
|
|
|
|
|
arity => 'print', |
1713
|
|
|
|
|
|
|
first => $args, |
1714
|
|
|
|
|
|
|
); |
1715
|
11518
|
|
|
|
|
288768
|
return $parser->finish_statement($stmt); |
1716
|
|
|
|
|
|
|
} |
1717
|
|
|
|
|
|
|
|
1718
|
|
|
|
|
|
|
# for cascade() and include() |
1719
|
|
|
|
|
|
|
sub barename { |
1720
|
1333
|
|
|
1333
|
0
|
1730
|
my($parser) = @_; |
1721
|
|
|
|
|
|
|
|
1722
|
1333
|
|
|
|
|
2852
|
my $t = $parser->token; |
1723
|
1333
|
100
|
100
|
|
|
5312
|
if($t->arity ne 'name' or $t->is_defined) { |
1724
|
|
|
|
|
|
|
# string literal for 'cascade', or any expression for 'include' |
1725
|
1264
|
|
|
|
|
2698
|
return $parser->expression(0); |
1726
|
|
|
|
|
|
|
} |
1727
|
|
|
|
|
|
|
|
1728
|
|
|
|
|
|
|
# path::to::name |
1729
|
69
|
|
|
|
|
96
|
my @parts; |
1730
|
69
|
|
|
|
|
147
|
push @parts, $t; |
1731
|
69
|
|
|
|
|
158
|
$parser->advance(); |
1732
|
|
|
|
|
|
|
|
1733
|
69
|
|
|
|
|
97
|
while(1) { |
1734
|
121
|
|
|
|
|
281
|
my $t = $parser->token; |
1735
|
|
|
|
|
|
|
|
1736
|
121
|
100
|
|
|
|
463
|
if($t->id eq "::") { |
1737
|
52
|
|
|
|
|
115
|
$t = $parser->advance(); # "::" |
1738
|
|
|
|
|
|
|
|
1739
|
52
|
50
|
|
|
|
210
|
if($t->arity ne "name") { |
1740
|
0
|
|
|
|
|
0
|
$parser->_unexpected("a name", $t); |
1741
|
|
|
|
|
|
|
} |
1742
|
|
|
|
|
|
|
|
1743
|
52
|
|
|
|
|
89
|
push @parts, $t; |
1744
|
52
|
|
|
|
|
113
|
$parser->advance(); |
1745
|
|
|
|
|
|
|
} |
1746
|
|
|
|
|
|
|
else { |
1747
|
69
|
|
|
|
|
136
|
last; |
1748
|
|
|
|
|
|
|
} |
1749
|
|
|
|
|
|
|
} |
1750
|
69
|
|
|
|
|
169
|
return \@parts; |
1751
|
|
|
|
|
|
|
} |
1752
|
|
|
|
|
|
|
|
1753
|
|
|
|
|
|
|
# NOTHING | { expression-list } |
1754
|
|
|
|
|
|
|
sub localize_vars { |
1755
|
1299
|
|
|
1299
|
0
|
1927
|
my($parser) = @_; |
1756
|
1299
|
100
|
|
|
|
4923
|
if($parser->token->id eq "{") { |
1757
|
13
|
|
|
|
|
28
|
$parser->advance(); |
1758
|
13
|
|
|
|
|
49
|
$parser->new_scope(); |
1759
|
13
|
|
|
|
|
43
|
my $vars = $parser->expression_list(); |
1760
|
13
|
|
|
|
|
40
|
$parser->pop_scope(); |
1761
|
13
|
|
|
|
|
27
|
$parser->advance("}"); |
1762
|
13
|
|
|
|
|
29
|
return $vars; |
1763
|
|
|
|
|
|
|
} |
1764
|
1286
|
|
|
|
|
2186
|
return undef; |
1765
|
|
|
|
|
|
|
} |
1766
|
|
|
|
|
|
|
|
1767
|
|
|
|
|
|
|
sub std_cascade { |
1768
|
64
|
|
|
64
|
0
|
110
|
my($parser, $symbol) = @_; |
1769
|
|
|
|
|
|
|
|
1770
|
64
|
|
|
|
|
99
|
my $base; |
1771
|
64
|
100
|
|
|
|
352
|
if($parser->token->id ne "with") { |
1772
|
57
|
|
|
|
|
216
|
$base = $parser->barename(); |
1773
|
|
|
|
|
|
|
} |
1774
|
|
|
|
|
|
|
|
1775
|
64
|
|
|
|
|
99
|
my $components; |
1776
|
64
|
100
|
|
|
|
328
|
if($parser->token->id eq "with") { |
1777
|
11
|
|
|
|
|
27
|
$parser->advance(); # "with" |
1778
|
|
|
|
|
|
|
|
1779
|
11
|
|
|
|
|
35
|
my @c = $parser->barename(); |
1780
|
11
|
|
|
|
|
65
|
while($parser->token->id eq ",") { |
1781
|
2
|
|
|
|
|
4
|
$parser->advance(); # "," |
1782
|
2
|
|
|
|
|
5
|
push @c, $parser->barename(); |
1783
|
|
|
|
|
|
|
} |
1784
|
11
|
|
|
|
|
26
|
$components = \@c; |
1785
|
|
|
|
|
|
|
} |
1786
|
|
|
|
|
|
|
|
1787
|
64
|
|
|
|
|
241
|
my $vars = $parser->localize_vars(); |
1788
|
64
|
|
|
|
|
243
|
my $stmt = $symbol->clone( |
1789
|
|
|
|
|
|
|
arity => 'cascade', |
1790
|
|
|
|
|
|
|
first => $base, |
1791
|
|
|
|
|
|
|
second => $components, |
1792
|
|
|
|
|
|
|
third => $vars, |
1793
|
|
|
|
|
|
|
); |
1794
|
64
|
|
|
|
|
1592
|
return $parser->finish_statement($stmt); |
1795
|
|
|
|
|
|
|
} |
1796
|
|
|
|
|
|
|
|
1797
|
|
|
|
|
|
|
sub std_super { |
1798
|
7
|
|
|
7
|
0
|
14
|
my($parser, $symbol) = @_; |
1799
|
7
|
|
|
|
|
23
|
my $stmt = $symbol->clone(arity => 'super'); |
1800
|
7
|
|
|
|
|
137
|
return $parser->finish_statement($stmt); |
1801
|
|
|
|
|
|
|
} |
1802
|
|
|
|
|
|
|
|
1803
|
|
|
|
|
|
|
sub std_next { |
1804
|
5
|
|
|
5
|
0
|
10
|
my($parser, $symbol) = @_; |
1805
|
5
|
|
|
|
|
16
|
my $stmt = $symbol->clone(arity => 'loop_control', id => 'next'); |
1806
|
5
|
|
|
|
|
116
|
return $parser->finish_statement($stmt); |
1807
|
|
|
|
|
|
|
} |
1808
|
|
|
|
|
|
|
|
1809
|
|
|
|
|
|
|
sub std_last { |
1810
|
7
|
|
|
7
|
0
|
13
|
my($parser, $symbol) = @_; |
1811
|
7
|
|
|
|
|
21
|
my $stmt = $symbol->clone(arity => 'loop_control', id => 'last'); |
1812
|
7
|
|
|
|
|
177
|
return $parser->finish_statement($stmt); |
1813
|
|
|
|
|
|
|
} |
1814
|
|
|
|
|
|
|
|
1815
|
|
|
|
|
|
|
# iterator elements |
1816
|
|
|
|
|
|
|
|
1817
|
|
|
|
|
|
|
sub bad_iterator_args { |
1818
|
8
|
|
|
8
|
0
|
14
|
my($parser, $iterator) = @_; |
1819
|
8
|
|
|
|
|
33
|
$parser->_error("Wrong number of arguments for $iterator." . $iterator->second); |
1820
|
|
|
|
|
|
|
} |
1821
|
|
|
|
|
|
|
|
1822
|
|
|
|
|
|
|
sub iterator_index { |
1823
|
16
|
|
|
16
|
0
|
157
|
my($parser, $iterator, @args) = @_; |
1824
|
16
|
100
|
|
|
|
66
|
$parser->bad_iterator_args($iterator) if @args != 0; |
1825
|
|
|
|
|
|
|
# $~iterator |
1826
|
15
|
|
|
|
|
52
|
return $iterator; |
1827
|
|
|
|
|
|
|
} |
1828
|
|
|
|
|
|
|
|
1829
|
|
|
|
|
|
|
sub iterator_count { |
1830
|
10
|
|
|
10
|
0
|
21
|
my($parser, $iterator, @args) = @_; |
1831
|
10
|
100
|
|
|
|
33
|
$parser->bad_iterator_args($iterator) if @args != 0; |
1832
|
|
|
|
|
|
|
# $~iterator + 1 |
1833
|
9
|
|
|
|
|
35
|
return $parser->binary('+', $iterator, 1); |
1834
|
|
|
|
|
|
|
} |
1835
|
|
|
|
|
|
|
|
1836
|
|
|
|
|
|
|
sub iterator_is_first { |
1837
|
7
|
|
|
7
|
0
|
18
|
my($parser, $iterator, @args) = @_; |
1838
|
7
|
100
|
|
|
|
26
|
$parser->bad_iterator_args($iterator) if @args != 0; |
1839
|
|
|
|
|
|
|
# $~iterator == 0 |
1840
|
6
|
|
|
|
|
22
|
return $parser->binary('==', $iterator, 0); |
1841
|
|
|
|
|
|
|
} |
1842
|
|
|
|
|
|
|
|
1843
|
|
|
|
|
|
|
sub iterator_is_last { |
1844
|
4
|
|
|
4
|
0
|
10
|
my($parser, $iterator, @args) = @_; |
1845
|
4
|
100
|
|
|
|
19
|
$parser->bad_iterator_args($iterator) if @args != 0; |
1846
|
|
|
|
|
|
|
# $~iterator == $~iterator.max_index |
1847
|
3
|
|
|
|
|
25
|
return $parser->binary('==', $iterator, $parser->iterator_max_index($iterator)); |
1848
|
|
|
|
|
|
|
} |
1849
|
|
|
|
|
|
|
|
1850
|
|
|
|
|
|
|
sub iterator_body { |
1851
|
16
|
|
|
16
|
0
|
30
|
my($parser, $iterator, @args) = @_; |
1852
|
16
|
50
|
|
|
|
57
|
$parser->bad_iterator_args($iterator) if @args != 0; |
1853
|
|
|
|
|
|
|
# $~iterator.body |
1854
|
16
|
|
|
|
|
49
|
return $iterator->clone( |
1855
|
|
|
|
|
|
|
arity => 'iterator_body', |
1856
|
|
|
|
|
|
|
); |
1857
|
|
|
|
|
|
|
} |
1858
|
|
|
|
|
|
|
|
1859
|
|
|
|
|
|
|
sub iterator_size { |
1860
|
3
|
|
|
3
|
0
|
77
|
my($parser, $iterator, @args) = @_; |
1861
|
3
|
100
|
|
|
|
17
|
$parser->bad_iterator_args($iterator) if @args != 0; |
1862
|
|
|
|
|
|
|
# $~iterator.max_index + 1 |
1863
|
2
|
|
|
|
|
9
|
return $parser->binary('+', $parser->iterator_max_index($iterator), 1); |
1864
|
|
|
|
|
|
|
} |
1865
|
|
|
|
|
|
|
|
1866
|
|
|
|
|
|
|
sub iterator_max_index { |
1867
|
8
|
|
|
8
|
0
|
18
|
my($parser, $iterator, @args) = @_; |
1868
|
8
|
100
|
|
|
|
37
|
$parser->bad_iterator_args($iterator) if @args != 0; |
1869
|
|
|
|
|
|
|
# __builtin_max_index($~iterator.body) |
1870
|
7
|
|
|
|
|
18
|
return $parser->symbol('max_index')->clone( |
1871
|
|
|
|
|
|
|
arity => 'unary', |
1872
|
|
|
|
|
|
|
first => $parser->iterator_body($iterator), |
1873
|
|
|
|
|
|
|
); |
1874
|
|
|
|
|
|
|
} |
1875
|
|
|
|
|
|
|
|
1876
|
|
|
|
|
|
|
sub _iterator_peek { |
1877
|
6
|
|
|
6
|
|
13
|
my($parser, $iterator, $pos) = @_; |
1878
|
|
|
|
|
|
|
# $~iterator.body[ $~iterator.index + $pos ] |
1879
|
6
|
|
|
|
|
19
|
return $parser->binary('[', |
1880
|
|
|
|
|
|
|
$parser->iterator_body($iterator), |
1881
|
|
|
|
|
|
|
$parser->binary('+', $parser->iterator_index($iterator), $pos), |
1882
|
|
|
|
|
|
|
); |
1883
|
|
|
|
|
|
|
} |
1884
|
|
|
|
|
|
|
|
1885
|
|
|
|
|
|
|
sub iterator_peek_next { |
1886
|
3
|
|
|
3
|
0
|
9
|
my($parser, $iterator, @args) = @_; |
1887
|
3
|
50
|
|
|
|
13
|
$parser->bad_iterator_args($iterator) if @args != 0; |
1888
|
3
|
|
|
|
|
24
|
return $parser->_iterator_peek($iterator, +1); |
1889
|
|
|
|
|
|
|
} |
1890
|
|
|
|
|
|
|
|
1891
|
|
|
|
|
|
|
sub iterator_peek_prev { |
1892
|
5
|
|
|
5
|
0
|
16
|
my($parser, $iterator, @args) = @_; |
1893
|
5
|
100
|
|
|
|
23
|
$parser->bad_iterator_args($iterator) if @args != 0; |
1894
|
|
|
|
|
|
|
# $~iterator.is_first ? nil : |
1895
|
3
|
|
|
|
|
11
|
return $parser->symbol('?')->clone( |
1896
|
|
|
|
|
|
|
arity => 'if', |
1897
|
|
|
|
|
|
|
first => $parser->iterator_is_first($iterator), |
1898
|
|
|
|
|
|
|
second => [$parser->nil], |
1899
|
|
|
|
|
|
|
third => [$parser->_iterator_peek($iterator, -1)], |
1900
|
|
|
|
|
|
|
); |
1901
|
|
|
|
|
|
|
} |
1902
|
|
|
|
|
|
|
|
1903
|
|
|
|
|
|
|
sub iterator_cycle { |
1904
|
6
|
|
|
6
|
0
|
14
|
my($parser, $iterator, @args) = @_; |
1905
|
6
|
50
|
|
|
|
19
|
$parser->bad_iterator_args($iterator) if @args < 2; |
1906
|
|
|
|
|
|
|
# $iterator.cycle("foo", "bar", "baz") makes: |
1907
|
|
|
|
|
|
|
# ($tmp = $~iterator % n) == 0 ? "foo" |
1908
|
|
|
|
|
|
|
# : $tmp == 1 ? "bar" |
1909
|
|
|
|
|
|
|
# : "baz" |
1910
|
6
|
|
|
|
|
15
|
$parser->new_scope(); |
1911
|
|
|
|
|
|
|
|
1912
|
6
|
|
|
|
|
18
|
my $mod = $parser->binary('%', $iterator, scalar @args); |
1913
|
|
|
|
|
|
|
|
1914
|
|
|
|
|
|
|
# for the second time |
1915
|
6
|
|
|
|
|
131
|
my $tmp = $parser->symbol('($cycle)')->clone(arity => 'name'); |
1916
|
|
|
|
|
|
|
|
1917
|
|
|
|
|
|
|
# for the first time |
1918
|
6
|
|
|
|
|
111
|
my $cond = $iterator->clone( |
1919
|
|
|
|
|
|
|
arity => 'constant', |
1920
|
|
|
|
|
|
|
first => $tmp, |
1921
|
|
|
|
|
|
|
second => $mod, |
1922
|
|
|
|
|
|
|
); |
1923
|
|
|
|
|
|
|
|
1924
|
6
|
|
|
|
|
126
|
my $parent = $iterator->clone( |
1925
|
|
|
|
|
|
|
arity => 'if', |
1926
|
|
|
|
|
|
|
first => $parser->binary('==', $cond, 0), |
1927
|
|
|
|
|
|
|
second => [ $args[0] ], |
1928
|
|
|
|
|
|
|
); |
1929
|
6
|
|
|
|
|
125
|
my $child = $parent; |
1930
|
|
|
|
|
|
|
|
1931
|
6
|
|
|
|
|
12
|
my $last = pop @args; |
1932
|
6
|
|
|
|
|
19
|
for(my $i = 1; $i < @args; $i++) { |
1933
|
4
|
|
|
|
|
20
|
my $nth = $iterator->clone( |
1934
|
|
|
|
|
|
|
arity => 'if', |
1935
|
|
|
|
|
|
|
id => "$iterator.cycle: $i", |
1936
|
|
|
|
|
|
|
first => $parser->binary('==', $tmp, $i), |
1937
|
|
|
|
|
|
|
second => [$args[$i]], |
1938
|
|
|
|
|
|
|
); |
1939
|
|
|
|
|
|
|
|
1940
|
4
|
|
|
|
|
99
|
$child->third([$nth]); |
1941
|
4
|
|
|
|
|
14
|
$child = $nth; |
1942
|
|
|
|
|
|
|
} |
1943
|
6
|
|
|
|
|
21
|
$child->third([$last]); |
1944
|
|
|
|
|
|
|
|
1945
|
6
|
|
|
|
|
18
|
$parser->pop_scope(); |
1946
|
6
|
|
|
|
|
20
|
return $parent; |
1947
|
|
|
|
|
|
|
} |
1948
|
|
|
|
|
|
|
|
1949
|
|
|
|
|
|
|
# utils |
1950
|
|
|
|
|
|
|
|
1951
|
|
|
|
|
|
|
sub make_alias { # alas(from => to) |
1952
|
3260
|
|
|
3260
|
0
|
10917
|
my($parser, $from, $to) = @_; |
1953
|
|
|
|
|
|
|
|
1954
|
3260
|
|
|
|
|
12575
|
my $stash = $parser->symbol_table; |
1955
|
3260
|
50
|
|
|
|
15353
|
if(exists $parser->symbol_table->{$to}) { |
1956
|
|
|
|
|
|
|
Carp::confess( |
1957
|
|
|
|
|
|
|
"Cannot make an alias to an existing symbol ($from => $to / " |
1958
|
0
|
|
|
|
|
0
|
. p($parser->symbol_table->{$to}) .")"); |
1959
|
|
|
|
|
|
|
} |
1960
|
|
|
|
|
|
|
|
1961
|
|
|
|
|
|
|
# make a snapshot |
1962
|
3260
|
|
|
|
|
11602
|
return $stash->{$to} = $parser->symbol($from)->clone( |
1963
|
|
|
|
|
|
|
value => $to, # real id |
1964
|
|
|
|
|
|
|
); |
1965
|
|
|
|
|
|
|
} |
1966
|
|
|
|
|
|
|
|
1967
|
|
|
|
|
|
|
sub not_supported { |
1968
|
2
|
|
|
2
|
0
|
4
|
my($parser, $symbol) = @_; |
1969
|
2
|
|
|
|
|
52
|
$parser->_error("'$symbol' is not supported"); |
1970
|
|
|
|
|
|
|
} |
1971
|
|
|
|
|
|
|
|
1972
|
|
|
|
|
|
|
sub _unexpected { |
1973
|
13
|
|
|
13
|
|
26
|
my($parser, $expected, $got) = @_; |
1974
|
13
|
100
|
66
|
|
|
160
|
if(defined($got) && $got ne ";") { |
1975
|
12
|
100
|
|
|
|
57
|
if($got eq '(end)') { |
1976
|
2
|
|
|
|
|
14
|
$parser->_error("Expected $expected, but reached EOF"); |
1977
|
|
|
|
|
|
|
} |
1978
|
|
|
|
|
|
|
else { |
1979
|
10
|
|
|
|
|
36
|
$parser->_error("Expected $expected, but got " . neat("$got")); |
1980
|
|
|
|
|
|
|
} |
1981
|
|
|
|
|
|
|
} |
1982
|
|
|
|
|
|
|
else { |
1983
|
1
|
|
|
|
|
5
|
$parser->_error("Expected $expected"); |
1984
|
|
|
|
|
|
|
} |
1985
|
|
|
|
|
|
|
} |
1986
|
|
|
|
|
|
|
|
1987
|
|
|
|
|
|
|
sub _error { |
1988
|
49
|
|
|
49
|
|
98
|
my($parser, $message, $near, $line) = @_; |
1989
|
|
|
|
|
|
|
|
1990
|
49
|
|
100
|
|
|
393
|
$near ||= $parser->near_token || ";"; |
|
|
|
66
|
|
|
|
|
1991
|
49
|
100
|
100
|
|
|
255
|
if($near ne ";" && $message !~ /\b \Q$near\E \b/xms) { |
1992
|
39
|
|
|
|
|
118
|
$message .= ", near $near"; |
1993
|
|
|
|
|
|
|
} |
1994
|
49
|
|
66
|
|
|
480
|
die $parser->make_error($message . ", while parsing templates", |
1995
|
|
|
|
|
|
|
$parser->file, $line || $parser->line); |
1996
|
|
|
|
|
|
|
} |
1997
|
|
|
|
|
|
|
|
1998
|
172
|
|
|
172
|
|
1833
|
no Mouse; |
|
172
|
|
|
|
|
410
|
|
|
172
|
|
|
|
|
1466
|
|
1999
|
|
|
|
|
|
|
__PACKAGE__->meta->make_immutable; |
2000
|
|
|
|
|
|
|
__END__ |