line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package JE::Parser; |
2
|
|
|
|
|
|
|
|
3
|
|
|
|
|
|
|
our $VERSION = '0.064'; |
4
|
|
|
|
|
|
|
|
5
|
101
|
|
|
101
|
|
39994
|
use strict; # :-( |
|
101
|
|
|
|
|
132
|
|
|
101
|
|
|
|
|
3260
|
|
6
|
101
|
|
|
101
|
|
429
|
use warnings;# :-( |
|
101
|
|
|
|
|
119
|
|
|
101
|
|
|
|
|
2405
|
|
7
|
101
|
|
|
101
|
|
407
|
no warnings 'utf8'; |
|
101
|
|
|
|
|
707
|
|
|
101
|
|
|
|
|
2697
|
|
8
|
|
|
|
|
|
|
|
9
|
101
|
|
|
101
|
|
406
|
use Scalar::Util 'blessed'; |
|
101
|
|
|
|
|
171
|
|
|
101
|
|
|
|
|
47671
|
|
10
|
|
|
|
|
|
|
|
11
|
|
|
|
|
|
|
require JE::Code ; |
12
|
|
|
|
|
|
|
require JE::Number; # ~~~ Don't want to do this |
13
|
|
|
|
|
|
|
|
14
|
|
|
|
|
|
|
import JE::Code 'add_line_number'; |
15
|
|
|
|
|
|
|
sub add_line_number; |
16
|
|
|
|
|
|
|
|
17
|
|
|
|
|
|
|
our ($_parser, $global, @_decls, @_stms, $_vars); |
18
|
|
|
|
|
|
|
|
19
|
|
|
|
|
|
|
#----------METHODS---------# |
20
|
|
|
|
|
|
|
|
21
|
|
|
|
|
|
|
sub new { |
22
|
2
|
|
|
2
|
1
|
738
|
my %self = ( |
23
|
|
|
|
|
|
|
stm_names => [qw[ |
24
|
|
|
|
|
|
|
-function block empty if while with for switch try |
25
|
|
|
|
|
|
|
labelled var do continue break return throw expr |
26
|
|
|
|
|
|
|
]], |
27
|
|
|
|
|
|
|
stm => { |
28
|
|
|
|
|
|
|
-function => \&function, block => \&block, |
29
|
|
|
|
|
|
|
empty => \&empty, if => \&if, |
30
|
|
|
|
|
|
|
while => \&while, with => \&with, |
31
|
|
|
|
|
|
|
for => \&for, switch => \&switch, |
32
|
|
|
|
|
|
|
try => \&try, labelled => \&labelled, |
33
|
|
|
|
|
|
|
var => \&var, do => \&do, |
34
|
|
|
|
|
|
|
continue => \&continue, break => \&break, |
35
|
|
|
|
|
|
|
return => \&return, throw => \&throw, |
36
|
|
|
|
|
|
|
expr => \&expr_statement, |
37
|
|
|
|
|
|
|
}, |
38
|
|
|
|
|
|
|
global => pop, |
39
|
|
|
|
|
|
|
); |
40
|
2
|
|
|
|
|
12
|
return bless \%self, shift; |
41
|
|
|
|
|
|
|
} |
42
|
|
|
|
|
|
|
|
43
|
|
|
|
|
|
|
sub add_statement { |
44
|
0
|
|
|
0
|
1
|
0
|
my($self,$name,$parser) = shift; |
45
|
0
|
|
|
|
|
0
|
my $in_list; |
46
|
|
|
|
|
|
|
# no warnings 'exiting'; |
47
|
0
|
|
|
|
|
0
|
grep $_ eq $name && ++$in_list && goto END_GREP, |
48
|
0
|
|
0
|
|
|
0
|
@{$$self{stm_names}}; |
49
|
0
|
|
|
|
|
0
|
END_GREP: |
50
|
0
|
0
|
|
|
|
0
|
$in_list or unshift @{$$self{stm_names}} ,$name; |
51
|
0
|
|
|
|
|
0
|
$$self{stm}{$name} = $parser; |
52
|
0
|
|
|
|
|
0
|
return; # Don't return anything for now, because if we return some- |
53
|
|
|
|
|
|
|
# thing, even if it's not documented, someone might start |
54
|
|
|
|
|
|
|
# relying on it. |
55
|
|
|
|
|
|
|
} |
56
|
|
|
|
|
|
|
|
57
|
|
|
|
|
|
|
sub delete_statement { |
58
|
1
|
|
|
1
|
1
|
389
|
my $self = shift; |
59
|
1
|
|
|
|
|
3
|
for my $name (@_) { |
60
|
4
|
|
|
|
|
11
|
delete $$self{stm}{$name}; |
61
|
4
|
|
|
|
|
15
|
@{$$self{stm_names}} = |
|
4
|
|
|
|
|
13
|
|
62
|
4
|
|
|
|
|
4
|
grep $_ ne $name, @{$$self{stm_names}}; |
63
|
|
|
|
|
|
|
} |
64
|
1
|
|
|
|
|
3
|
return $self; |
65
|
|
|
|
|
|
|
} |
66
|
|
|
|
|
|
|
|
67
|
|
|
|
|
|
|
sub statement_list { |
68
|
2
|
|
|
2
|
1
|
18
|
$_[0]{stm_names}; |
69
|
|
|
|
|
|
|
} |
70
|
|
|
|
|
|
|
|
71
|
|
|
|
|
|
|
sub parse { |
72
|
11
|
|
|
11
|
1
|
18
|
local $_parser = shift; |
73
|
11
|
|
|
|
|
17
|
local(@_decls, @_stms); # Doing this here and localising it saves |
74
|
11
|
|
|
|
|
10
|
for(@{$_parser->{stm_names}}) { # us from having to do it multiple |
|
11
|
|
|
|
|
25
|
|
75
|
143
|
50
|
|
|
|
100
|
push @{/^-/ ? \@_decls : \@_stms}, # times. |
|
143
|
|
|
|
|
323
|
|
76
|
|
|
|
|
|
|
$_parser->{stm}{$_}; |
77
|
|
|
|
|
|
|
} |
78
|
|
|
|
|
|
|
|
79
|
11
|
|
|
|
|
37
|
JE::Code::parse($_parser->{global}, @_); |
80
|
|
|
|
|
|
|
} |
81
|
|
|
|
|
|
|
|
82
|
|
|
|
|
|
|
sub eval { |
83
|
4
|
|
|
4
|
1
|
15
|
shift->parse(@_)->execute |
84
|
|
|
|
|
|
|
} |
85
|
|
|
|
|
|
|
|
86
|
|
|
|
|
|
|
#----------PARSER---------# |
87
|
|
|
|
|
|
|
|
88
|
101
|
|
|
101
|
|
556
|
use Exporter 5.57 'import'; |
|
101
|
|
|
|
|
2477
|
|
|
101
|
|
|
|
|
7446
|
|
89
|
|
|
|
|
|
|
|
90
|
|
|
|
|
|
|
our @EXPORT_OK = qw/ $h $n $optional_sc $ss $s $S $id_cont |
91
|
|
|
|
|
|
|
str num skip ident expr expr_noin statement |
92
|
|
|
|
|
|
|
statements expected optional_sc/; |
93
|
|
|
|
|
|
|
our @EXPORT_TAGS = ( |
94
|
|
|
|
|
|
|
vars => [qw/ $h $n $optional_sc $ss $s $S $id_cont/], |
95
|
|
|
|
|
|
|
functions => [qw/ str num skip ident expr expr_noin statement |
96
|
|
|
|
|
|
|
statements expected optional_sc /], |
97
|
|
|
|
|
|
|
); |
98
|
|
|
|
|
|
|
|
99
|
101
|
|
|
101
|
|
511
|
use re 'taint'; |
|
101
|
|
|
|
|
126
|
|
|
101
|
|
|
|
|
3952
|
|
100
|
|
|
|
|
|
|
#use subs qw'statement statements assign assign_noin expr new'; |
101
|
101
|
|
|
101
|
|
426
|
use constant JECE => 'JE::Code::Expression'; |
|
101
|
|
|
|
|
119
|
|
|
101
|
|
|
|
|
5513
|
|
102
|
101
|
|
|
101
|
|
459
|
use constant JECS => 'JE::Code::Statement'; |
|
101
|
|
|
|
|
138
|
|
|
101
|
|
|
|
|
12308
|
|
103
|
|
|
|
|
|
|
|
104
|
|
|
|
|
|
|
require JE::String; |
105
|
|
|
|
|
|
|
import JE::String 'desurrogify'; |
106
|
|
|
|
|
|
|
import JE::String 'surrogify'; |
107
|
|
|
|
|
|
|
sub desurrogify($); |
108
|
|
|
|
|
|
|
sub surrogify($); |
109
|
|
|
|
|
|
|
|
110
|
|
|
|
|
|
|
|
111
|
|
|
|
|
|
|
# die is called with a scalar ref when the string contains what is |
112
|
|
|
|
|
|
|
# expected. This will be converted to a longer message afterwards, which |
113
|
|
|
|
|
|
|
# will read something like "Expected %s but found %s" (probably the most |
114
|
|
|
|
|
|
|
# common error message, which is why there is a shorthand). Using an array |
115
|
|
|
|
|
|
|
# ref is the easiest way to stop the 'at ..., line ...' from being appended |
116
|
|
|
|
|
|
|
# when there is no line break at the end already. die is called with a |
117
|
|
|
|
|
|
|
# double reference to a string if the string is the complete error |
118
|
|
|
|
|
|
|
# message. |
119
|
|
|
|
|
|
|
# ~~~ We may need a function for this second usage, in case we change the |
120
|
|
|
|
|
|
|
# \\ yet again. |
121
|
|
|
|
|
|
|
|
122
|
|
|
|
|
|
|
# @ret != push @ret, ... is a funny way of pushing and then checking to |
123
|
|
|
|
|
|
|
# see whether anything was pushed. |
124
|
|
|
|
|
|
|
|
125
|
|
|
|
|
|
|
|
126
|
|
|
|
|
|
|
sub expected($) { # public |
127
|
21
|
|
|
21
|
0
|
163
|
die \shift |
128
|
|
|
|
|
|
|
} |
129
|
|
|
|
|
|
|
|
130
|
|
|
|
|
|
|
|
131
|
|
|
|
|
|
|
# public vars: |
132
|
|
|
|
|
|
|
|
133
|
|
|
|
|
|
|
# optional horizontal comments and whitespace |
134
|
|
|
|
|
|
|
our $h = qr( |
135
|
|
|
|
|
|
|
(?> [ \t\x0b\f\xa0\p{Zs}]* ) |
136
|
|
|
|
|
|
|
(?> (?>/\*[^\cm\cj\x{2028}\x{2029}]*?\*/) [ \t\x0b\f\xa0\p{Zs}]* )? |
137
|
1
|
|
|
1
|
|
606
|
)x; |
|
1
|
|
|
|
|
8
|
|
|
1
|
|
|
|
|
12
|
|
138
|
|
|
|
|
|
|
|
139
|
|
|
|
|
|
|
# line terminators |
140
|
|
|
|
|
|
|
our $n = qr((?>[\cm\cj\x{2028}\x{2029}])); |
141
|
|
|
|
|
|
|
|
142
|
|
|
|
|
|
|
# single space char |
143
|
|
|
|
|
|
|
our $ss = qr((?>[\p{Zs}\s\ck\x{2028}\x{2029}])); |
144
|
|
|
|
|
|
|
|
145
|
|
|
|
|
|
|
# optional comments and whitespace |
146
|
|
|
|
|
|
|
our $s = qr((?> |
147
|
|
|
|
|
|
|
(?> $ss* ) |
148
|
|
|
|
|
|
|
(?> (?> //[^\cm\cj\x{2028}\x{2029}]* (?>$n|\z) | /\*.*?\*/ ) |
149
|
|
|
|
|
|
|
(?> $ss* ) |
150
|
|
|
|
|
|
|
) * |
151
|
|
|
|
|
|
|
))sx; |
152
|
|
|
|
|
|
|
|
153
|
|
|
|
|
|
|
# mandatory comments/whitespace |
154
|
|
|
|
|
|
|
our $S = qr( |
155
|
|
|
|
|
|
|
(?> |
156
|
|
|
|
|
|
|
$ss |
157
|
|
|
|
|
|
|
| |
158
|
|
|
|
|
|
|
//[^\cm\cj\x{2028}\x{2029}]* |
159
|
|
|
|
|
|
|
| |
160
|
|
|
|
|
|
|
/\*.*?\*/ |
161
|
|
|
|
|
|
|
) |
162
|
|
|
|
|
|
|
$s |
163
|
|
|
|
|
|
|
)xs; |
164
|
|
|
|
|
|
|
|
165
|
|
|
|
|
|
|
our $id_cont = qr( |
166
|
|
|
|
|
|
|
(?> |
167
|
|
|
|
|
|
|
\\u([0-9A-Fa-f]{4}) |
168
|
|
|
|
|
|
|
| |
169
|
|
|
|
|
|
|
[\p{ID_Continue}\$_] |
170
|
|
|
|
|
|
|
) |
171
|
|
|
|
|
|
|
)x; |
172
|
|
|
|
|
|
|
|
173
|
|
|
|
|
|
|
# end public vars |
174
|
|
|
|
|
|
|
|
175
|
|
|
|
|
|
|
|
176
|
|
|
|
|
|
|
sub str() { # public |
177
|
|
|
|
|
|
|
# For very long strings (>~45000), this pattern hits a perl bug (Complex regular subexpression recursion limit (32766) exceeded) |
178
|
|
|
|
|
|
|
#/\G (?: '((?>(?:[^'\\] | \\.)*))' |
179
|
|
|
|
|
|
|
# | |
180
|
|
|
|
|
|
|
# "((?>(?:[^"\\] | \\.)*))" )/xcgs or return; |
181
|
|
|
|
|
|
|
# There are two solutions: |
182
|
|
|
|
|
|
|
# 1) Use the unrolling technique from the Owl Book. |
183
|
|
|
|
|
|
|
# 2) Use shorter patterns but more code (contributed by Kevin |
184
|
|
|
|
|
|
|
# Cameron) |
185
|
|
|
|
|
|
|
# Number 1 should be faster, but it crashes under perl 5.8.8 on |
186
|
|
|
|
|
|
|
# Windows, and perhaps on other platforms, too. So we use #2 for |
187
|
|
|
|
|
|
|
# 5.8.x regardless of platform to be on the safe side. |
188
|
|
|
|
|
|
|
|
189
|
101
|
|
|
101
|
|
197020
|
use constant old_perl => $] < 5.01; # Use a constant so the |
|
101
|
|
|
|
|
162
|
|
|
101
|
|
|
|
|
26594
|
|
190
|
42065
|
|
|
42065
|
0
|
75766
|
my $yarn; # if-block disappears |
191
|
42065
|
|
|
|
|
33558
|
if(old_perl) { # at compile-time. |
192
|
|
|
|
|
|
|
# Use a simpler pattern (but more code) to break strings up |
193
|
|
|
|
|
|
|
# into extents bounded by the quote or escape |
194
|
|
|
|
|
|
|
my $qt = substr($_,pos($_),1); |
195
|
|
|
|
|
|
|
$qt =~ /['"]/ or return; # not a string literal if first |
196
|
|
|
|
|
|
|
pos($_)++; # char not a quote |
197
|
|
|
|
|
|
|
my $done = 0; |
198
|
|
|
|
|
|
|
while (defined(substr($_,pos($_),1))) { |
199
|
|
|
|
|
|
|
my ($part) = /\G([^\\$qt]*)/xcgs; |
200
|
|
|
|
|
|
|
defined($part) or $part = ""; |
201
|
|
|
|
|
|
|
$yarn .= $part; |
202
|
|
|
|
|
|
|
my $next = substr($_,pos($_)++,1); |
203
|
|
|
|
|
|
|
|
204
|
|
|
|
|
|
|
if ($next eq "\\") { |
205
|
|
|
|
|
|
|
#pass on any escaped char |
206
|
|
|
|
|
|
|
$next = substr($_,pos($_)++,1); |
207
|
|
|
|
|
|
|
$yarn .= "\\$next"; |
208
|
|
|
|
|
|
|
} else { |
209
|
|
|
|
|
|
|
# handle end quote |
210
|
|
|
|
|
|
|
$done = 1; |
211
|
|
|
|
|
|
|
last; |
212
|
|
|
|
|
|
|
} |
213
|
|
|
|
|
|
|
} |
214
|
|
|
|
|
|
|
|
215
|
|
|
|
|
|
|
# error if EOF before end of string |
216
|
|
|
|
|
|
|
return if !$done; |
217
|
|
|
|
|
|
|
} |
218
|
|
|
|
|
|
|
else { |
219
|
42065
|
100
|
|
|
|
172220
|
/\G (?: '([^'\\]*(?:\\.[^'\\]*)*)' |
220
|
|
|
|
|
|
|
| |
221
|
|
|
|
|
|
|
"([^"\\]*(?:\\.[^"\\]*)*)" )/xcgs or return; |
222
|
9820
|
|
|
|
|
21336
|
$yarn = $+; |
223
|
|
|
|
|
|
|
} |
224
|
|
|
|
|
|
|
# Get rid of that constant, as it’s no longer needed. |
225
|
101
|
|
|
101
|
|
530
|
BEGIN { no strict; delete ${__PACKAGE__.'::'}{old_perl}; } |
|
101
|
|
|
101
|
|
159
|
|
|
101
|
|
|
|
|
3756
|
|
|
101
|
|
|
|
|
146
|
|
|
101
|
|
|
|
|
2009
|
|
226
|
|
|
|
|
|
|
|
227
|
|
|
|
|
|
|
# transform special chars |
228
|
101
|
|
|
101
|
|
450
|
no re 'taint'; # I need eval "qq-..." to work |
|
101
|
|
|
|
|
155
|
|
|
101
|
|
|
|
|
37104
|
|
229
|
9820
|
|
|
|
|
16959
|
$yarn =~ s/\\(?: |
230
|
|
|
|
|
|
|
u([0-9a-fA-F]{4}) |
231
|
|
|
|
|
|
|
| |
232
|
|
|
|
|
|
|
x([0-9a-fA-F]{2}) |
233
|
|
|
|
|
|
|
| |
234
|
|
|
|
|
|
|
(\r\n?|[\n\x{2028}\x{2029}]) |
235
|
|
|
|
|
|
|
| |
236
|
|
|
|
|
|
|
([bfnrt]) |
237
|
|
|
|
|
|
|
| |
238
|
|
|
|
|
|
|
(v) |
239
|
|
|
|
|
|
|
| |
240
|
|
|
|
|
|
|
([0-3][0-7]{0,2}|[4-7][0-7]?) # actually slightly looser |
241
|
|
|
|
|
|
|
| # than what ECMAScript v3 has in its |
242
|
|
|
|
|
|
|
(.) # addendum (it forbids \0 when followed by 8) |
243
|
|
|
|
|
|
|
)/ |
244
|
21990
|
100
|
|
|
|
114451
|
$1 ? chr(hex $1) : |
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
245
|
|
|
|
|
|
|
$2 ? chr(hex $2) : |
246
|
|
|
|
|
|
|
$3 ? "" : # escaped line feed disappears |
247
|
|
|
|
|
|
|
$4 ? eval "qq-\\$4-" : |
248
|
|
|
|
|
|
|
$5 ? "\cK" : |
249
|
|
|
|
|
|
|
defined $6 ? chr oct $6 : |
250
|
|
|
|
|
|
|
$7 |
251
|
|
|
|
|
|
|
/sgex; |
252
|
9820
|
|
|
|
|
38390
|
"s$yarn"; |
253
|
|
|
|
|
|
|
} |
254
|
|
|
|
|
|
|
|
255
|
|
|
|
|
|
|
sub num() { # public |
256
|
32245
|
100
|
|
32245
|
0
|
301150
|
/\G (?: |
257
|
|
|
|
|
|
|
0[Xx] ([A-Fa-f0-9]+) |
258
|
|
|
|
|
|
|
| |
259
|
|
|
|
|
|
|
0 ([01234567]+) |
260
|
|
|
|
|
|
|
| |
261
|
|
|
|
|
|
|
(?=[0-9]|\.[0-9]) |
262
|
|
|
|
|
|
|
( |
263
|
|
|
|
|
|
|
(?:0|[1-9][0-9]*)? |
264
|
|
|
|
|
|
|
(?:\.[0-9]*)? |
265
|
|
|
|
|
|
|
(?:[Ee][+-]?[0-9]+)? |
266
|
|
|
|
|
|
|
) |
267
|
|
|
|
|
|
|
) /xcg |
268
|
|
|
|
|
|
|
or return; |
269
|
21596
|
100
|
|
|
|
107170
|
return defined $1 ? hex $1 : defined $2 ? oct $2 : $3; |
|
|
100
|
|
|
|
|
|
270
|
|
|
|
|
|
|
} |
271
|
|
|
|
|
|
|
|
272
|
|
|
|
|
|
|
our $ident = qr( |
273
|
|
|
|
|
|
|
(?! (?: case | default ) (?!$id_cont) ) |
274
|
|
|
|
|
|
|
(?: |
275
|
|
|
|
|
|
|
\\u[0-9A-Fa-f]{4} |
276
|
|
|
|
|
|
|
| |
277
|
|
|
|
|
|
|
[\p{ID_Start}\$_] |
278
|
|
|
|
|
|
|
) |
279
|
|
|
|
|
|
|
(?> $id_cont* ) |
280
|
|
|
|
|
|
|
)x; |
281
|
|
|
|
|
|
|
|
282
|
|
|
|
|
|
|
sub unescape_ident($) { |
283
|
23681
|
|
|
23681
|
0
|
27824
|
my $ident = shift; |
284
|
23681
|
|
|
|
|
28080
|
$ident =~ s/\\u([0-9a-fA-F]{4})/chr hex $1/ge; |
|
18
|
|
|
|
|
71
|
|
285
|
23681
|
|
|
|
|
52662
|
$ident = desurrogify $ident; |
286
|
23681
|
100
|
|
|
|
73638
|
$ident =~ /^[\p{ID_Start}\$_] |
287
|
|
|
|
|
|
|
[\p{ID_Continue}\$_]* |
288
|
|
|
|
|
|
|
\z/x |
289
|
|
|
|
|
|
|
or die \\"'$ident' is not a valid identifier"; |
290
|
23680
|
|
|
|
|
100111
|
$ident; |
291
|
|
|
|
|
|
|
} |
292
|
|
|
|
|
|
|
|
293
|
|
|
|
|
|
|
# public |
294
|
34794
|
|
|
34794
|
0
|
126578
|
sub skip() { /\G$s/g } # skip whitespace |
295
|
|
|
|
|
|
|
|
296
|
|
|
|
|
|
|
sub ident() { # public |
297
|
6479
|
100
|
|
6479
|
0
|
36617
|
return unless my($ident) = /\G($ident)/cgox; |
298
|
5549
|
|
|
|
|
65874
|
unescape_ident $ident; |
299
|
|
|
|
|
|
|
} |
300
|
|
|
|
|
|
|
|
301
|
|
|
|
|
|
|
sub params() { # Only called when we know we need it, which is why it dies |
302
|
|
|
|
|
|
|
# on the second line |
303
|
364
|
|
|
364
|
0
|
400
|
my @ret; |
304
|
364
|
50
|
|
|
|
1251
|
/\G\(/gc or expected "'('"; |
305
|
364
|
|
|
|
|
567
|
&skip; |
306
|
364
|
100
|
|
|
|
1574
|
if (@ret != push @ret, &ident) { # first identifier (not prec. |
307
|
|
|
|
|
|
|
# by comma) |
308
|
111
|
|
|
|
|
1294
|
while (/\G$s,$s/gc) { |
309
|
|
|
|
|
|
|
# if there's a comma we need another ident |
310
|
100
|
100
|
|
|
|
7136
|
@ret != push @ret, &ident or expected 'identifier'; |
311
|
|
|
|
|
|
|
} |
312
|
109
|
|
|
|
|
2608
|
&skip; |
313
|
|
|
|
|
|
|
} |
314
|
362
|
100
|
|
|
|
1299
|
/\G\)/gc or expected "')'"; |
315
|
360
|
|
|
|
|
791
|
\@ret; |
316
|
|
|
|
|
|
|
} |
317
|
|
|
|
|
|
|
|
318
|
|
|
|
|
|
|
sub term() { |
319
|
61737
|
|
|
61737
|
0
|
88167
|
my $pos = pos; |
320
|
61737
|
|
|
|
|
47102
|
my $tmp; |
321
|
61737
|
100
|
100
|
|
|
365162
|
if(/\Gfunction(?!$id_cont)$s/cg) { |
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
322
|
163
|
|
|
|
|
378
|
my @ret = (func => ident); |
323
|
163
|
100
|
|
|
|
3593
|
@ret == 2 and &skip; |
324
|
163
|
|
|
|
|
308
|
push @ret, ¶ms; |
325
|
163
|
|
|
|
|
298
|
&skip; |
326
|
163
|
50
|
|
|
|
496
|
/\G \{ /gcx or expected "'{'"; |
327
|
|
|
|
|
|
|
{ |
328
|
163
|
|
|
|
|
217
|
local $_vars = []; |
|
163
|
|
|
|
|
298
|
|
329
|
163
|
|
|
|
|
311
|
push @ret, &statements, $_vars; |
330
|
|
|
|
|
|
|
} |
331
|
163
|
50
|
|
|
|
677
|
/\G \} /gocx or expected "'}'"; |
332
|
|
|
|
|
|
|
|
333
|
163
|
|
|
|
|
1022
|
return bless [[$pos, pos], @ret], JECE; |
334
|
|
|
|
|
|
|
} |
335
|
|
|
|
|
|
|
# We don’t call the ident subroutine here, |
336
|
|
|
|
|
|
|
# because we need to sift out null/true/false/this. |
337
|
|
|
|
|
|
|
elsif(($tmp)=/\G($ident)/cgox) { |
338
|
20028
|
100
|
|
|
|
108698
|
$tmp=~/^(?:(?:tru|fals)e|null)\z/ &&return $global->$tmp; |
339
|
18259
|
100
|
|
|
|
32906
|
$tmp eq 'this' and return $tmp; |
340
|
18043
|
|
|
|
|
27198
|
return "i" . unescape_ident $tmp; |
341
|
|
|
|
|
|
|
} |
342
|
|
|
|
|
|
|
elsif(defined($tmp = &str) or |
343
|
|
|
|
|
|
|
defined($tmp = &num)) { |
344
|
31325
|
|
|
|
|
118038
|
return $tmp; |
345
|
|
|
|
|
|
|
} |
346
|
|
|
|
|
|
|
elsif(m-\G |
347
|
|
|
|
|
|
|
/ |
348
|
|
|
|
|
|
|
( (?:[^/*\\[] | \\. | \[ (?>(?:[^]\\] | \\.)*) \] ) |
349
|
|
|
|
|
|
|
(?>(?:[^/\\[] | \\. | \[ (?>(?:[^]\\] | \\.)*) \] )*) ) |
350
|
|
|
|
|
|
|
/ |
351
|
|
|
|
|
|
|
($id_cont*) |
352
|
|
|
|
|
|
|
-cogx ) { |
353
|
|
|
|
|
|
|
|
354
|
|
|
|
|
|
|
# I have to use local *_ because |
355
|
|
|
|
|
|
|
# 'require JE::Object::RegExp' causes |
356
|
|
|
|
|
|
|
# Scalar::Util->import() to be called (import is inherited |
357
|
|
|
|
|
|
|
# from Exporter), and &Exporter::import does 'local $_', |
358
|
|
|
|
|
|
|
# which, in p5.8.8 (though not 5.9.5) causes pos() |
359
|
|
|
|
|
|
|
# to be reset. |
360
|
317
|
|
|
|
|
401
|
{ local *_; require JE::Object::RegExp; } |
|
317
|
|
|
|
|
782
|
|
|
317
|
|
|
|
|
2968
|
|
361
|
|
|
|
|
|
|
# ~~~ This needs to unescape the flags. |
362
|
317
|
|
|
|
|
1360
|
return JE::Object::RegExp->new( $global, $1, $2); |
363
|
|
|
|
|
|
|
} |
364
|
|
|
|
|
|
|
elsif(/\G\[$s/cg) { |
365
|
5291
|
|
|
|
|
4984
|
my $anon; |
366
|
|
|
|
|
|
|
my @ret; |
367
|
0
|
|
|
|
|
0
|
my $length; |
368
|
|
|
|
|
|
|
|
369
|
5291
|
|
|
|
|
3796
|
while () { |
370
|
20890
|
100
|
|
|
|
27909
|
@ret != ($length = push @ret, &assign) and &skip; |
371
|
20890
|
|
|
|
|
136347
|
push @ret, bless \$anon, 'comma' while /\G,$s/cg; |
372
|
20890
|
100
|
|
|
|
42231
|
$length == @ret and last; |
373
|
|
|
|
|
|
|
} |
374
|
|
|
|
|
|
|
|
375
|
5291
|
100
|
|
|
|
12037
|
/\G]/cg or expected "']'"; |
376
|
5287
|
|
|
|
|
37794
|
return bless [[$pos, pos], array => @ret], JECE; |
377
|
|
|
|
|
|
|
} |
378
|
|
|
|
|
|
|
elsif(/\G\{$s/cg) { |
379
|
552
|
|
|
|
|
5047
|
my @ret; |
380
|
|
|
|
|
|
|
|
381
|
552
|
100
|
66
|
|
|
863
|
if($tmp = &ident or defined($tmp = &str)&&$tmp=~s/^s// or |
|
|
|
66
|
|
|
|
|
|
|
|
100
|
|
|
|
|
382
|
|
|
|
|
|
|
defined($tmp = &num)) { |
383
|
|
|
|
|
|
|
# first elem, not preceded by comma |
384
|
125
|
|
|
|
|
195
|
push @ret, $tmp; |
385
|
125
|
|
|
|
|
190
|
&skip; |
386
|
125
|
50
|
|
|
|
1141
|
/\G:$s/cggg or expected 'colon'; |
387
|
125
|
50
|
|
|
|
2974
|
@ret != push @ret, &assign |
388
|
|
|
|
|
|
|
or expected \'expression'; |
389
|
125
|
|
|
|
|
209
|
&skip; |
390
|
|
|
|
|
|
|
|
391
|
125
|
|
|
|
|
751
|
while (/\G,$s/cg) { |
392
|
|
|
|
|
|
|
$tmp = ident |
393
|
|
|
|
|
|
|
or defined($tmp = &str)&&$tmp=~s/^s// or |
394
|
|
|
|
|
|
|
defined($tmp = &num) |
395
|
101
|
100
|
66
|
|
|
1430
|
or do { |
|
|
|
66
|
|
|
|
|
|
|
|
100
|
|
|
|
|
396
|
|
|
|
|
|
|
# ECMAScript 5 allows a |
397
|
|
|
|
|
|
|
# trailing comma |
398
|
1
|
50
|
|
|
|
6
|
/\G}/cg or expected |
399
|
|
|
|
|
|
|
"'}', identifier, or string or ". |
400
|
|
|
|
|
|
|
" number literal"; |
401
|
1
|
|
|
|
|
9
|
return bless [[$pos, pos], |
402
|
|
|
|
|
|
|
hash => @ret], JECE; |
403
|
|
|
|
|
|
|
}; |
404
|
|
|
|
|
|
|
|
405
|
100
|
|
|
|
|
160
|
push @ret, $tmp; |
406
|
100
|
|
|
|
|
137
|
&skip; |
407
|
100
|
50
|
|
|
|
516
|
/\G:$s/cggg or expected 'colon'; |
408
|
100
|
50
|
|
|
|
1716
|
@ret != push @ret, &assign |
409
|
|
|
|
|
|
|
or expected 'expression'; |
410
|
100
|
|
|
|
|
148
|
&skip; |
411
|
|
|
|
|
|
|
} |
412
|
|
|
|
|
|
|
} |
413
|
551
|
50
|
|
|
|
2759
|
/\G}/cg or expected "'}'"; |
414
|
551
|
|
|
|
|
4231
|
return bless [[$pos, pos], hash => @ret], JECE; |
415
|
|
|
|
|
|
|
} |
416
|
|
|
|
|
|
|
elsif (/\G\($s/cg) { |
417
|
812
|
50
|
|
|
|
6323
|
my $ret = &expr or expected 'expression'; |
418
|
812
|
|
|
|
|
1369
|
&skip; |
419
|
812
|
50
|
|
|
|
2851
|
/\G\)/cg or expected "')'"; |
420
|
812
|
|
|
|
|
2824
|
return $ret; |
421
|
|
|
|
|
|
|
} |
422
|
|
|
|
|
|
|
return |
423
|
3249
|
|
|
|
|
111821
|
} |
424
|
|
|
|
|
|
|
|
425
|
|
|
|
|
|
|
sub subscript() { # skips leading whitespace |
426
|
71554
|
|
|
71554
|
0
|
83550
|
my $pos = pos; |
427
|
71554
|
|
|
|
|
55818
|
my $subscript; |
428
|
71554
|
100
|
|
|
|
655759
|
if (/\G$s\[$s/cg) { |
|
|
100
|
|
|
|
|
|
429
|
1012
|
50
|
|
|
|
1632
|
$subscript = &expr or expected 'expression'; |
430
|
1012
|
|
|
|
|
1585
|
&skip; |
431
|
1012
|
50
|
|
|
|
2687
|
/\G]/cog or expected "']'"; |
432
|
|
|
|
|
|
|
} |
433
|
|
|
|
|
|
|
elsif (/\G$s\.$s/cg) { |
434
|
4216
|
50
|
|
|
|
8984
|
$subscript = &ident or expected 'identifier'; |
435
|
|
|
|
|
|
|
} |
436
|
66326
|
|
|
|
|
190990
|
else { return } |
437
|
|
|
|
|
|
|
|
438
|
5228
|
|
|
|
|
26956
|
return bless [[$pos, pos], $subscript], 'JE::Code::Subscript'; |
439
|
|
|
|
|
|
|
} |
440
|
|
|
|
|
|
|
|
441
|
|
|
|
|
|
|
sub args() { # skips leading whitespace |
442
|
71522
|
|
|
71522
|
0
|
73839
|
my $pos = pos; |
443
|
71522
|
|
|
|
|
56792
|
my @ret; |
444
|
71522
|
100
|
|
|
|
658829
|
/\G$s\($s/gc or return; |
445
|
10401
|
100
|
|
|
|
26841
|
if (@ret != push @ret, &assign) { # first expression (not prec. |
446
|
|
|
|
|
|
|
# by comma) |
447
|
9018
|
|
|
|
|
47202
|
while (/\G$s,$s/gc) { |
448
|
|
|
|
|
|
|
# if there's a comma we need another expression |
449
|
9249
|
50
|
|
|
|
24161
|
@ret != push @ret, &assign |
450
|
|
|
|
|
|
|
or expected 'expression'; |
451
|
|
|
|
|
|
|
} |
452
|
9018
|
|
|
|
|
18847
|
&skip; |
453
|
|
|
|
|
|
|
} |
454
|
10401
|
100
|
|
|
|
28842
|
/\G\)/gc or expected "')'"; |
455
|
10399
|
|
|
|
|
69224
|
return bless [[$pos, pos], @ret], 'JE::Code::Arguments'; |
456
|
|
|
|
|
|
|
} |
457
|
|
|
|
|
|
|
|
458
|
|
|
|
|
|
|
sub new_expr() { |
459
|
62738
|
100
|
|
62738
|
0
|
330494
|
/\G new(?!$id_cont) $s /cgx or return; |
460
|
1001
|
|
|
|
|
4286
|
my $ret = bless [[pos], 'new'], JECE; |
461
|
|
|
|
|
|
|
|
462
|
1001
|
|
|
|
|
1192
|
my $pos = pos; |
463
|
1001
|
|
33
|
|
|
1544
|
my @member_expr = &new_expr || &term |
464
|
|
|
|
|
|
|
|| expected "identifier, literal, 'new' or '('"; |
465
|
|
|
|
|
|
|
|
466
|
1001
|
|
|
|
|
2070
|
0 while @member_expr != push @member_expr, &subscript; |
467
|
|
|
|
|
|
|
|
468
|
1001
|
100
|
|
|
|
2537
|
push @$ret, @member_expr == 1 ? @member_expr : |
469
|
|
|
|
|
|
|
bless [[$pos, pos], 'member/call', @member_expr], |
470
|
|
|
|
|
|
|
JECE; |
471
|
1001
|
|
|
|
|
1588
|
push @$ret, args; |
472
|
1001
|
|
|
|
|
4123
|
$ret; |
473
|
|
|
|
|
|
|
} |
474
|
|
|
|
|
|
|
|
475
|
|
|
|
|
|
|
sub left_expr() { |
476
|
61737
|
|
|
61737
|
0
|
62511
|
my($pos,@ret) = pos; |
477
|
61737
|
100
|
100
|
|
|
80162
|
@ret != push @ret, &new_expr || &term or return; |
478
|
|
|
|
|
|
|
|
479
|
58478
|
|
|
|
|
112764
|
0 while @ret != push @ret, &subscript, &args; |
480
|
58476
|
100
|
|
|
|
251825
|
@ret ? @ret == 1 ? @ret : |
|
|
50
|
|
|
|
|
|
481
|
|
|
|
|
|
|
bless([[$pos, pos], 'member/call', @ret], |
482
|
|
|
|
|
|
|
JECE) |
483
|
|
|
|
|
|
|
: return; |
484
|
|
|
|
|
|
|
} |
485
|
|
|
|
|
|
|
|
486
|
|
|
|
|
|
|
sub postfix() { |
487
|
61737
|
|
|
61737
|
0
|
74368
|
my($pos,@ret) = pos; |
488
|
61737
|
100
|
|
|
|
76379
|
@ret != push @ret, &left_expr or return; |
489
|
58476
|
|
|
|
|
173490
|
push @ret, $1 while /\G $h ( \+\+ | -- ) /cogx; |
490
|
58476
|
100
|
|
|
|
169761
|
@ret == 1 ? @ret : bless [[$pos, pos], 'postfix', @ret], |
491
|
|
|
|
|
|
|
JECE; |
492
|
|
|
|
|
|
|
} |
493
|
|
|
|
|
|
|
|
494
|
|
|
|
|
|
|
sub unary() { |
495
|
61737
|
|
|
61737
|
0
|
60806
|
my($pos,@ret) = pos; |
496
|
61737
|
|
|
|
|
426497
|
push @ret, $1 while /\G $s ( |
497
|
|
|
|
|
|
|
(?: delete | void | typeof )(?!$id_cont) |
498
|
|
|
|
|
|
|
| |
499
|
|
|
|
|
|
|
\+\+? | --? | ~ | ! |
500
|
|
|
|
|
|
|
) $s /cgx; |
501
|
61737
|
100
|
|
|
|
120845
|
@ret != push @ret, &postfix or ( |
|
|
100
|
|
|
|
|
|
502
|
|
|
|
|
|
|
@ret |
503
|
|
|
|
|
|
|
? expected "expression" |
504
|
|
|
|
|
|
|
: return |
505
|
|
|
|
|
|
|
); |
506
|
58476
|
100
|
|
|
|
177842
|
@ret == 1 ? @ret : bless [[$pos, pos], 'prefix', @ret], |
507
|
|
|
|
|
|
|
JECE; |
508
|
|
|
|
|
|
|
} |
509
|
|
|
|
|
|
|
|
510
|
|
|
|
|
|
|
sub multi() { |
511
|
61518
|
|
|
61518
|
0
|
60403
|
my($pos,@ret) = pos; |
512
|
61518
|
100
|
|
|
|
75118
|
@ret != push @ret, &unary or return; |
513
|
58257
|
|
|
|
|
298598
|
while(m-\G $s ( [*%](?!=) | / (?![*/=]) ) $s -cgx) { |
514
|
219
|
|
|
|
|
669
|
push @ret, $1; |
515
|
219
|
50
|
|
|
|
335
|
@ret == push @ret, &unary and expected 'expression'; |
516
|
|
|
|
|
|
|
} |
517
|
58257
|
100
|
|
|
|
189111
|
@ret == 1 ? @ret : bless [[$pos, pos], 'lassoc', @ret], |
518
|
|
|
|
|
|
|
JECE; |
519
|
|
|
|
|
|
|
} |
520
|
|
|
|
|
|
|
|
521
|
|
|
|
|
|
|
sub add() { |
522
|
60240
|
|
|
60240
|
0
|
59629
|
my($pos,@ret) = pos; |
523
|
60240
|
100
|
|
|
|
72971
|
@ret != push @ret, &multi or return; |
524
|
56979
|
|
|
|
|
255051
|
while(/\G $s ( \+(?![+=]) | -(?![-=]) ) $s /cgx) { |
525
|
1278
|
|
|
|
|
3886
|
push @ret, $1; |
526
|
1278
|
50
|
|
|
|
1842
|
@ret == push @ret, &multi and expected 'expression' |
527
|
|
|
|
|
|
|
} |
528
|
56979
|
100
|
|
|
|
180959
|
@ret == 1 ? @ret : bless [[$pos, pos], 'lassoc', @ret], |
529
|
|
|
|
|
|
|
JECE; |
530
|
|
|
|
|
|
|
} |
531
|
|
|
|
|
|
|
|
532
|
|
|
|
|
|
|
sub bitshift() { |
533
|
60084
|
|
|
60084
|
0
|
57361
|
my($pos,@ret) = pos; |
534
|
60084
|
100
|
|
|
|
74594
|
@ret == push @ret, &add and return; |
535
|
56823
|
|
|
|
|
245094
|
while(/\G $s (>>> | >>(?!>) | <<)(?!=) $s /cgx) { |
536
|
156
|
|
|
|
|
885
|
push @ret, $1; |
537
|
156
|
50
|
|
|
|
230
|
@ret == push @ret, &add and expected 'expression'; |
538
|
|
|
|
|
|
|
} |
539
|
56823
|
100
|
|
|
|
182465
|
@ret == 1 ? @ret : bless [[$pos, pos], 'lassoc', @ret], |
540
|
|
|
|
|
|
|
JECE; |
541
|
|
|
|
|
|
|
} |
542
|
|
|
|
|
|
|
|
543
|
|
|
|
|
|
|
sub rel() { |
544
|
58550
|
|
|
58550
|
0
|
57981
|
my($pos,@ret) = pos; |
545
|
58550
|
100
|
|
|
|
72533
|
@ret == push @ret, &bitshift and return; |
546
|
55302
|
|
|
|
|
276058
|
while(/\G $s ( ([<>])(?!\2|=) | [<>]= | |
547
|
|
|
|
|
|
|
in(?:stanceof)?(?!$id_cont) ) $s /cgx) { |
548
|
957
|
|
|
|
|
2762
|
push @ret, $1; |
549
|
957
|
50
|
|
|
|
1503
|
@ret== push @ret, &bitshift and expected 'expression'; |
550
|
|
|
|
|
|
|
} |
551
|
55302
|
100
|
|
|
|
197752
|
@ret == 1 ? @ret : bless [[$pos, pos], 'lassoc', @ret], |
552
|
|
|
|
|
|
|
JECE; |
553
|
|
|
|
|
|
|
} |
554
|
|
|
|
|
|
|
|
555
|
|
|
|
|
|
|
sub rel_noin() { |
556
|
565
|
|
|
565
|
0
|
626
|
my($pos,@ret) = pos; |
557
|
565
|
100
|
|
|
|
732
|
@ret == push @ret, &bitshift and return; |
558
|
552
|
|
|
|
|
3689
|
while(/\G $s ( ([<>])(?!\2|=) | [<>]= | instanceof(?!$id_cont) ) |
559
|
|
|
|
|
|
|
$s /cgx) { |
560
|
12
|
|
|
|
|
393
|
push @ret, $1; |
561
|
12
|
50
|
|
|
|
20
|
@ret == push @ret, &bitshift and expected 'expression'; |
562
|
|
|
|
|
|
|
} |
563
|
552
|
100
|
|
|
|
9878
|
@ret == 1 ? @ret : bless [[$pos, pos], 'lassoc', @ret], |
564
|
|
|
|
|
|
|
JECE; |
565
|
|
|
|
|
|
|
} |
566
|
|
|
|
|
|
|
|
567
|
|
|
|
|
|
|
sub equal() { |
568
|
55789
|
|
|
55789
|
0
|
55574
|
my($pos,@ret) = pos; |
569
|
55789
|
100
|
|
|
|
69491
|
@ret == push @ret, &rel and return; |
570
|
52541
|
|
|
|
|
512870
|
while(/\G $s ([!=]==?) $s /cgx) { |
571
|
2761
|
|
|
|
|
7442
|
push @ret, $1; |
572
|
2761
|
50
|
|
|
|
4141
|
@ret == push @ret, &rel and expected 'expression'; |
573
|
|
|
|
|
|
|
} |
574
|
52541
|
100
|
|
|
|
176472
|
@ret == 1 ? @ret : bless [[$pos, pos], 'lassoc', @ret], |
575
|
|
|
|
|
|
|
JECE; |
576
|
|
|
|
|
|
|
} |
577
|
|
|
|
|
|
|
|
578
|
|
|
|
|
|
|
sub equal_noin() { |
579
|
555
|
|
|
555
|
0
|
654
|
my($pos,@ret) = pos; |
580
|
555
|
100
|
|
|
|
866
|
@ret == push @ret, &rel_noin and return; |
581
|
542
|
|
|
|
|
3240
|
while(/\G $s ([!=]==?) $s /cgx) { |
582
|
10
|
|
|
|
|
17
|
push @ret, $1; |
583
|
10
|
50
|
|
|
|
16
|
@ret == push @ret, &rel_noin and expected 'expression'; |
584
|
|
|
|
|
|
|
} |
585
|
542
|
100
|
|
|
|
8156
|
@ret == 1 ? @ret : bless [[$pos, pos], 'lassoc', @ret], |
586
|
|
|
|
|
|
|
JECE; |
587
|
|
|
|
|
|
|
} |
588
|
|
|
|
|
|
|
|
589
|
|
|
|
|
|
|
sub bit_and() { |
590
|
55737
|
|
|
55737
|
0
|
53971
|
my($pos,@ret) = pos; |
591
|
55737
|
100
|
|
|
|
65941
|
@ret == push @ret, &equal and return; |
592
|
52489
|
|
|
|
|
1049786
|
while(/\G $s &(?![&=]) $s /cgx) { |
593
|
52
|
50
|
|
|
|
850
|
@ret == push @ret, '&', &equal and expected 'expression'; |
594
|
|
|
|
|
|
|
} |
595
|
52489
|
100
|
|
|
|
167568
|
@ret == 1 ? @ret : bless [[$pos, pos], 'lassoc', @ret], |
596
|
|
|
|
|
|
|
JECE; |
597
|
|
|
|
|
|
|
} |
598
|
|
|
|
|
|
|
|
599
|
|
|
|
|
|
|
sub bit_and_noin() { |
600
|
553
|
|
|
553
|
0
|
608
|
my($pos,@ret) = pos; |
601
|
553
|
100
|
|
|
|
774
|
@ret == push @ret, &equal_noin and return; |
602
|
540
|
|
|
|
|
7999
|
while(/\G $s &(?![&=]) $s /cgx) { |
603
|
2
|
50
|
|
|
|
4
|
@ret == push @ret, '&', &equal_noin |
604
|
|
|
|
|
|
|
and expected 'expression'; |
605
|
|
|
|
|
|
|
} |
606
|
540
|
100
|
|
|
|
7903
|
@ret == 1 ? @ret : bless [[$pos, pos], 'lassoc', @ret], |
607
|
|
|
|
|
|
|
JECE; |
608
|
|
|
|
|
|
|
} |
609
|
|
|
|
|
|
|
|
610
|
|
|
|
|
|
|
sub bit_or() { |
611
|
55684
|
|
|
55684
|
0
|
55879
|
my($pos,@ret) = pos; |
612
|
55684
|
100
|
|
|
|
70448
|
@ret == push @ret, &bit_and and return; |
613
|
52436
|
|
|
|
|
1041438
|
while(/\G $s \|(?![|=]) $s /cgx) { |
614
|
53
|
50
|
|
|
|
353
|
@ret == push @ret, '|', &bit_and and expected 'expression'; |
615
|
|
|
|
|
|
|
} |
616
|
52436
|
100
|
|
|
|
167347
|
@ret == 1 ? @ret : bless [[$pos, pos], 'lassoc', @ret], |
617
|
|
|
|
|
|
|
JECE; |
618
|
|
|
|
|
|
|
} |
619
|
|
|
|
|
|
|
|
620
|
|
|
|
|
|
|
sub bit_or_noin() { |
621
|
551
|
|
|
551
|
0
|
624
|
my($pos,@ret) = pos; |
622
|
551
|
100
|
|
|
|
749
|
@ret == push @ret, &bit_and_noin and return; |
623
|
538
|
|
|
|
|
7928
|
while(/\G $s \|(?![|=]) $s /cgx) { |
624
|
2
|
50
|
|
|
|
5
|
@ret == push @ret, '|', &bit_and_noin |
625
|
|
|
|
|
|
|
and expected 'expression'; |
626
|
|
|
|
|
|
|
} |
627
|
538
|
100
|
|
|
|
7955
|
@ret == 1 ? @ret : bless [[$pos, pos], 'lassoc', @ret], |
628
|
|
|
|
|
|
|
JECE; |
629
|
|
|
|
|
|
|
} |
630
|
|
|
|
|
|
|
|
631
|
|
|
|
|
|
|
sub bit_xor() { |
632
|
55632
|
|
|
55632
|
0
|
52834
|
my($pos,@ret) = pos; |
633
|
55632
|
100
|
|
|
|
69416
|
@ret == push @ret, &bit_or and return; |
634
|
52384
|
|
|
|
|
963730
|
while(/\G $s \^(?!=) $s /cgx) { |
635
|
52
|
50
|
|
|
|
355
|
@ret == push @ret, '^', &bit_or and expected 'expression'; |
636
|
|
|
|
|
|
|
} |
637
|
52384
|
100
|
|
|
|
172295
|
@ret == 1 ? @ret : bless [[$pos, pos], 'lassoc', @ret], |
638
|
|
|
|
|
|
|
JECE; |
639
|
|
|
|
|
|
|
} |
640
|
|
|
|
|
|
|
|
641
|
|
|
|
|
|
|
sub bit_xor_noin() { |
642
|
549
|
|
|
549
|
0
|
653
|
my($pos,@ret) = pos; |
643
|
549
|
100
|
|
|
|
767
|
@ret == push @ret, &bit_or_noin and return; |
644
|
536
|
|
|
|
|
7901
|
while(/\G $s \^(?!=) $s /cgx) { |
645
|
2
|
50
|
|
|
|
5
|
@ret == push @ret, '^', &bit_or_noin |
646
|
|
|
|
|
|
|
and expected 'expression'; |
647
|
|
|
|
|
|
|
} |
648
|
536
|
100
|
|
|
|
7961
|
@ret == 1 ? @ret : bless [[$pos, pos], 'lassoc', @ret], |
649
|
|
|
|
|
|
|
JECE; |
650
|
|
|
|
|
|
|
} |
651
|
|
|
|
|
|
|
|
652
|
|
|
|
|
|
|
sub and_expr() { # If I just call it 'and', then I have to write |
653
|
|
|
|
|
|
|
# CORE::and for the operator! (Far too cumbersome.) |
654
|
55155
|
|
|
55155
|
0
|
54346
|
my($pos,@ret) = pos; |
655
|
55155
|
100
|
|
|
|
68644
|
@ret == push @ret, &bit_xor and return; |
656
|
51907
|
|
|
|
|
737221
|
while(/\G $s && $s /cgx) { |
657
|
477
|
50
|
|
|
|
1273
|
@ret == push @ret, '&&', &bit_xor |
658
|
|
|
|
|
|
|
and expected 'expression'; |
659
|
|
|
|
|
|
|
} |
660
|
51907
|
100
|
|
|
|
166577
|
@ret == 1 ? @ret : bless [[$pos, pos], 'lassoc', @ret], |
661
|
|
|
|
|
|
|
JECE; |
662
|
|
|
|
|
|
|
} |
663
|
|
|
|
|
|
|
|
664
|
|
|
|
|
|
|
sub and_noin() { |
665
|
547
|
|
|
547
|
0
|
616
|
my($pos,@ret) = pos; |
666
|
547
|
100
|
|
|
|
826
|
@ret == push @ret, &bit_xor_noin and return; |
667
|
534
|
|
|
|
|
5225
|
while(/\G $s && $s /cgx) { |
668
|
2
|
50
|
|
|
|
4
|
@ret == push @ret, '&&', &bit_xor_noin |
669
|
|
|
|
|
|
|
and expected 'expression'; |
670
|
|
|
|
|
|
|
} |
671
|
534
|
100
|
|
|
|
7884
|
@ret == 1 ? @ret : bless [[$pos, pos], 'lassoc', @ret], |
672
|
|
|
|
|
|
|
JECE; |
673
|
|
|
|
|
|
|
} |
674
|
|
|
|
|
|
|
|
675
|
|
|
|
|
|
|
sub or_expr() { |
676
|
55075
|
|
|
55075
|
0
|
57185
|
my($pos,@ret) = pos; |
677
|
55075
|
100
|
|
|
|
68018
|
@ret == push @ret, &and_expr and return; |
678
|
51827
|
|
|
|
|
717215
|
while(/\G $s \|\| $s /cgx) { |
679
|
80
|
50
|
|
|
|
148
|
@ret == push @ret, '||', &and_expr |
680
|
|
|
|
|
|
|
and expected 'expression'; |
681
|
|
|
|
|
|
|
} |
682
|
51827
|
100
|
|
|
|
171574
|
@ret == 1 ? @ret : bless [[$pos, pos], 'lassoc', @ret], |
683
|
|
|
|
|
|
|
JECE; |
684
|
|
|
|
|
|
|
} |
685
|
|
|
|
|
|
|
|
686
|
|
|
|
|
|
|
sub or_noin() { |
687
|
545
|
|
|
545
|
0
|
803
|
my($pos,@ret) = pos; |
688
|
545
|
100
|
|
|
|
827
|
@ret == push @ret, &and_noin and return; |
689
|
532
|
|
|
|
|
5105
|
while(/\G $s \|\| $s /cgx) { |
690
|
2
|
50
|
|
|
|
30
|
@ret == push @ret, '||', &and_noin |
691
|
|
|
|
|
|
|
and expected 'expression'; |
692
|
|
|
|
|
|
|
} |
693
|
532
|
100
|
|
|
|
9095
|
@ret == 1 ? @ret : bless [[$pos, pos], 'lassoc', @ret], |
694
|
|
|
|
|
|
|
JECE; |
695
|
|
|
|
|
|
|
} |
696
|
|
|
|
|
|
|
|
697
|
|
|
|
|
|
|
sub assign() { |
698
|
53457
|
|
|
53457
|
0
|
99887
|
my($pos,@ret) = pos; |
699
|
53457
|
100
|
|
|
|
67162
|
@ret == push @ret, &or_expr and return; |
700
|
50210
|
|
|
|
|
520503
|
while(m@\G $s ((?>(?: [-*/%+&^|] | << | >>>? )?)=) $s @cgx) { |
701
|
1618
|
|
|
|
|
9202
|
push @ret, $1; |
702
|
1618
|
50
|
|
|
|
2652
|
@ret == push @ret, &or_expr and expected 'expression'; |
703
|
|
|
|
|
|
|
} |
704
|
50209
|
100
|
|
|
|
1177905
|
if(/\G$s\?$s/cg) { |
705
|
48
|
50
|
|
|
|
109
|
@ret == push @ret, &assign and expected 'expression'; |
706
|
48
|
|
|
|
|
95
|
&skip; |
707
|
48
|
50
|
|
|
|
561
|
/\G:$s/cg or expected "colon"; |
708
|
48
|
50
|
|
|
|
1446
|
@ret == push @ret, &assign and expected 'expression'; |
709
|
|
|
|
|
|
|
} |
710
|
50209
|
100
|
|
|
|
252006
|
@ret == 1 ? @ret : bless [[$pos, pos], 'assign', @ret], |
711
|
|
|
|
|
|
|
JECE; |
712
|
|
|
|
|
|
|
} |
713
|
|
|
|
|
|
|
|
714
|
|
|
|
|
|
|
sub assign_noin() { |
715
|
321
|
|
|
321
|
0
|
2372
|
my($pos,@ret) = pos; |
716
|
321
|
100
|
|
|
|
581
|
@ret == push @ret, &or_noin and return; |
717
|
308
|
|
|
|
|
2414
|
while(m~\G $s ((?>(?: [-*/%+&^|] | << | >>>? )?)=) $s ~cgx) { |
718
|
224
|
|
|
|
|
3382
|
push @ret, $1; |
719
|
224
|
50
|
|
|
|
366
|
@ret == push @ret, &or_noin and expected 'expression'; |
720
|
|
|
|
|
|
|
} |
721
|
308
|
100
|
|
|
|
5543
|
if(/\G$s\?$s/cg) { |
722
|
6
|
50
|
|
|
|
10
|
@ret == push @ret, &assign and expected 'expression'; |
723
|
6
|
|
|
|
|
11
|
&skip; |
724
|
6
|
50
|
|
|
|
45
|
/\G:$s/cg or expected "colon"; |
725
|
6
|
50
|
|
|
|
256
|
@ret == push @ret, &assign_noin and expected 'expression'; |
726
|
|
|
|
|
|
|
} |
727
|
308
|
100
|
|
|
|
8378
|
@ret == 1 ? @ret : bless [[$pos, pos], 'assign', @ret], |
728
|
|
|
|
|
|
|
JECE; |
729
|
|
|
|
|
|
|
} |
730
|
|
|
|
|
|
|
|
731
|
|
|
|
|
|
|
sub expr() { # public |
732
|
11982
|
|
|
11982
|
0
|
39523
|
my $ret = bless [[pos], 'expr'], JECE; |
733
|
11982
|
100
|
|
|
|
20800
|
@$ret == push @$ret, &assign and return; |
734
|
10286
|
|
|
|
|
52291
|
while(/\G$s,$s/cg) { |
735
|
304
|
50
|
|
|
|
1276
|
@$ret == push @$ret,& assign and expected 'expression'; |
736
|
|
|
|
|
|
|
} |
737
|
10286
|
|
|
|
|
35111
|
push @{$$ret[0]},pos; |
|
10286
|
|
|
|
|
21373
|
|
738
|
10286
|
|
|
|
|
28423
|
$ret; |
739
|
|
|
|
|
|
|
} |
740
|
|
|
|
|
|
|
|
741
|
|
|
|
|
|
|
sub expr_noin() { # public |
742
|
237
|
|
|
237
|
0
|
4166
|
my $ret = bless [[pos], 'expr'], JECE; |
743
|
237
|
100
|
|
|
|
531
|
@$ret == push @$ret, &assign_noin and return; |
744
|
224
|
|
|
|
|
1723
|
while(/\G$s,$s/cg) { |
745
|
22
|
50
|
|
|
|
40
|
@$ret == push @$ret, &assign_noin |
746
|
|
|
|
|
|
|
and expected 'expression'; |
747
|
|
|
|
|
|
|
} |
748
|
224
|
|
|
|
|
5713
|
push @{$$ret[0]},pos; |
|
224
|
|
|
|
|
514
|
|
749
|
224
|
|
|
|
|
652
|
$ret; |
750
|
|
|
|
|
|
|
} |
751
|
|
|
|
|
|
|
|
752
|
|
|
|
|
|
|
sub vardecl() { # vardecl is only called when we *know* we need it, so it |
753
|
|
|
|
|
|
|
# will die when it can't get the first identifier, instead |
754
|
|
|
|
|
|
|
# of returning undef |
755
|
385
|
|
|
385
|
0
|
438
|
my @ret; |
756
|
385
|
50
|
|
|
|
726
|
@ret == push @ret, &ident and expected 'identifier'; |
757
|
385
|
100
|
33
|
|
|
4137
|
/\G$s=$s/cg and |
758
|
|
|
|
|
|
|
(@ret != push @ret, &assign or expected 'expression'); |
759
|
385
|
|
|
|
|
3222
|
push @$_vars, $ret[0]; |
760
|
385
|
|
|
|
|
3801
|
\@ret; |
761
|
|
|
|
|
|
|
} |
762
|
|
|
|
|
|
|
|
763
|
|
|
|
|
|
|
sub vardecl_noin() { |
764
|
118
|
|
|
118
|
0
|
118
|
my @ret; |
765
|
118
|
50
|
|
|
|
224
|
@ret == push @ret, &ident and expected 'identifier'; |
766
|
118
|
100
|
33
|
|
|
1081
|
/\G$s=$s/cg and |
767
|
|
|
|
|
|
|
(@ret != push @ret, &assign_noin or expected 'expression'); |
768
|
118
|
|
|
|
|
2906
|
push @$_vars, $ret[0]; |
769
|
118
|
|
|
|
|
285
|
\@ret; |
770
|
|
|
|
|
|
|
} |
771
|
|
|
|
|
|
|
|
772
|
|
|
|
|
|
|
sub finish_for_sc_sc() { # returns the last two expressions of a for (;;) |
773
|
|
|
|
|
|
|
# loop header |
774
|
301
|
|
|
301
|
0
|
302
|
my @ret; |
775
|
|
|
|
|
|
|
my $msg; |
776
|
301
|
100
|
|
|
|
522
|
if(@ret != push @ret, expr) { |
777
|
260
|
|
|
|
|
352
|
$msg = ''; |
778
|
260
|
|
|
|
|
391
|
&skip |
779
|
|
|
|
|
|
|
} else { |
780
|
41
|
|
|
|
|
279
|
push @ret, 'empty'; |
781
|
41
|
|
|
|
|
44
|
$msg = 'expression or ' |
782
|
|
|
|
|
|
|
} |
783
|
301
|
50
|
|
|
|
1739
|
/\G;$s/cg or expected "${msg}semicolon"; |
784
|
301
|
100
|
|
|
|
3103
|
if(@ret != push @ret, expr) { |
785
|
194
|
|
|
|
|
249
|
$msg = ''; |
786
|
194
|
|
|
|
|
273
|
&skip |
787
|
|
|
|
|
|
|
} else { |
788
|
107
|
|
|
|
|
146
|
push @ret, 'empty'; |
789
|
107
|
|
|
|
|
134
|
$msg = 'expression or ' |
790
|
|
|
|
|
|
|
} |
791
|
301
|
50
|
|
|
|
1703
|
/\G\)$s/cg or expected "${msg}')'"; |
792
|
|
|
|
|
|
|
|
793
|
301
|
|
|
|
|
3622
|
@ret; |
794
|
|
|
|
|
|
|
} |
795
|
|
|
|
|
|
|
|
796
|
|
|
|
|
|
|
# ----------- Statement types ------------ # |
797
|
|
|
|
|
|
|
# (used by custom parsers) |
798
|
|
|
|
|
|
|
|
799
|
|
|
|
|
|
|
our $optional_sc = # public |
800
|
|
|
|
|
|
|
qr-\G (?: |
801
|
|
|
|
|
|
|
$s (?: \z | ; $s | (?=\}) ) |
802
|
|
|
|
|
|
|
| |
803
|
|
|
|
|
|
|
|
804
|
|
|
|
|
|
|
# optional horizontal whitespace |
805
|
|
|
|
|
|
|
# then a line terminator or a comment containing one |
806
|
|
|
|
|
|
|
# then optional trailing whitespace |
807
|
|
|
|
|
|
|
$h |
808
|
|
|
|
|
|
|
(?: $n | //[^\cm\cj\x{2028}\x{2029}]* $n | |
809
|
|
|
|
|
|
|
/\* [^*\cm\cj\x{2028}\x{2029}]* |
810
|
|
|
|
|
|
|
(?: \*(?!/) [^*\cm\cj\x{2028}\x{2029}] )* |
811
|
|
|
|
|
|
|
$n |
812
|
|
|
|
|
|
|
(?s:.)*? |
813
|
|
|
|
|
|
|
\*/ |
814
|
|
|
|
|
|
|
) |
815
|
|
|
|
|
|
|
$s |
816
|
|
|
|
|
|
|
)-x; |
817
|
|
|
|
|
|
|
|
818
|
|
|
|
|
|
|
sub optional_sc() { |
819
|
9
|
100
|
|
9
|
0
|
57
|
/$optional_sc/gc or expected "semicolon, '}' or end of line"; |
820
|
|
|
|
|
|
|
} |
821
|
|
|
|
|
|
|
|
822
|
|
|
|
|
|
|
sub block() { |
823
|
16
|
50
|
|
16
|
0
|
61
|
/\G\{/gc or return; |
824
|
0
|
|
|
|
|
0
|
my $ret = [[pos()-1], 'statements']; |
825
|
0
|
|
|
|
|
0
|
&skip; |
826
|
0
|
|
|
|
|
0
|
while() { # 'last' does not work when 'while' is a |
827
|
|
|
|
|
|
|
# statement modifier |
828
|
0
|
0
|
|
|
|
0
|
@$ret == push @$ret, &statement and last; |
829
|
|
|
|
|
|
|
} |
830
|
0
|
0
|
|
|
|
0
|
expected "'}'" unless /\G\}$s/gc; |
831
|
|
|
|
|
|
|
|
832
|
0
|
|
|
|
|
0
|
push @{$$ret[0]},pos; |
|
0
|
|
|
|
|
0
|
|
833
|
|
|
|
|
|
|
|
834
|
0
|
|
|
|
|
0
|
bless $ret, JECS; |
835
|
|
|
|
|
|
|
} |
836
|
|
|
|
|
|
|
|
837
|
|
|
|
|
|
|
sub empty() { |
838
|
16
|
|
|
16
|
0
|
15
|
my $pos = pos; |
839
|
16
|
50
|
|
|
|
93
|
/\G;$s/cg or return; |
840
|
0
|
|
|
|
|
0
|
bless [[$pos,pos], 'empty'], JECS; |
841
|
|
|
|
|
|
|
} |
842
|
|
|
|
|
|
|
|
843
|
|
|
|
|
|
|
sub function() { |
844
|
7064
|
|
|
7064
|
0
|
9346
|
my $pos = pos; |
845
|
7064
|
100
|
|
|
|
39387
|
/\Gfunction$S/cg or return; |
846
|
132
|
|
|
|
|
5827
|
my $ret = [[$pos], 'function']; |
847
|
132
|
50
|
|
|
|
366
|
@$ret == push @$ret, &ident |
848
|
|
|
|
|
|
|
and expected "identifier"; |
849
|
132
|
|
|
|
|
276
|
&skip; |
850
|
132
|
|
|
|
|
4626
|
push @$ret, ¶ms; |
851
|
132
|
|
|
|
|
229
|
&skip; |
852
|
132
|
50
|
|
|
|
413
|
/\G \{ /gcx or expected "'{'"; |
853
|
|
|
|
|
|
|
{ |
854
|
132
|
|
|
|
|
156
|
local $_vars = []; |
|
132
|
|
|
|
|
220
|
|
855
|
132
|
|
|
|
|
302
|
push @$ret, &statements, $_vars; |
856
|
|
|
|
|
|
|
} |
857
|
132
|
50
|
|
|
|
1502
|
/\G \}$s /gcx or expected "'}'"; |
858
|
|
|
|
|
|
|
|
859
|
132
|
|
|
|
|
5850
|
push @{$$ret[0]},pos; |
|
132
|
|
|
|
|
334
|
|
860
|
|
|
|
|
|
|
|
861
|
132
|
|
|
|
|
234
|
push @$_vars, $ret; |
862
|
|
|
|
|
|
|
|
863
|
132
|
|
|
|
|
739
|
bless $ret, JECS; |
864
|
|
|
|
|
|
|
} |
865
|
|
|
|
|
|
|
|
866
|
|
|
|
|
|
|
sub if() { |
867
|
16
|
|
|
16
|
0
|
16
|
my $pos = pos; |
868
|
16
|
50
|
|
|
|
89
|
/\Gif$s\($s/cg or return; |
869
|
0
|
|
|
|
|
0
|
my $ret = [[$pos], 'if']; |
870
|
|
|
|
|
|
|
|
871
|
0
|
0
|
|
|
|
0
|
@$ret == push @$ret, &expr |
872
|
|
|
|
|
|
|
and expected 'expression'; |
873
|
0
|
|
|
|
|
0
|
&skip; |
874
|
0
|
0
|
|
|
|
0
|
/\G\)$s/gc or expected "')'"; |
875
|
0
|
0
|
|
|
|
0
|
@$ret != push @$ret, &statement |
876
|
|
|
|
|
|
|
or expected 'statement'; |
877
|
0
|
0
|
|
|
|
0
|
if (/\Gelse(?!$id_cont)$s/cg) { |
878
|
0
|
0
|
|
|
|
0
|
@$ret == push @$ret, &statement |
879
|
|
|
|
|
|
|
and expected 'statement'; |
880
|
|
|
|
|
|
|
} |
881
|
|
|
|
|
|
|
|
882
|
0
|
|
|
|
|
0
|
push @{$$ret[0]},pos; |
|
0
|
|
|
|
|
0
|
|
883
|
|
|
|
|
|
|
|
884
|
0
|
|
|
|
|
0
|
bless $ret, JECS; |
885
|
|
|
|
|
|
|
} |
886
|
|
|
|
|
|
|
|
887
|
|
|
|
|
|
|
sub while() { |
888
|
0
|
|
|
0
|
0
|
0
|
my $pos = pos; |
889
|
0
|
0
|
|
|
|
0
|
/\Gwhile$s\($s/cg or return; |
890
|
0
|
|
|
|
|
0
|
my $ret = [[$pos], 'while']; |
891
|
|
|
|
|
|
|
|
892
|
0
|
0
|
|
|
|
0
|
@$ret == push @$ret, &expr |
893
|
|
|
|
|
|
|
and expected 'expression'; |
894
|
0
|
|
|
|
|
0
|
&skip; |
895
|
0
|
0
|
|
|
|
0
|
/\G\)$s/gc or expected "')'"; |
896
|
0
|
0
|
|
|
|
0
|
@$ret != push @$ret, &statement |
897
|
|
|
|
|
|
|
or expected 'statement'; |
898
|
|
|
|
|
|
|
|
899
|
0
|
|
|
|
|
0
|
push @{$$ret[0]},pos; |
|
0
|
|
|
|
|
0
|
|
900
|
|
|
|
|
|
|
|
901
|
0
|
|
|
|
|
0
|
bless $ret, JECS; |
902
|
|
|
|
|
|
|
} |
903
|
|
|
|
|
|
|
|
904
|
|
|
|
|
|
|
sub for() { |
905
|
0
|
|
|
0
|
1
|
0
|
my $pos = pos; |
906
|
0
|
0
|
|
|
|
0
|
/\Gfor$s\($s/cg or return; |
907
|
0
|
|
|
|
|
0
|
my $ret = [[$pos], 'for']; |
908
|
|
|
|
|
|
|
|
909
|
0
|
0
|
|
|
|
0
|
if (/\G var$S/cgx) { |
|
|
0
|
|
|
|
|
|
910
|
0
|
|
|
|
|
0
|
push @$ret, my $var = bless |
911
|
|
|
|
|
|
|
[[pos() - length $1], 'var'], |
912
|
|
|
|
|
|
|
'JE::Code::Statement'; |
913
|
|
|
|
|
|
|
|
914
|
0
|
|
|
|
|
0
|
push @$var, &vardecl_noin; |
915
|
0
|
|
|
|
|
0
|
&skip; |
916
|
0
|
0
|
|
|
|
0
|
if (/\G([;,])$s/gc) { |
917
|
|
|
|
|
|
|
# if there's a comma or sc then |
918
|
|
|
|
|
|
|
# this is a for(;;) loop |
919
|
0
|
0
|
|
|
|
0
|
if ($1 eq ',') { |
920
|
|
|
|
|
|
|
# finish getting the var |
921
|
|
|
|
|
|
|
# decl list |
922
|
0
|
|
|
|
|
0
|
do{ |
923
|
0
|
0
|
|
|
|
0
|
@$var == |
924
|
|
|
|
|
|
|
push @$var, &vardecl |
925
|
|
|
|
|
|
|
and expected |
926
|
|
|
|
|
|
|
'identifier' |
927
|
|
|
|
|
|
|
} while (/\G$s,$s/gc); |
928
|
0
|
|
|
|
|
0
|
&skip; |
929
|
0
|
0
|
|
|
|
0
|
/\G;$s/cg |
930
|
|
|
|
|
|
|
or expected 'semicolon'; |
931
|
|
|
|
|
|
|
} |
932
|
0
|
|
|
|
|
0
|
push @$ret, &finish_for_sc_sc; |
933
|
|
|
|
|
|
|
} |
934
|
|
|
|
|
|
|
else { |
935
|
0
|
0
|
|
|
|
0
|
/\Gin$s/cg or expected |
936
|
|
|
|
|
|
|
"'in', comma or semicolon"; |
937
|
0
|
|
|
|
|
0
|
push @$ret, 'in'; |
938
|
0
|
0
|
|
|
|
0
|
@$ret == push @$ret, &expr |
939
|
|
|
|
|
|
|
and expected 'expresssion'; |
940
|
0
|
|
|
|
|
0
|
&skip; |
941
|
0
|
0
|
|
|
|
0
|
/\G\)$s/cg or expected "')'"; |
942
|
|
|
|
|
|
|
} |
943
|
|
|
|
|
|
|
} |
944
|
|
|
|
|
|
|
elsif(@$ret != push @$ret, &expr_noin) { |
945
|
0
|
|
|
|
|
0
|
&skip; |
946
|
0
|
0
|
|
|
|
0
|
if (/\G;$s/gc) { |
947
|
|
|
|
|
|
|
# if there's a semicolon then |
948
|
|
|
|
|
|
|
# this is a for(;;) loop |
949
|
0
|
|
|
|
|
0
|
push @$ret, &finish_for_sc_sc; |
950
|
|
|
|
|
|
|
} |
951
|
|
|
|
|
|
|
else { |
952
|
0
|
0
|
|
|
|
0
|
/\Gin$s/cg or expected |
953
|
|
|
|
|
|
|
"'in' or semicolon"; |
954
|
0
|
|
|
|
|
0
|
push @$ret, 'in'; |
955
|
0
|
0
|
|
|
|
0
|
@$ret == push @$ret, &expr |
956
|
|
|
|
|
|
|
and expected 'expresssion'; |
957
|
0
|
|
|
|
|
0
|
&skip; |
958
|
0
|
0
|
|
|
|
0
|
/\G\)$s/cg or expected "')'"; |
959
|
|
|
|
|
|
|
} |
960
|
|
|
|
|
|
|
} |
961
|
|
|
|
|
|
|
else { |
962
|
0
|
|
|
|
|
0
|
push @$ret, 'empty'; |
963
|
0
|
0
|
|
|
|
0
|
/\G;$s/cg |
964
|
|
|
|
|
|
|
or expected 'expression or semicolon'; |
965
|
0
|
|
|
|
|
0
|
push @$ret, &finish_for_sc_sc; |
966
|
|
|
|
|
|
|
} |
967
|
|
|
|
|
|
|
|
968
|
|
|
|
|
|
|
# body of the for loop |
969
|
0
|
0
|
|
|
|
0
|
@$ret != push @$ret, &statement |
970
|
|
|
|
|
|
|
or expected 'statement'; |
971
|
|
|
|
|
|
|
|
972
|
0
|
|
|
|
|
0
|
push @{$$ret[0]},pos; |
|
0
|
|
|
|
|
0
|
|
973
|
|
|
|
|
|
|
|
974
|
0
|
|
|
|
|
0
|
bless $ret, JECS; |
975
|
|
|
|
|
|
|
} |
976
|
|
|
|
|
|
|
|
977
|
|
|
|
|
|
|
sub with() { # almost identical to while |
978
|
16
|
|
|
16
|
0
|
23
|
my $pos = pos; |
979
|
16
|
50
|
|
|
|
90
|
/\Gwith$s\($s/cg or return; |
980
|
0
|
|
|
|
|
0
|
my $ret = [[$pos], 'with']; |
981
|
|
|
|
|
|
|
|
982
|
0
|
0
|
|
|
|
0
|
@$ret == push @$ret, &expr |
983
|
|
|
|
|
|
|
and expected 'expression'; |
984
|
0
|
|
|
|
|
0
|
&skip; |
985
|
0
|
0
|
|
|
|
0
|
/\G\)$s/gc or expected "')'"; |
986
|
0
|
0
|
|
|
|
0
|
@$ret != push @$ret, &statement |
987
|
|
|
|
|
|
|
or expected 'statement'; |
988
|
|
|
|
|
|
|
|
989
|
0
|
|
|
|
|
0
|
push @{$$ret[0]},pos; |
|
0
|
|
|
|
|
0
|
|
990
|
|
|
|
|
|
|
|
991
|
0
|
|
|
|
|
0
|
bless $ret, JECS; |
992
|
|
|
|
|
|
|
} |
993
|
|
|
|
|
|
|
|
994
|
|
|
|
|
|
|
sub switch() { |
995
|
16
|
|
|
16
|
0
|
18
|
my $pos = pos; |
996
|
16
|
50
|
|
|
|
91
|
/\Gswitch$s\($s/cg or return; |
997
|
0
|
|
|
|
|
0
|
my $ret = [[$pos], 'switch']; |
998
|
|
|
|
|
|
|
|
999
|
0
|
0
|
|
|
|
0
|
@$ret == push @$ret, &expr |
1000
|
|
|
|
|
|
|
and expected 'expression'; |
1001
|
0
|
|
|
|
|
0
|
&skip; |
1002
|
0
|
0
|
|
|
|
0
|
/\G\)$s/gc or expected "')'"; |
1003
|
0
|
0
|
|
|
|
0
|
/\G\{$s/gc or expected "'{'"; |
1004
|
|
|
|
|
|
|
|
1005
|
0
|
|
|
|
|
0
|
while (/\G case(?!$id_cont) $s/cgx) { |
1006
|
0
|
0
|
|
|
|
0
|
@$ret == push @$ret, &expr |
1007
|
|
|
|
|
|
|
and expected 'expression'; |
1008
|
0
|
|
|
|
|
0
|
&skip; |
1009
|
0
|
0
|
|
|
|
0
|
/\G:$s/cg or expected 'colon'; |
1010
|
0
|
|
|
|
|
0
|
push @$ret, &statements; |
1011
|
|
|
|
|
|
|
} |
1012
|
0
|
|
|
|
|
0
|
my $default=0; |
1013
|
0
|
0
|
|
|
|
0
|
if (/\G default(?!$id_cont) $s/cgx) { |
1014
|
0
|
0
|
|
|
|
0
|
/\G : $s /cgx or expected 'colon'; |
1015
|
0
|
|
|
|
|
0
|
push @$ret, default => &statements; |
1016
|
0
|
|
|
|
|
0
|
++$default; |
1017
|
|
|
|
|
|
|
} |
1018
|
0
|
|
|
|
|
0
|
while (/\G case(?!$id_cont) $s/cgx) { |
1019
|
0
|
0
|
|
|
|
0
|
@$ret == push @$ret, &expr |
1020
|
|
|
|
|
|
|
and expected 'expression'; |
1021
|
0
|
|
|
|
|
0
|
&skip; |
1022
|
0
|
0
|
|
|
|
0
|
/\G:$s/cg or expected 'colon'; |
1023
|
0
|
|
|
|
|
0
|
push @$ret, &statements; |
1024
|
|
|
|
|
|
|
} |
1025
|
0
|
0
|
|
|
|
0
|
/\G \} $s /cgx or expected ( |
|
|
0
|
|
|
|
|
|
1026
|
|
|
|
|
|
|
$default |
1027
|
|
|
|
|
|
|
? "'}' or 'case'" |
1028
|
|
|
|
|
|
|
: "'}', 'case' or 'default'" |
1029
|
|
|
|
|
|
|
); |
1030
|
|
|
|
|
|
|
|
1031
|
0
|
|
|
|
|
0
|
push @{$$ret[0]},pos; |
|
0
|
|
|
|
|
0
|
|
1032
|
|
|
|
|
|
|
|
1033
|
0
|
|
|
|
|
0
|
bless $ret, JECS; |
1034
|
|
|
|
|
|
|
} |
1035
|
|
|
|
|
|
|
|
1036
|
|
|
|
|
|
|
sub try() { |
1037
|
16
|
|
|
16
|
0
|
16
|
my $pos = pos; |
1038
|
16
|
50
|
|
|
|
91
|
/\Gtry$s\{$s/cg or return; |
1039
|
0
|
|
|
|
|
0
|
my $ret = [[$pos], 'try', &statements]; |
1040
|
|
|
|
|
|
|
|
1041
|
0
|
0
|
|
|
|
0
|
/\G \} $s /cgx or expected "'}'"; |
1042
|
|
|
|
|
|
|
|
1043
|
0
|
|
|
|
|
0
|
$pos = pos; |
1044
|
|
|
|
|
|
|
|
1045
|
0
|
0
|
|
|
|
0
|
if(/\Gcatch$s/cg) { |
1046
|
0
|
0
|
|
|
|
0
|
/\G \( $s /cgx or expected "'('"; |
1047
|
0
|
0
|
|
|
|
0
|
@$ret == push @$ret, &ident |
1048
|
|
|
|
|
|
|
and expected 'identifier'; |
1049
|
0
|
|
|
|
|
0
|
&skip; |
1050
|
0
|
0
|
|
|
|
0
|
/\G \) $s /cgx or expected "')'"; |
1051
|
|
|
|
|
|
|
|
1052
|
0
|
0
|
|
|
|
0
|
/\G \{ $s /cgx or expected "'{'"; |
1053
|
0
|
|
|
|
|
0
|
push @$ret, &statements; |
1054
|
0
|
0
|
|
|
|
0
|
/\G \} $s /cgx or expected "'}'"; |
1055
|
|
|
|
|
|
|
} |
1056
|
0
|
0
|
|
|
|
0
|
if(/\Gfinally$s/cg) { |
1057
|
0
|
0
|
|
|
|
0
|
/\G \{ $s /cgx or expected "'{'"; |
1058
|
0
|
|
|
|
|
0
|
push @$ret, &statements; |
1059
|
0
|
0
|
|
|
|
0
|
/\G \} $s /cgx or expected "'}'"; |
1060
|
|
|
|
|
|
|
} |
1061
|
|
|
|
|
|
|
|
1062
|
0
|
0
|
|
|
|
0
|
pos eq $pos and expected "'catch' or 'finally'"; |
1063
|
|
|
|
|
|
|
|
1064
|
0
|
|
|
|
|
0
|
push @{$$ret[0]},pos; |
|
0
|
|
|
|
|
0
|
|
1065
|
|
|
|
|
|
|
|
1066
|
0
|
|
|
|
|
0
|
bless $ret, JECS; |
1067
|
|
|
|
|
|
|
} |
1068
|
|
|
|
|
|
|
|
1069
|
|
|
|
|
|
|
sub labelled() { |
1070
|
16
|
|
|
16
|
0
|
18
|
my $pos = pos; |
1071
|
16
|
50
|
|
|
|
119
|
/\G ($ident) $s : $s/cgx or return; |
1072
|
0
|
|
|
|
|
0
|
my $ret = [[$pos], 'labelled', unescape_ident $1]; |
1073
|
|
|
|
|
|
|
|
1074
|
0
|
|
|
|
|
0
|
while (/\G($ident)$s:$s/cg) { |
1075
|
0
|
|
|
|
|
0
|
push @$ret, unescape_ident $1; |
1076
|
|
|
|
|
|
|
} |
1077
|
0
|
0
|
|
|
|
0
|
@$ret != push @$ret, &statement |
1078
|
|
|
|
|
|
|
or expected 'statement'; |
1079
|
|
|
|
|
|
|
|
1080
|
0
|
|
|
|
|
0
|
push @{$$ret[0]},pos; |
|
0
|
|
|
|
|
0
|
|
1081
|
|
|
|
|
|
|
|
1082
|
0
|
|
|
|
|
0
|
bless $ret, JECS; |
1083
|
|
|
|
|
|
|
} |
1084
|
|
|
|
|
|
|
|
1085
|
|
|
|
|
|
|
sub var() { |
1086
|
16
|
|
|
16
|
0
|
16
|
my $pos = pos; |
1087
|
16
|
50
|
|
|
|
92
|
/\G var $S/cgx or return; |
1088
|
0
|
|
|
|
|
0
|
my $ret = [[$pos], 'var']; |
1089
|
|
|
|
|
|
|
|
1090
|
0
|
|
|
|
|
0
|
do{ |
1091
|
0
|
|
|
|
|
0
|
push @$ret, &vardecl; |
1092
|
|
|
|
|
|
|
} while(/\G$s,$s/gc); |
1093
|
|
|
|
|
|
|
|
1094
|
0
|
|
|
|
|
0
|
optional_sc; |
1095
|
|
|
|
|
|
|
|
1096
|
0
|
|
|
|
|
0
|
push @{$$ret[0]},pos; |
|
0
|
|
|
|
|
0
|
|
1097
|
|
|
|
|
|
|
|
1098
|
0
|
|
|
|
|
0
|
bless $ret, JECS; |
1099
|
|
|
|
|
|
|
} |
1100
|
|
|
|
|
|
|
|
1101
|
|
|
|
|
|
|
sub do() { |
1102
|
0
|
|
|
0
|
0
|
0
|
my $pos = pos; |
1103
|
0
|
0
|
|
|
|
0
|
/\G do(?!$id_cont)$s/cgx or return; |
1104
|
0
|
|
|
|
|
0
|
my $ret = [[$pos], 'do']; |
1105
|
|
|
|
|
|
|
|
1106
|
0
|
0
|
|
|
|
0
|
@$ret != push @$ret, &statement |
1107
|
|
|
|
|
|
|
or expected 'statement'; |
1108
|
0
|
0
|
|
|
|
0
|
/\Gwhile$s/cg or expected "'while'"; |
1109
|
0
|
0
|
|
|
|
0
|
/\G\($s/cg or expected "'('"; |
1110
|
0
|
0
|
|
|
|
0
|
@$ret != push @$ret, &expr |
1111
|
|
|
|
|
|
|
or expected 'expression'; |
1112
|
0
|
|
|
|
|
0
|
&skip; |
1113
|
0
|
0
|
|
|
|
0
|
/\G\)/cog or expected "')'"; |
1114
|
|
|
|
|
|
|
|
1115
|
0
|
|
|
|
|
0
|
optional_sc; |
1116
|
|
|
|
|
|
|
|
1117
|
0
|
|
|
|
|
0
|
push @{$$ret[0]},pos; |
|
0
|
|
|
|
|
0
|
|
1118
|
|
|
|
|
|
|
|
1119
|
0
|
|
|
|
|
0
|
bless $ret, JECS; |
1120
|
|
|
|
|
|
|
} |
1121
|
|
|
|
|
|
|
|
1122
|
|
|
|
|
|
|
sub continue() { |
1123
|
16
|
|
|
16
|
0
|
22
|
my $pos = pos; |
1124
|
16
|
50
|
|
|
|
70
|
/\G continue(?!$id_cont)/cogx or return; |
1125
|
0
|
|
|
|
|
0
|
my $ret = [[$pos], 'continue']; |
1126
|
|
|
|
|
|
|
|
1127
|
0
|
0
|
|
|
|
0
|
/\G$h($ident)/cog |
1128
|
|
|
|
|
|
|
and push @$ret, unescape_ident $1; |
1129
|
|
|
|
|
|
|
|
1130
|
0
|
|
|
|
|
0
|
optional_sc; |
1131
|
|
|
|
|
|
|
|
1132
|
0
|
|
|
|
|
0
|
push @{$$ret[0]},pos; |
|
0
|
|
|
|
|
0
|
|
1133
|
|
|
|
|
|
|
|
1134
|
0
|
|
|
|
|
0
|
bless $ret, JECS; |
1135
|
|
|
|
|
|
|
} |
1136
|
|
|
|
|
|
|
|
1137
|
|
|
|
|
|
|
sub break() { # almost identical to continue |
1138
|
16
|
|
|
16
|
0
|
20
|
my $pos = pos; |
1139
|
16
|
50
|
|
|
|
63
|
/\G break(?!$id_cont)/cogx or return; |
1140
|
0
|
|
|
|
|
0
|
my $ret = [[$pos], 'break']; |
1141
|
|
|
|
|
|
|
|
1142
|
0
|
0
|
|
|
|
0
|
/\G$h($ident)/cog |
1143
|
|
|
|
|
|
|
and push @$ret, unescape_ident $1; |
1144
|
|
|
|
|
|
|
|
1145
|
0
|
|
|
|
|
0
|
optional_sc; |
1146
|
|
|
|
|
|
|
|
1147
|
0
|
|
|
|
|
0
|
push @{$$ret[0]},pos; |
|
0
|
|
|
|
|
0
|
|
1148
|
|
|
|
|
|
|
|
1149
|
0
|
|
|
|
|
0
|
bless $ret, JECS; |
1150
|
|
|
|
|
|
|
} |
1151
|
|
|
|
|
|
|
|
1152
|
|
|
|
|
|
|
sub return() { |
1153
|
16
|
|
|
16
|
0
|
18
|
my $pos = pos; |
1154
|
16
|
50
|
|
|
|
58
|
/\G return(?!$id_cont)/cogx or return; |
1155
|
0
|
|
|
|
|
0
|
my $ret = [[$pos], 'return']; |
1156
|
|
|
|
|
|
|
|
1157
|
0
|
|
|
|
|
0
|
$pos = pos; |
1158
|
0
|
|
|
|
|
0
|
/\G$h/g; # skip horz ws |
1159
|
0
|
0
|
|
|
|
0
|
@$ret == push @$ret, &expr and pos = $pos; |
1160
|
|
|
|
|
|
|
# reverse to before the white space if |
1161
|
|
|
|
|
|
|
# there is no expr |
1162
|
|
|
|
|
|
|
|
1163
|
0
|
|
|
|
|
0
|
optional_sc; |
1164
|
|
|
|
|
|
|
|
1165
|
0
|
|
|
|
|
0
|
push @{$$ret[0]},pos; |
|
0
|
|
|
|
|
0
|
|
1166
|
|
|
|
|
|
|
|
1167
|
0
|
|
|
|
|
0
|
bless $ret, JECS; |
1168
|
|
|
|
|
|
|
} |
1169
|
|
|
|
|
|
|
|
1170
|
|
|
|
|
|
|
sub throw() { |
1171
|
16
|
|
|
16
|
0
|
14
|
my $pos = pos; |
1172
|
16
|
50
|
|
|
|
56
|
/\G throw(?!$id_cont)/cogx |
1173
|
|
|
|
|
|
|
or return; |
1174
|
0
|
|
|
|
|
0
|
my $ret = [[$pos], 'throw']; |
1175
|
|
|
|
|
|
|
|
1176
|
0
|
|
|
|
|
0
|
/\G$h/g; # skip horz ws |
1177
|
0
|
0
|
|
|
|
0
|
@$ret == push @$ret, &expr and expected 'expression'; |
1178
|
|
|
|
|
|
|
|
1179
|
0
|
|
|
|
|
0
|
optional_sc; |
1180
|
|
|
|
|
|
|
|
1181
|
0
|
|
|
|
|
0
|
push @{$$ret[0]},pos; |
|
0
|
|
|
|
|
0
|
|
1182
|
|
|
|
|
|
|
|
1183
|
0
|
|
|
|
|
0
|
bless $ret, JECS; |
1184
|
|
|
|
|
|
|
} |
1185
|
|
|
|
|
|
|
|
1186
|
|
|
|
|
|
|
sub expr_statement() { |
1187
|
16
|
100
|
|
16
|
0
|
20
|
my $ret = &expr or return; |
1188
|
9
|
|
|
|
|
15
|
optional_sc; # the only difference in behaviour between |
1189
|
|
|
|
|
|
|
# this and &expr |
1190
|
5
|
|
|
|
|
16
|
$ret; |
1191
|
|
|
|
|
|
|
} |
1192
|
|
|
|
|
|
|
|
1193
|
|
|
|
|
|
|
|
1194
|
|
|
|
|
|
|
|
1195
|
|
|
|
|
|
|
# -------- end of statement types----------# |
1196
|
|
|
|
|
|
|
|
1197
|
|
|
|
|
|
|
# This takes care of trailing white space. |
1198
|
|
|
|
|
|
|
sub statement_default() { |
1199
|
10949
|
|
|
10949
|
0
|
19626
|
my $ret = [[pos]]; |
1200
|
|
|
|
|
|
|
|
1201
|
|
|
|
|
|
|
# Statements that do not have an optional semicolon |
1202
|
10949
|
100
|
|
|
|
106306
|
if (/\G (?: |
1203
|
|
|
|
|
|
|
( \{ | ; ) |
1204
|
|
|
|
|
|
|
| |
1205
|
|
|
|
|
|
|
(function)$S |
1206
|
|
|
|
|
|
|
| |
1207
|
|
|
|
|
|
|
( if | w(?:hile|ith) | for | switch ) $s \( $s |
1208
|
|
|
|
|
|
|
| |
1209
|
|
|
|
|
|
|
( try $s \{ $s ) |
1210
|
|
|
|
|
|
|
| |
1211
|
|
|
|
|
|
|
($ident) $s : $s |
1212
|
|
|
|
|
|
|
) /xgc) { |
1213
|
101
|
|
|
101
|
|
705087
|
no warnings 'uninitialized'; |
|
101
|
|
|
|
|
217
|
|
|
101
|
|
|
|
|
198445
|
|
1214
|
1222
|
100
|
|
|
|
24527
|
if($1 eq '{') { |
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
1215
|
166
|
|
|
|
|
298
|
push @$ret, 'statements'; |
1216
|
166
|
|
|
|
|
279
|
&skip; |
1217
|
166
|
|
|
|
|
483
|
while() { # 'last' does not work when 'while' is a |
1218
|
|
|
|
|
|
|
# statement modifier |
1219
|
509
|
100
|
|
|
|
1121
|
@$ret == push @$ret, |
1220
|
|
|
|
|
|
|
&statement_default and last; |
1221
|
|
|
|
|
|
|
} |
1222
|
|
|
|
|
|
|
|
1223
|
165
|
50
|
|
|
|
1859
|
expected "'}'" unless /\G\}$s/gc; |
1224
|
|
|
|
|
|
|
} |
1225
|
|
|
|
|
|
|
elsif($1 eq ';') { |
1226
|
156
|
|
|
|
|
251
|
push @$ret, 'empty'; |
1227
|
156
|
|
|
|
|
250
|
&skip; |
1228
|
|
|
|
|
|
|
} |
1229
|
|
|
|
|
|
|
elsif($2) { |
1230
|
34
|
|
|
|
|
48
|
push @$ret, 'function'; |
1231
|
34
|
50
|
|
|
|
55
|
@$ret == push @$ret, &ident |
1232
|
|
|
|
|
|
|
and expected "identifier"; |
1233
|
34
|
|
|
|
|
45
|
&skip; |
1234
|
34
|
|
|
|
|
50
|
push @$ret, ¶ms; |
1235
|
34
|
|
|
|
|
47
|
&skip; |
1236
|
34
|
50
|
|
|
|
79
|
/\G \{ /gcx or expected "'{'"; |
1237
|
|
|
|
|
|
|
{ |
1238
|
34
|
|
|
|
|
30
|
local $_vars = []; |
|
34
|
|
|
|
|
47
|
|
1239
|
34
|
|
|
|
|
64
|
push @$ret, &statements, $_vars; |
1240
|
|
|
|
|
|
|
} |
1241
|
34
|
50
|
|
|
|
245
|
/\G \}$s /gcx or expected "'}'"; |
1242
|
34
|
|
|
|
|
600
|
push @$_vars, $ret; |
1243
|
|
|
|
|
|
|
} |
1244
|
|
|
|
|
|
|
elsif($3 eq 'if') { |
1245
|
84
|
|
|
|
|
165
|
push @$ret, 'if'; |
1246
|
84
|
50
|
|
|
|
197
|
@$ret == push @$ret, &expr |
1247
|
|
|
|
|
|
|
and expected 'expression'; |
1248
|
84
|
|
|
|
|
147
|
&skip; |
1249
|
84
|
50
|
|
|
|
837
|
/\G\)$s/gc or expected "')'"; |
1250
|
84
|
50
|
|
|
|
2223
|
@$ret != push @$ret, &statement_default |
1251
|
|
|
|
|
|
|
or expected 'statement'; |
1252
|
84
|
100
|
|
|
|
735
|
if (/\Gelse(?!$id_cont)$s/cg) { |
1253
|
29
|
50
|
|
|
|
702
|
@$ret == push @$ret, |
1254
|
|
|
|
|
|
|
&statement_default |
1255
|
|
|
|
|
|
|
and expected 'statement'; |
1256
|
|
|
|
|
|
|
} |
1257
|
|
|
|
|
|
|
} |
1258
|
|
|
|
|
|
|
elsif($3 eq 'while') { |
1259
|
22
|
|
|
|
|
40
|
push @$ret, 'while'; |
1260
|
22
|
50
|
|
|
|
43
|
@$ret == push @$ret, &expr |
1261
|
|
|
|
|
|
|
and expected 'expression'; |
1262
|
22
|
|
|
|
|
46
|
&skip; |
1263
|
22
|
50
|
|
|
|
376
|
/\G\)$s/gc or expected "')'"; |
1264
|
22
|
50
|
|
|
|
922
|
@$ret != push @$ret, &statement_default |
1265
|
|
|
|
|
|
|
or expected 'statement'; |
1266
|
|
|
|
|
|
|
} |
1267
|
|
|
|
|
|
|
elsif($3 eq 'for') { |
1268
|
355
|
|
|
|
|
618
|
push @$ret, 'for'; |
1269
|
355
|
100
|
|
|
|
2577
|
if (/\G var$S/cgx) { |
|
|
100
|
|
|
|
|
|
1270
|
118
|
|
|
|
|
3893
|
push @$ret, my $var = bless |
1271
|
|
|
|
|
|
|
[[pos() - length $1], 'var'], |
1272
|
|
|
|
|
|
|
'JE::Code::Statement'; |
1273
|
|
|
|
|
|
|
|
1274
|
118
|
|
|
|
|
241
|
push @$var, &vardecl_noin; |
1275
|
118
|
|
|
|
|
190
|
&skip; |
1276
|
118
|
100
|
|
|
|
809
|
if (/\G([;,])$s/gc) { |
1277
|
|
|
|
|
|
|
# if there's a comma or sc then |
1278
|
|
|
|
|
|
|
# this is a for(;;) loop |
1279
|
85
|
100
|
|
|
|
1431
|
if ($1 eq ',') { |
1280
|
|
|
|
|
|
|
# finish getting the var |
1281
|
|
|
|
|
|
|
# decl list |
1282
|
34
|
|
|
|
|
32
|
do{ |
1283
|
34
|
50
|
|
|
|
55
|
@$var == |
1284
|
|
|
|
|
|
|
push @$var, &vardecl |
1285
|
|
|
|
|
|
|
and expected |
1286
|
|
|
|
|
|
|
'identifier' |
1287
|
|
|
|
|
|
|
} while (/\G$s,$s/gc); |
1288
|
34
|
|
|
|
|
668
|
&skip; |
1289
|
34
|
50
|
|
|
|
172
|
/\G;$s/cg |
1290
|
|
|
|
|
|
|
or expected 'semicolon'; |
1291
|
|
|
|
|
|
|
} |
1292
|
85
|
|
|
|
|
516
|
push @$ret, &finish_for_sc_sc; |
1293
|
|
|
|
|
|
|
} |
1294
|
|
|
|
|
|
|
else { |
1295
|
33
|
50
|
|
|
|
1262
|
/\Gin$s/cg or expected |
1296
|
|
|
|
|
|
|
"'in', comma or semicolon"; |
1297
|
33
|
|
|
|
|
1540
|
push @$ret, 'in'; |
1298
|
33
|
50
|
|
|
|
88
|
@$ret == push @$ret, &expr |
1299
|
|
|
|
|
|
|
and expected 'expresssion'; |
1300
|
33
|
|
|
|
|
75
|
&skip; |
1301
|
33
|
50
|
|
|
|
311
|
/\G\)$s/cg or expected "')'"; |
1302
|
|
|
|
|
|
|
} |
1303
|
|
|
|
|
|
|
} |
1304
|
|
|
|
|
|
|
elsif(@$ret != push @$ret, &expr_noin) { |
1305
|
224
|
|
|
|
|
361
|
&skip; |
1306
|
224
|
100
|
|
|
|
2132
|
if (/\G;$s/gc) { |
1307
|
|
|
|
|
|
|
# if there's a semicolon then |
1308
|
|
|
|
|
|
|
# this is a for(;;) loop |
1309
|
203
|
|
|
|
|
1993
|
push @$ret, &finish_for_sc_sc; |
1310
|
|
|
|
|
|
|
} |
1311
|
|
|
|
|
|
|
else { |
1312
|
21
|
50
|
|
|
|
1374
|
/\Gin$s/cg or expected |
1313
|
|
|
|
|
|
|
"'in' or semicolon"; |
1314
|
21
|
|
|
|
|
1414
|
push @$ret, 'in'; |
1315
|
21
|
50
|
|
|
|
58
|
@$ret == push @$ret, &expr |
1316
|
|
|
|
|
|
|
and expected 'expresssion'; |
1317
|
21
|
|
|
|
|
43
|
&skip; |
1318
|
21
|
50
|
|
|
|
217
|
/\G\)$s/cg or expected "')'"; |
1319
|
|
|
|
|
|
|
} |
1320
|
|
|
|
|
|
|
} |
1321
|
|
|
|
|
|
|
else { |
1322
|
13
|
|
|
|
|
20
|
push @$ret, 'empty'; |
1323
|
13
|
50
|
|
|
|
95
|
/\G;$s/cg |
1324
|
|
|
|
|
|
|
or expected 'expression or semicolon'; |
1325
|
13
|
|
|
|
|
187
|
push @$ret, &finish_for_sc_sc; |
1326
|
|
|
|
|
|
|
} |
1327
|
|
|
|
|
|
|
|
1328
|
|
|
|
|
|
|
# body of the for loop |
1329
|
355
|
50
|
|
|
|
3828
|
@$ret != push @$ret, &statement_default |
1330
|
|
|
|
|
|
|
or expected 'statement'; |
1331
|
|
|
|
|
|
|
} |
1332
|
|
|
|
|
|
|
elsif($3 eq 'with') { |
1333
|
18
|
|
|
|
|
38
|
push @$ret, 'with'; |
1334
|
18
|
50
|
|
|
|
57
|
@$ret == push @$ret, &expr |
1335
|
|
|
|
|
|
|
and expected 'expression'; |
1336
|
18
|
|
|
|
|
43
|
&skip; |
1337
|
18
|
50
|
|
|
|
446
|
/\G\)$s/gc or expected "')'"; |
1338
|
18
|
50
|
|
|
|
1138
|
@$ret != push @$ret, &statement_default |
1339
|
|
|
|
|
|
|
or expected 'statement'; |
1340
|
|
|
|
|
|
|
} |
1341
|
|
|
|
|
|
|
elsif($3 eq 'switch') { |
1342
|
33
|
|
|
|
|
58
|
push @$ret, 'switch'; |
1343
|
33
|
50
|
|
|
|
60
|
@$ret == push @$ret, &expr |
1344
|
|
|
|
|
|
|
and expected 'expression'; |
1345
|
33
|
|
|
|
|
59
|
&skip; |
1346
|
33
|
50
|
|
|
|
399
|
/\G\)$s/gc or expected "')'"; |
1347
|
33
|
50
|
|
|
|
719
|
/\G\{$s/gc or expected "'{'"; |
1348
|
|
|
|
|
|
|
|
1349
|
33
|
|
|
|
|
622
|
while (/\G case(?!$id_cont) $s/cgx) { |
1350
|
31
|
50
|
|
|
|
273
|
@$ret == push @$ret, &expr |
1351
|
|
|
|
|
|
|
and expected 'expression'; |
1352
|
31
|
|
|
|
|
46
|
&skip; |
1353
|
31
|
50
|
|
|
|
195
|
/\G:$s/cg or expected 'colon'; |
1354
|
31
|
|
|
|
|
525
|
push @$ret, &statements; |
1355
|
|
|
|
|
|
|
} |
1356
|
33
|
|
|
|
|
433
|
my $default=0; |
1357
|
33
|
100
|
|
|
|
220
|
if (/\G default(?!$id_cont) $s/cgx) { |
1358
|
20
|
50
|
|
|
|
389
|
/\G : $s /cgx or expected 'colon'; |
1359
|
20
|
|
|
|
|
484
|
push @$ret, default => &statements; |
1360
|
20
|
|
|
|
|
27
|
++$default; |
1361
|
|
|
|
|
|
|
} |
1362
|
33
|
|
|
|
|
603
|
while (/\G case(?!$id_cont) $s/cgx) { |
1363
|
19
|
50
|
|
|
|
257
|
@$ret == push @$ret, &expr |
1364
|
|
|
|
|
|
|
and expected 'expression'; |
1365
|
19
|
|
|
|
|
36
|
&skip; |
1366
|
19
|
50
|
|
|
|
145
|
/\G:$s/cg or expected 'colon'; |
1367
|
19
|
|
|
|
|
537
|
push @$ret, &statements; |
1368
|
|
|
|
|
|
|
} |
1369
|
33
|
0
|
|
|
|
664
|
/\G \} $s /cgx or expected ( |
|
|
50
|
|
|
|
|
|
1370
|
|
|
|
|
|
|
$default |
1371
|
|
|
|
|
|
|
? "'}' or 'case'" |
1372
|
|
|
|
|
|
|
: "'}', 'case' or 'default'" |
1373
|
|
|
|
|
|
|
); |
1374
|
|
|
|
|
|
|
} |
1375
|
|
|
|
|
|
|
elsif($4) { # try |
1376
|
316
|
|
|
|
|
703
|
push @$ret, 'try', &statements; |
1377
|
316
|
50
|
|
|
|
3031
|
/\G \} $s /cgx or expected "'}'"; |
1378
|
|
|
|
|
|
|
|
1379
|
316
|
|
|
|
|
6651
|
my $pos = pos; |
1380
|
|
|
|
|
|
|
|
1381
|
316
|
100
|
|
|
|
2017
|
if(/\Gcatch$s/cg) { |
1382
|
314
|
50
|
|
|
|
7251
|
/\G \( $s /cgx or expected "'('"; |
1383
|
314
|
50
|
|
|
|
6204
|
@$ret == push @$ret, &ident |
1384
|
|
|
|
|
|
|
and expected 'identifier'; |
1385
|
314
|
|
|
|
|
595
|
&skip; |
1386
|
314
|
50
|
|
|
|
2501
|
/\G \) $s /cgx or expected "')'"; |
1387
|
|
|
|
|
|
|
|
1388
|
314
|
50
|
|
|
|
7595
|
/\G \{ $s /cgx or expected "'{'"; |
1389
|
314
|
|
|
|
|
5953
|
push @$ret, &statements; |
1390
|
314
|
50
|
|
|
|
2931
|
/\G \} $s /cgx or expected "'}'"; |
1391
|
|
|
|
|
|
|
} |
1392
|
316
|
100
|
|
|
|
7615
|
if(/\Gfinally$s/cg) { |
1393
|
7
|
50
|
|
|
|
263
|
/\G \{ $s /cgx or expected "'{'"; |
1394
|
7
|
|
|
|
|
507
|
push @$ret, &statements; |
1395
|
7
|
50
|
|
|
|
79
|
/\G \} $s /cgx or expected "'}'"; |
1396
|
|
|
|
|
|
|
} |
1397
|
|
|
|
|
|
|
|
1398
|
316
|
50
|
|
|
|
7036
|
pos eq $pos and expected "'catch' or 'finally'"; |
1399
|
|
|
|
|
|
|
} |
1400
|
|
|
|
|
|
|
else { # labelled statement |
1401
|
38
|
|
|
|
|
89
|
push @$ret, 'labelled', unescape_ident $5; |
1402
|
38
|
|
|
|
|
527
|
while (/\G($ident)$s:$s/cg) { |
1403
|
21
|
|
|
|
|
1187
|
push @$ret, unescape_ident $1; |
1404
|
|
|
|
|
|
|
} |
1405
|
38
|
50
|
|
|
|
2735
|
@$ret != push @$ret, &statement_default |
1406
|
|
|
|
|
|
|
or expected 'statement'; |
1407
|
|
|
|
|
|
|
} |
1408
|
|
|
|
|
|
|
} |
1409
|
|
|
|
|
|
|
# Statements that do have an optional semicolon |
1410
|
|
|
|
|
|
|
else { |
1411
|
9727
|
100
|
|
|
|
222381
|
if (/\G var$S/xcg) { |
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
1412
|
339
|
|
|
|
|
4471
|
push @$ret, 'var'; |
1413
|
|
|
|
|
|
|
|
1414
|
339
|
|
|
|
|
402
|
do{ |
1415
|
351
|
|
|
|
|
1237
|
push @$ret, &vardecl; |
1416
|
|
|
|
|
|
|
} while(/\G$s,$s/gc); |
1417
|
|
|
|
|
|
|
} |
1418
|
|
|
|
|
|
|
elsif(/\Gdo(?!$id_cont)$s/cg) { |
1419
|
25
|
|
|
|
|
267
|
push @$ret, 'do'; |
1420
|
25
|
50
|
|
|
|
71
|
@$ret != push @$ret, &statement_default |
1421
|
|
|
|
|
|
|
or expected 'statement'; |
1422
|
25
|
50
|
|
|
|
211
|
/\Gwhile$s/cg or expected "'while'"; |
1423
|
25
|
50
|
|
|
|
790
|
/\G\($s/cg or expected "'('"; |
1424
|
25
|
50
|
|
|
|
614
|
@$ret != push @$ret, &expr |
1425
|
|
|
|
|
|
|
or expected 'expression'; |
1426
|
25
|
|
|
|
|
54
|
&skip; |
1427
|
25
|
50
|
|
|
|
265
|
/\G\)/cog or expected "')'"; |
1428
|
|
|
|
|
|
|
} |
1429
|
|
|
|
|
|
|
elsif(/\G(continue|break)(?!$id_cont)/cog) { |
1430
|
109
|
|
|
|
|
1292
|
push @$ret, $1; |
1431
|
109
|
100
|
|
|
|
680
|
/\G$h($ident)/cog |
1432
|
|
|
|
|
|
|
and push @$ret, unescape_ident $1; |
1433
|
|
|
|
|
|
|
} |
1434
|
|
|
|
|
|
|
elsif(/\Greturn(?!$id_cont)/cog) { |
1435
|
135
|
|
|
|
|
965
|
push @$ret, 'return'; |
1436
|
135
|
|
|
|
|
224
|
my $pos = pos; |
1437
|
135
|
|
|
|
|
1279
|
/\G$h/g; # skip horz ws |
1438
|
135
|
100
|
|
|
|
5251
|
@$ret == push @$ret, &expr and pos = $pos; |
1439
|
|
|
|
|
|
|
# reverse to before the white space if |
1440
|
|
|
|
|
|
|
# there is no expr |
1441
|
|
|
|
|
|
|
} |
1442
|
|
|
|
|
|
|
elsif(/\Gthrow(?!$id_cont)/cog) { |
1443
|
23
|
|
|
|
|
46
|
push @$ret, 'throw'; |
1444
|
23
|
|
|
|
|
276
|
/\G$h/g; # skip horz ws |
1445
|
23
|
100
|
|
|
|
1343
|
@$ret == push @$ret, &expr |
1446
|
|
|
|
|
|
|
and expected 'expression'; |
1447
|
|
|
|
|
|
|
} |
1448
|
|
|
|
|
|
|
else { # expression statement |
1449
|
9096
|
100
|
|
|
|
78235
|
$ret = &expr or return; |
1450
|
|
|
|
|
|
|
} |
1451
|
|
|
|
|
|
|
|
1452
|
|
|
|
|
|
|
# Check for optional semicolon |
1453
|
8189
|
100
|
|
|
|
87598
|
m-$optional_sc-cgx |
1454
|
|
|
|
|
|
|
or expected "semicolon, '}' or end of line"; |
1455
|
|
|
|
|
|
|
} |
1456
|
9407
|
100
|
|
|
|
17539
|
push @{$$ret[0]},pos unless @{$$ret[0]} == 2; # an expr will |
|
1851
|
|
|
|
|
3358
|
|
|
9407
|
|
|
|
|
20129
|
|
1457
|
|
|
|
|
|
|
# already have this |
1458
|
|
|
|
|
|
|
|
1459
|
9407
|
100
|
|
|
|
22968
|
ref $ret eq 'ARRAY' and bless $ret, 'JE::Code::Statement'; |
1460
|
|
|
|
|
|
|
|
1461
|
9407
|
|
|
|
|
27119
|
return $ret; |
1462
|
|
|
|
|
|
|
} |
1463
|
|
|
|
|
|
|
|
1464
|
|
|
|
|
|
|
sub statement() { # public |
1465
|
16
|
|
|
16
|
0
|
23
|
my $ret; |
1466
|
16
|
|
|
|
|
19
|
for my $sub(@_stms) { |
1467
|
208
|
100
|
|
|
|
3344
|
defined($ret = &$sub) |
1468
|
|
|
|
|
|
|
and last; |
1469
|
|
|
|
|
|
|
} |
1470
|
10
|
100
|
|
|
|
32
|
defined $ret ? $ret : () |
1471
|
|
|
|
|
|
|
} |
1472
|
|
|
|
|
|
|
|
1473
|
|
|
|
|
|
|
# This takes care of leading white space. |
1474
|
|
|
|
|
|
|
sub statements() { |
1475
|
1036
|
|
|
1036
|
0
|
4255
|
my $ret = bless [[pos], 'statements'], 'JE::Code::Statement'; |
1476
|
1036
|
|
|
|
|
7350
|
/\G$s/g; # skip initial whitespace |
1477
|
1036
|
|
|
|
|
9011
|
while () { # 'last' does not work when 'while' is a |
1478
|
|
|
|
|
|
|
# statement modifier |
1479
|
2937
|
50
|
|
|
|
7741
|
@$ret != push @$ret, |
|
|
100
|
|
|
|
|
|
1480
|
|
|
|
|
|
|
$_parser ? &statement : &statement_default |
1481
|
|
|
|
|
|
|
or last; |
1482
|
|
|
|
|
|
|
} |
1483
|
1036
|
|
|
|
|
1695
|
push @{$$ret[0]},pos; |
|
1036
|
|
|
|
|
2635
|
|
1484
|
1036
|
|
|
|
|
2741
|
return $ret; |
1485
|
|
|
|
|
|
|
} |
1486
|
|
|
|
|
|
|
|
1487
|
|
|
|
|
|
|
sub program() { # like statements(), but it allows function declarations |
1488
|
|
|
|
|
|
|
# as well |
1489
|
351
|
|
|
351
|
0
|
1721
|
my $ret = bless [[pos], 'statements'], 'JE::Code::Statement'; |
1490
|
351
|
|
|
|
|
5363
|
/\G$s/g; # skip initial whitespace |
1491
|
351
|
100
|
|
|
|
21457
|
if($_parser) { |
1492
|
11
|
|
|
|
|
12
|
while () { |
1493
|
|
|
|
|
|
|
DECL: { |
1494
|
16
|
|
|
|
|
18
|
for my $sub(@_decls) { |
|
16
|
|
|
|
|
28
|
|
1495
|
0
|
0
|
|
|
|
0
|
@$ret != push @$ret, &$sub |
1496
|
|
|
|
|
|
|
and redo DECL; |
1497
|
|
|
|
|
|
|
} |
1498
|
|
|
|
|
|
|
} |
1499
|
16
|
100
|
|
|
|
32
|
@$ret != push @$ret, &statement or last; |
1500
|
|
|
|
|
|
|
} |
1501
|
|
|
|
|
|
|
} |
1502
|
|
|
|
|
|
|
else { |
1503
|
340
|
|
|
|
|
455
|
while () { |
1504
|
6932
|
|
|
|
|
6602
|
while() { |
1505
|
7064
|
100
|
|
|
|
13319
|
@$ret == push @$ret, &function and last; |
1506
|
|
|
|
|
|
|
} |
1507
|
6932
|
100
|
|
|
|
26412
|
@$ret != push @$ret, &statement_default or last; |
1508
|
|
|
|
|
|
|
} |
1509
|
|
|
|
|
|
|
} |
1510
|
330
|
|
|
|
|
688
|
push @{$$ret[0]},pos; |
|
330
|
|
|
|
|
883
|
|
1511
|
330
|
|
|
|
|
901
|
return $ret; |
1512
|
|
|
|
|
|
|
} |
1513
|
|
|
|
|
|
|
|
1514
|
|
|
|
|
|
|
|
1515
|
|
|
|
|
|
|
# ~~~ The second arg to add_line_number is a bit ridiculous. I may change |
1516
|
|
|
|
|
|
|
# add_line_number's parameter list, perhaps so it accepts either a |
1517
|
|
|
|
|
|
|
# code object, or (src,file,line) if $_[1] isn'ta JE::Code. I don't |
1518
|
|
|
|
|
|
|
# know.... |
1519
|
|
|
|
|
|
|
sub _parse($$$;$$) { # Returns just the parse tree, not a JE::Code object. |
1520
|
|
|
|
|
|
|
# Actually, it returns the source followed by the |
1521
|
|
|
|
|
|
|
# parse tree in list context, or just the parse tree |
1522
|
|
|
|
|
|
|
# in scalar context. |
1523
|
386
|
|
|
386
|
|
723
|
my ($rule, $src, $my_global, $file, $line) = @_; |
1524
|
386
|
|
|
|
|
842
|
local our($_source, $_file, $_line) =($src,$file,$line); |
1525
|
|
|
|
|
|
|
|
1526
|
|
|
|
|
|
|
# Note: We *hafta* stringify the $src, because it could be an |
1527
|
|
|
|
|
|
|
# object with overloading (e.g., JE::String) and we |
1528
|
|
|
|
|
|
|
# need to rely on its pos(), which simply cannot be |
1529
|
|
|
|
|
|
|
# done with an object. Furthermore, perl5.8.5 is |
1530
|
|
|
|
|
|
|
# a bit buggy and sometimes mangles the contents |
1531
|
|
|
|
|
|
|
# of $1 when one does $obj =~ /(...)/. |
1532
|
386
|
100
|
100
|
|
|
4559
|
$src = defined blessed $src && $src->isa("JE::String") |
1533
|
|
|
|
|
|
|
? $src->value16 |
1534
|
|
|
|
|
|
|
: surrogify("$src"); |
1535
|
|
|
|
|
|
|
|
1536
|
|
|
|
|
|
|
# remove unicode format chrs |
1537
|
386
|
|
|
|
|
52986
|
$src =~ s/\p{Cf}//g; |
1538
|
|
|
|
|
|
|
|
1539
|
|
|
|
|
|
|
# In HTML mode, modify the whitespace regexps to remove HTML com- |
1540
|
|
|
|
|
|
|
# ment delimiters and following junk up to the end of the line. |
1541
|
386
|
100
|
|
|
|
1210
|
$my_global->html_mode and |
1542
|
|
|
|
|
|
|
local $s = qr((?> |
1543
|
|
|
|
|
|
|
(?> [ \t\x0b\f\xa0\p{Zs}]* ) |
1544
|
|
|
|
|
|
|
(?> (?> |
1545
|
|
|
|
|
|
|
$n |
1546
|
|
|
|
|
|
|
(?>(?: |
1547
|
|
|
|
|
|
|
(?>[ \t\x0b\f\xa0\p{Zs}]*) --> |
1548
|
|
|
|
|
|
|
(?>[^\cm\cj\x{2028}\x{2029}]*)(?>$n|\z) |
1549
|
|
|
|
|
|
|
)?) |
1550
|
|
|
|
|
|
|
| |
1551
|
|
|
|
|
|
|
^ |
1552
|
|
|
|
|
|
|
(?>[ \t\x0b\f\xa0\p{Zs}]*) --> |
1553
|
|
|
|
|
|
|
(?>[^\cm\cj\x{2028}\x{2029}]*)(?>$n|\z) |
1554
|
|
|
|
|
|
|
| |
1555
|
|
|
|
|
|
|
(?>//| |