line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
# |
2
|
|
|
|
|
|
|
# parse PHP source files |
3
|
|
|
|
|
|
|
# |
4
|
|
|
|
|
|
|
package PHP::Decode::Parser; |
5
|
6
|
|
|
6
|
|
142801
|
use base 'PHP::Decode::Tokenizer'; |
|
6
|
|
|
|
|
42
|
|
|
6
|
|
|
|
|
2991
|
|
6
|
|
|
|
|
|
|
|
7
|
6
|
|
|
6
|
|
46
|
use strict; |
|
6
|
|
|
|
|
12
|
|
|
6
|
|
|
|
|
136
|
|
8
|
6
|
|
|
6
|
|
31
|
use warnings; |
|
6
|
|
|
|
|
11
|
|
|
6
|
|
|
|
|
159
|
|
9
|
6
|
|
|
6
|
|
31
|
use Carp 'croak'; |
|
6
|
|
|
|
|
32
|
|
|
6
|
|
|
|
|
319
|
|
10
|
6
|
|
|
6
|
|
33
|
use Config; |
|
6
|
|
|
|
|
12
|
|
|
6
|
|
|
|
|
272
|
|
11
|
6
|
|
|
6
|
|
1695
|
use PHP::Decode::Array qw(is_int_index); |
|
6
|
|
|
|
|
27
|
|
|
6
|
|
|
|
|
301
|
|
12
|
6
|
|
|
6
|
|
38
|
use Exporter qw(import); |
|
6
|
|
|
|
|
12
|
|
|
6
|
|
|
|
|
421
|
|
13
|
|
|
|
|
|
|
our @EXPORT_OK = qw(is_variable is_symbol is_null is_const is_numval is_strval is_array is_block global_var global_split inst_var inst_split method_name method_split ns_name ns_split); |
14
|
|
|
|
|
|
|
our %EXPORT_TAGS = (all => \@EXPORT_OK); |
15
|
|
|
|
|
|
|
|
16
|
|
|
|
|
|
|
our $VERSION = '0.127'; |
17
|
|
|
|
|
|
|
|
18
|
|
|
|
|
|
|
# avoid 'Deep recursion' warnings for depth > 100 |
19
|
|
|
|
|
|
|
# |
20
|
6
|
|
|
6
|
|
35
|
no warnings 'recursion'; |
|
6
|
|
|
|
|
11
|
|
|
6
|
|
|
|
|
29681
|
|
21
|
|
|
|
|
|
|
|
22
|
|
|
|
|
|
|
my $stridx = 1; |
23
|
|
|
|
|
|
|
my $numidx = 1; |
24
|
|
|
|
|
|
|
my $constidx = 1; |
25
|
|
|
|
|
|
|
my $funidx = 1; |
26
|
|
|
|
|
|
|
my $callidx = 1; |
27
|
|
|
|
|
|
|
my $elemidx = 1; |
28
|
|
|
|
|
|
|
my $expridx = 1; |
29
|
|
|
|
|
|
|
my $stmtidx = 1; |
30
|
|
|
|
|
|
|
my $blkidx = 1; |
31
|
|
|
|
|
|
|
my $pfxidx = 1; |
32
|
|
|
|
|
|
|
my $objidx = 1; # obj-> |
33
|
|
|
|
|
|
|
my $scopeidx = 1; # class:: |
34
|
|
|
|
|
|
|
my $refidx = 1; # & $var |
35
|
|
|
|
|
|
|
my $classidx = 1; # class name {} |
36
|
|
|
|
|
|
|
my $instidx = 1; # class instance |
37
|
|
|
|
|
|
|
my $traitidx = 1; # trait name {} |
38
|
|
|
|
|
|
|
my $nsidx = 1; # namespace\ |
39
|
|
|
|
|
|
|
my $fhidx = 1; |
40
|
|
|
|
|
|
|
|
41
|
|
|
|
|
|
|
# Initialize new parser using PHP::Decode::Tokenizer |
42
|
|
|
|
|
|
|
# {inscript} - set to indicate already inside of script |
43
|
|
|
|
|
|
|
# {warn} - warning message handler |
44
|
|
|
|
|
|
|
# {log} - log message handler |
45
|
|
|
|
|
|
|
# {debug} - debug message handler |
46
|
|
|
|
|
|
|
# {filename} - optional filename (if not stdin or textstr) |
47
|
|
|
|
|
|
|
# {max_strlen} - max strlen for debug strings |
48
|
|
|
|
|
|
|
# |
49
|
|
|
|
|
|
|
sub new { |
50
|
795
|
|
|
795
|
1
|
6494
|
my ($class, %args) = @_; |
51
|
795
|
50
|
|
|
|
2432
|
my $strmap = $args{strmap} or croak __PACKAGE__ . " expects strmap"; |
52
|
|
|
|
|
|
|
|
53
|
795
|
|
|
|
|
3088
|
my $self = $class->SUPER::new(%args); |
54
|
795
|
100
|
|
|
|
2402
|
$self->{max_strlen} = 0 unless exists $self->{max_strlen}; |
55
|
795
|
|
|
|
|
1573
|
$self->{tok} = []; # init token list |
56
|
|
|
|
|
|
|
|
57
|
|
|
|
|
|
|
# filename is required to decode __FILE__ |
58
|
795
|
100
|
|
|
|
1841
|
$self->{filename} = '__FILE__' unless exists $self->{filename}; |
59
|
|
|
|
|
|
|
|
60
|
795
|
100
|
|
|
|
2028
|
$strmap->{'__LINE__'} = 1 unless exists $strmap->{'__LINE__'}; |
61
|
795
|
100
|
|
|
|
1946
|
$strmap->{'#null'} = '' unless exists $strmap->{'#null'}; |
62
|
795
|
|
|
|
|
2048
|
return $self; |
63
|
|
|
|
|
|
|
} |
64
|
|
|
|
|
|
|
|
65
|
|
|
|
|
|
|
# A sub parser is always inscript (the parent might have inscript=0) |
66
|
|
|
|
|
|
|
# |
67
|
|
|
|
|
|
|
sub subparser { |
68
|
70
|
|
|
70
|
0
|
163
|
my ($self, %args) = @_; |
69
|
70
|
|
|
|
|
271
|
my $parser = PHP::Decode::Parser->new(strmap => $self->{strmap}, inscript => 1, filename => $self->{filename}, max_strlen => $self->{max_strlen}, warn => $self->{warn}); |
70
|
70
|
50
|
|
|
|
205
|
$parser->{log} = $self->{log} if exists $self->{log}; |
71
|
70
|
50
|
|
|
|
170
|
$parser->{debug} = $self->{debug} if exists $self->{debug}; |
72
|
|
|
|
|
|
|
|
73
|
70
|
|
|
|
|
158
|
foreach my $k (keys %args) { |
74
|
0
|
|
|
|
|
0
|
$parser->{$k} = $args{$k}; |
75
|
|
|
|
|
|
|
} |
76
|
70
|
|
|
|
|
157
|
return $parser; |
77
|
|
|
|
|
|
|
} |
78
|
|
|
|
|
|
|
|
79
|
|
|
|
|
|
|
sub clear_strmap { |
80
|
0
|
|
|
0
|
0
|
0
|
my ($self) = @_; |
81
|
|
|
|
|
|
|
|
82
|
0
|
|
|
|
|
0
|
$stridx = 1; |
83
|
0
|
|
|
|
|
0
|
$self->{strmap} = {}; |
84
|
0
|
|
|
|
|
0
|
$self->{strmap}{'__LINE__'} = 1; |
85
|
0
|
|
|
|
|
0
|
return; |
86
|
|
|
|
|
|
|
} |
87
|
|
|
|
|
|
|
|
88
|
|
|
|
|
|
|
my %ctrlmap = map { chr($_) => sprintf "\\x%02x", $_ } (0x00..0x1f, 0x7f); |
89
|
|
|
|
|
|
|
|
90
|
|
|
|
|
|
|
# convert controls from pattern to "\xNN" |
91
|
|
|
|
|
|
|
# |
92
|
|
|
|
|
|
|
sub escape_ctrl { |
93
|
0
|
|
|
0
|
0
|
0
|
my ($s, $pat) = @_; |
94
|
0
|
|
|
|
|
0
|
my @list = (); |
95
|
|
|
|
|
|
|
|
96
|
0
|
0
|
|
|
|
0
|
return "''" if ($s eq ''); |
97
|
|
|
|
|
|
|
|
98
|
0
|
|
|
|
|
0
|
$_ = $s; |
99
|
0
|
|
|
|
|
0
|
while (1) { |
100
|
|
|
|
|
|
|
#if(/\G([${pat}])/sgc) { |
101
|
|
|
|
|
|
|
# push(@list, sprintf "\"\\x%02x\"", ord($1)); |
102
|
0
|
0
|
|
|
|
0
|
if(/\G([${pat}]+)/sgc) { |
|
|
0
|
|
|
|
|
|
103
|
0
|
0
|
|
|
|
0
|
push(@list, '"' . join('', map { exists $ctrlmap{$_} ? $ctrlmap{$_} : $_ } split(//, $1)) . '"'); |
|
0
|
|
|
|
|
0
|
|
104
|
|
|
|
|
|
|
} elsif (/\G([^${pat}]+)/sgc) { |
105
|
0
|
|
|
|
|
0
|
push(@list, "'" . $1 . "'"); |
106
|
|
|
|
|
|
|
} else { |
107
|
0
|
|
|
|
|
0
|
last; |
108
|
|
|
|
|
|
|
} |
109
|
|
|
|
|
|
|
} |
110
|
0
|
|
|
|
|
0
|
return join('.', @list); |
111
|
|
|
|
|
|
|
} |
112
|
|
|
|
|
|
|
|
113
|
|
|
|
|
|
|
sub shortstr { |
114
|
0
|
|
|
0
|
0
|
0
|
my ($self, $s, $maxlen) = @_; |
115
|
|
|
|
|
|
|
|
116
|
0
|
0
|
|
|
|
0
|
if (!defined $s) { |
117
|
0
|
|
|
|
|
0
|
return '(null)'; |
118
|
|
|
|
|
|
|
} |
119
|
|
|
|
|
|
|
|
120
|
|
|
|
|
|
|
# remove linefeeds |
121
|
|
|
|
|
|
|
# |
122
|
|
|
|
|
|
|
#$s =~ s/\r\n/ /g; |
123
|
|
|
|
|
|
|
|
124
|
|
|
|
|
|
|
# remove non-printable |
125
|
|
|
|
|
|
|
# |
126
|
0
|
|
|
|
|
0
|
$s =~ s/[\x01-\x1f\x7f]/\./g; |
127
|
|
|
|
|
|
|
|
128
|
0
|
0
|
0
|
|
|
0
|
if (($self->{max_strlen} > 0) && (!$maxlen || ($maxlen > $self->{max_strlen}))) { |
|
|
|
0
|
|
|
|
|
129
|
0
|
|
|
|
|
0
|
$maxlen = $self->{max_strlen}; |
130
|
|
|
|
|
|
|
} |
131
|
0
|
0
|
0
|
|
|
0
|
if ($maxlen && (length($s) > $maxlen)) { |
132
|
0
|
|
|
|
|
0
|
$s = substr($s, 0, $maxlen-2).'..'; |
133
|
|
|
|
|
|
|
} |
134
|
0
|
|
|
|
|
0
|
return $s; |
135
|
|
|
|
|
|
|
} |
136
|
|
|
|
|
|
|
|
137
|
|
|
|
|
|
|
# 'str' -> #str$i |
138
|
|
|
|
|
|
|
# |
139
|
|
|
|
|
|
|
sub setstr { |
140
|
2030
|
|
|
2030
|
0
|
4656
|
my ($self, $v) = @_; |
141
|
2030
|
|
|
|
|
2862
|
my $k; |
142
|
|
|
|
|
|
|
|
143
|
2030
|
100
|
|
|
|
4520
|
if (exists $self->{strmap}->{rev}{$v}) { |
144
|
121
|
|
|
|
|
255
|
$k = $self->{strmap}->{rev}{$v}; |
145
|
121
|
|
|
|
|
345
|
return $k; |
146
|
|
|
|
|
|
|
} else { |
147
|
1909
|
|
|
|
|
3431
|
$k = "#str$stridx"; |
148
|
1909
|
|
|
|
|
2926
|
$stridx++; |
149
|
1909
|
|
|
|
|
4713
|
$self->{strmap}->{$k} = $v; |
150
|
1909
|
|
|
|
|
5205
|
$self->{strmap}->{rev}{$v} = $k; |
151
|
|
|
|
|
|
|
} |
152
|
|
|
|
|
|
|
# TODO: log also for $opt{P} |
153
|
1909
|
50
|
0
|
|
|
3954
|
$self->{log}->('setstr', "%s = %s", $k, $self->shortstr($v, $self->{max_strlen} || 60)) if $self->{log}; |
154
|
1909
|
|
|
|
|
4035
|
return $k; |
155
|
|
|
|
|
|
|
} |
156
|
|
|
|
|
|
|
|
157
|
|
|
|
|
|
|
# for expensive operations like repeated strconcat don't |
158
|
|
|
|
|
|
|
# store reverse entry to save some space |
159
|
|
|
|
|
|
|
# |
160
|
|
|
|
|
|
|
sub setstr_norev { |
161
|
110
|
|
|
110
|
0
|
242
|
my ($self, $v) = @_; |
162
|
110
|
|
|
|
|
171
|
my $k; |
163
|
|
|
|
|
|
|
|
164
|
110
|
100
|
|
|
|
281
|
if (exists $self->{strmap}->{rev}{$v}) { |
165
|
21
|
|
|
|
|
47
|
$k = $self->{strmap}->{rev}{$v}; |
166
|
21
|
|
|
|
|
53
|
return $k; |
167
|
|
|
|
|
|
|
} else { |
168
|
89
|
|
|
|
|
194
|
$k = "#str$stridx"; |
169
|
89
|
|
|
|
|
135
|
$stridx++; |
170
|
89
|
|
|
|
|
308
|
$self->{strmap}->{$k} = $v; |
171
|
|
|
|
|
|
|
} |
172
|
|
|
|
|
|
|
# TODO: log also for $opt{P} |
173
|
89
|
50
|
0
|
|
|
212
|
$self->{log}->('setstr', "%s = %s [norev]", $k, $self->shortstr($v, $self->{max_strlen} || 60)) if $self->{log}; |
174
|
89
|
|
|
|
|
203
|
return $k; |
175
|
|
|
|
|
|
|
} |
176
|
|
|
|
|
|
|
|
177
|
|
|
|
|
|
|
# number -> #num$i |
178
|
|
|
|
|
|
|
# |
179
|
|
|
|
|
|
|
sub setnum { |
180
|
868
|
|
|
868
|
0
|
2546
|
my ($self, $v) = @_; |
181
|
868
|
|
|
|
|
1157
|
my $k; |
182
|
|
|
|
|
|
|
|
183
|
868
|
100
|
|
|
|
2200
|
if (exists $self->{strmap}->{num}{$v}) { |
184
|
182
|
|
|
|
|
391
|
$k = $self->{strmap}->{num}{$v}; |
185
|
182
|
|
|
|
|
439
|
return $k; |
186
|
|
|
|
|
|
|
} else { |
187
|
686
|
|
|
|
|
1344
|
$k = "#num$numidx"; |
188
|
686
|
|
|
|
|
1017
|
$numidx++; |
189
|
686
|
|
|
|
|
2287
|
$self->{strmap}->{$k} = $v; |
190
|
686
|
|
|
|
|
1616
|
$self->{strmap}->{num}{$v} = $k; |
191
|
|
|
|
|
|
|
} |
192
|
686
|
50
|
|
|
|
1430
|
$self->{log}->('setnum', "%s = %s", $k, $self->shortstr($v, 60)) if $self->{log}; |
193
|
686
|
|
|
|
|
1477
|
return $k; |
194
|
|
|
|
|
|
|
} |
195
|
|
|
|
|
|
|
|
196
|
|
|
|
|
|
|
# 'const' -> #const$i |
197
|
|
|
|
|
|
|
# |
198
|
|
|
|
|
|
|
sub setconst { |
199
|
344
|
|
|
344
|
0
|
751
|
my ($self, $v) = @_; |
200
|
344
|
|
|
|
|
727
|
my $k = "#const$constidx"; |
201
|
344
|
|
|
|
|
502
|
$constidx++; |
202
|
|
|
|
|
|
|
|
203
|
344
|
|
|
|
|
1343
|
$self->{strmap}->{$k} = $v; |
204
|
344
|
50
|
|
|
|
751
|
$self->{log}->('setconst', "%s = %s", $k, $v) if $self->{log}; |
205
|
344
|
|
|
|
|
795
|
return $k; |
206
|
|
|
|
|
|
|
} |
207
|
|
|
|
|
|
|
|
208
|
|
|
|
|
|
|
sub newarr { |
209
|
274
|
|
|
274
|
0
|
1126
|
my ($self) = @_; |
210
|
274
|
|
|
|
|
1140
|
my $arr = PHP::Decode::Array->new(strmap => $self->{strmap}); |
211
|
274
|
50
|
|
|
|
616
|
$self->{log}->('newarr', "%s", $arr->{name}) if $self->{log}; |
212
|
274
|
|
|
|
|
633
|
return $arr; |
213
|
|
|
|
|
|
|
} |
214
|
|
|
|
|
|
|
|
215
|
|
|
|
|
|
|
# function -> #fun$i |
216
|
|
|
|
|
|
|
# |
217
|
|
|
|
|
|
|
sub setfun { |
218
|
309
|
|
|
309
|
0
|
732
|
my ($self, $cmd, $arglist, $block, $p) = @_; |
219
|
309
|
|
|
|
|
637
|
my $k = "#fun$funidx"; |
220
|
309
|
|
|
|
|
420
|
$funidx++; |
221
|
|
|
|
|
|
|
|
222
|
309
|
|
|
|
|
1331
|
$self->{strmap}->{$k} = [$cmd, $arglist, $block, $p]; |
223
|
309
|
50
|
|
|
|
711
|
$self->{log}->('setfun', "%s = %s", $k, $self->stmt_str($k)) if $self->{log}; |
224
|
309
|
|
|
|
|
726
|
return $k; |
225
|
|
|
|
|
|
|
} |
226
|
|
|
|
|
|
|
|
227
|
|
|
|
|
|
|
sub setcall { |
228
|
781
|
|
|
781
|
0
|
1506
|
my ($self, $cmd, $arglist) = @_; |
229
|
781
|
|
|
|
|
1613
|
my $k = "#call$callidx"; |
230
|
781
|
|
|
|
|
1227
|
$callidx++; |
231
|
|
|
|
|
|
|
|
232
|
781
|
|
|
|
|
3186
|
$self->{strmap}->{$k} = [$cmd, $arglist]; |
233
|
781
|
50
|
|
|
|
1637
|
$self->{log}->('setcall', "%s = %s", $k, $self->stmt_str($k)) if $self->{log}; |
234
|
781
|
|
|
|
|
1924
|
return $k; |
235
|
|
|
|
|
|
|
} |
236
|
|
|
|
|
|
|
|
237
|
|
|
|
|
|
|
sub setelem { |
238
|
538
|
|
|
538
|
0
|
1115
|
my ($self, $var, $idx) = @_; |
239
|
538
|
|
|
|
|
1174
|
my $k = "#elem$elemidx"; |
240
|
538
|
|
|
|
|
868
|
$elemidx++; |
241
|
|
|
|
|
|
|
|
242
|
538
|
|
|
|
|
2144
|
$self->{strmap}->{$k} = [$var, $idx]; |
243
|
538
|
50
|
|
|
|
1215
|
$self->{log}->('setelem', "%s = %s", $k, $self->stmt_str($k)) if $self->{log}; |
244
|
538
|
|
|
|
|
1205
|
return $k; |
245
|
|
|
|
|
|
|
} |
246
|
|
|
|
|
|
|
|
247
|
|
|
|
|
|
|
sub setexpr { |
248
|
1983
|
|
|
1983
|
0
|
4541
|
my ($self, $op, $v1, $v2) = @_; |
249
|
1983
|
|
|
|
|
4177
|
my $k = "#expr$expridx"; |
250
|
1983
|
|
|
|
|
3081
|
$expridx++; |
251
|
|
|
|
|
|
|
|
252
|
1983
|
|
|
|
|
8870
|
$self->{strmap}->{$k} = [$op, $v1, $v2]; |
253
|
1983
|
50
|
|
|
|
4192
|
$self->{log}->('setexpr', "%s = %s", $k, $self->stmt_str($k)) if $self->{log}; |
254
|
1983
|
|
|
|
|
4630
|
return $k; |
255
|
|
|
|
|
|
|
} |
256
|
|
|
|
|
|
|
|
257
|
|
|
|
|
|
|
sub setblk { |
258
|
2877
|
|
|
2877
|
0
|
5408
|
my ($self, $type, $a) = @_; |
259
|
2877
|
|
|
|
|
5924
|
my $k = "#blk$blkidx"; |
260
|
2877
|
|
|
|
|
4390
|
$blkidx++; |
261
|
|
|
|
|
|
|
|
262
|
2877
|
|
|
|
|
12352
|
$self->{strmap}->{$k} = [$type, $a]; |
263
|
2877
|
50
|
|
|
|
6034
|
$self->{log}->('setblk', "%s = %s", $k, $self->stmt_str($k)) if $self->{log}; |
264
|
2877
|
|
|
|
|
6299
|
return $k; |
265
|
|
|
|
|
|
|
} |
266
|
|
|
|
|
|
|
|
267
|
|
|
|
|
|
|
sub setstmt { |
268
|
853
|
|
|
853
|
0
|
1523
|
my ($self, $s) = @_; |
269
|
853
|
|
|
|
|
1922
|
my $k = "#stmt$stmtidx"; |
270
|
853
|
|
|
|
|
1262
|
$stmtidx++; |
271
|
|
|
|
|
|
|
|
272
|
853
|
|
|
|
|
2743
|
$self->{strmap}->{$k} = $s; |
273
|
853
|
50
|
|
|
|
1881
|
$self->{log}->('setstmt', "%s = %s", $k, $self->stmt_str($k)) if $self->{log}; |
274
|
853
|
|
|
|
|
2136
|
return $k; |
275
|
|
|
|
|
|
|
} |
276
|
|
|
|
|
|
|
|
277
|
|
|
|
|
|
|
sub setpfx { |
278
|
55
|
|
|
55
|
0
|
118
|
my ($self, $s) = @_; |
279
|
55
|
|
|
|
|
126
|
my $k = "#pfx$pfxidx"; |
280
|
55
|
|
|
|
|
98
|
$pfxidx++; |
281
|
|
|
|
|
|
|
|
282
|
55
|
|
|
|
|
167
|
$self->{strmap}->{$k} = $s; |
283
|
55
|
50
|
|
|
|
116
|
$self->{log}->('setpfx', "%s = %s", $k, $self->stmt_str($k)) if $self->{log}; |
284
|
55
|
|
|
|
|
130
|
return $k; |
285
|
|
|
|
|
|
|
} |
286
|
|
|
|
|
|
|
|
287
|
|
|
|
|
|
|
sub setobj { |
288
|
52
|
|
|
52
|
0
|
115
|
my ($self, $s, $property) = @_; |
289
|
52
|
|
|
|
|
126
|
my $k = "#obj$objidx"; |
290
|
52
|
|
|
|
|
73
|
$objidx++; |
291
|
|
|
|
|
|
|
|
292
|
52
|
|
|
|
|
331
|
$self->{strmap}->{$k} = [$s, $property]; |
293
|
52
|
50
|
|
|
|
143
|
$self->{log}->('setobj', "%s = %s", $k, $self->stmt_str($k)) if $self->{log}; |
294
|
52
|
|
|
|
|
113
|
return $k; |
295
|
|
|
|
|
|
|
} |
296
|
|
|
|
|
|
|
|
297
|
|
|
|
|
|
|
sub setscope { |
298
|
41
|
|
|
41
|
0
|
90
|
my ($self, $s, $elem) = @_; |
299
|
41
|
|
|
|
|
85
|
my $k = "#scope$scopeidx"; |
300
|
41
|
|
|
|
|
66
|
$scopeidx++; |
301
|
|
|
|
|
|
|
|
302
|
41
|
|
|
|
|
206
|
$self->{strmap}->{$k} = [$s, $elem]; |
303
|
41
|
50
|
|
|
|
98
|
$self->{log}->('setscope', "%s = %s", $k, $self->stmt_str($k)) if $self->{log}; |
304
|
41
|
|
|
|
|
102
|
return $k; |
305
|
|
|
|
|
|
|
} |
306
|
|
|
|
|
|
|
|
307
|
|
|
|
|
|
|
sub setref { |
308
|
8
|
|
|
8
|
0
|
23
|
my ($self, $s) = @_; |
309
|
8
|
|
|
|
|
23
|
my $k = "#ref$refidx"; |
310
|
8
|
|
|
|
|
14
|
$refidx++; |
311
|
|
|
|
|
|
|
|
312
|
8
|
|
|
|
|
32
|
$self->{strmap}->{$k} = [$s]; |
313
|
8
|
50
|
|
|
|
22
|
$self->{log}->('setref', "%s = %s", $k, $s) if $self->{log}; |
314
|
8
|
|
|
|
|
19
|
return $k; |
315
|
|
|
|
|
|
|
} |
316
|
|
|
|
|
|
|
|
317
|
|
|
|
|
|
|
sub setclass { |
318
|
69
|
|
|
69
|
0
|
179
|
my ($self, $name, $block, $p) = @_; |
319
|
69
|
|
|
|
|
144
|
my $k = "#class$classidx"; |
320
|
69
|
|
|
|
|
106
|
$classidx++; |
321
|
|
|
|
|
|
|
|
322
|
69
|
|
|
|
|
326
|
$self->{strmap}->{$k} = [$name, $block, $p]; |
323
|
69
|
50
|
|
|
|
170
|
$self->{log}->('setclass', "%s = %s", $k, $self->stmt_str($k)) if $self->{log}; |
324
|
69
|
|
|
|
|
166
|
return $k; |
325
|
|
|
|
|
|
|
} |
326
|
|
|
|
|
|
|
|
327
|
|
|
|
|
|
|
sub settrait { |
328
|
1
|
|
|
1
|
0
|
4
|
my ($self, $name, $block) = @_; |
329
|
1
|
|
|
|
|
4
|
my $k = "#trait$traitidx"; |
330
|
1
|
|
|
|
|
3
|
$traitidx++; |
331
|
|
|
|
|
|
|
|
332
|
1
|
|
|
|
|
4
|
$self->{strmap}->{$k} = [$name, $block]; |
333
|
1
|
50
|
|
|
|
5
|
$self->{log}->('settrait', "%s = %s", $k, $self->stmt_str($k)) if $self->{log}; |
334
|
1
|
|
|
|
|
3
|
return $k; |
335
|
|
|
|
|
|
|
} |
336
|
|
|
|
|
|
|
|
337
|
|
|
|
|
|
|
sub setinst { |
338
|
34
|
|
|
34
|
0
|
72
|
my ($self, $class, $initcall, $instctx) = @_; |
339
|
34
|
|
|
|
|
84
|
my $k = "#inst$instidx"; |
340
|
34
|
|
|
|
|
55
|
$instidx++; |
341
|
|
|
|
|
|
|
|
342
|
34
|
|
|
|
|
151
|
$self->{strmap}->{$k} = [$class, $initcall, $instctx]; |
343
|
34
|
50
|
|
|
|
81
|
$self->{log}->('setinst', "%s = %s", $k, $class) if $self->{log}; |
344
|
34
|
|
|
|
|
91
|
return $k; |
345
|
|
|
|
|
|
|
} |
346
|
|
|
|
|
|
|
|
347
|
|
|
|
|
|
|
sub setns { |
348
|
12
|
|
|
12
|
0
|
38
|
my ($self, $name, $elem) = @_; |
349
|
12
|
|
|
|
|
26
|
my $k = "#ns$nsidx"; |
350
|
12
|
|
|
|
|
16
|
$nsidx++; |
351
|
|
|
|
|
|
|
|
352
|
12
|
|
|
|
|
41
|
$self->{strmap}->{$k} = [$name, $elem]; |
353
|
12
|
50
|
|
|
|
27
|
$self->{log}->('setns', "%s = %s", $k, $self->stmt_str($k)) if $self->{log}; |
354
|
12
|
|
|
|
|
25
|
return $k; |
355
|
|
|
|
|
|
|
} |
356
|
|
|
|
|
|
|
|
357
|
|
|
|
|
|
|
sub newfh { |
358
|
2
|
|
|
2
|
0
|
11
|
my ($self, $filename, $mode) = @_; |
359
|
2
|
|
|
|
|
7
|
my %file; |
360
|
|
|
|
|
|
|
my $a; |
361
|
2
|
|
|
|
|
9
|
my $fh = "#fh$fhidx"; |
362
|
2
|
|
|
|
|
6
|
$fhidx++; |
363
|
|
|
|
|
|
|
|
364
|
2
|
|
|
|
|
10
|
$self->{strmap}->{$fh} = \%file; |
365
|
2
|
|
|
|
|
9
|
$self->{strmap}->{idx}{$fh} = 0; |
366
|
|
|
|
|
|
|
|
367
|
2
|
|
|
|
|
22
|
$file{name} = $filename; |
368
|
2
|
|
|
|
|
6
|
$file{mode} = $mode; |
369
|
2
|
|
|
|
|
7
|
$file{pos} = 0; |
370
|
2
|
50
|
|
|
|
8
|
if ($filename eq '__FILE__') { |
371
|
0
|
|
|
|
|
0
|
$file{buf} = $self->{strmap}->{$filename}; # todo: cleanup |
372
|
|
|
|
|
|
|
} else { |
373
|
2
|
|
|
|
|
5
|
$file{buf} = ''; |
374
|
2
|
|
|
|
|
9
|
return; # TODO: support write & non-existing files |
375
|
|
|
|
|
|
|
} |
376
|
0
|
0
|
|
|
|
0
|
$self->{log}->('newfh', "$fh ($filename, $mode)") if $self->{log}; |
377
|
0
|
|
|
|
|
0
|
return ($fh, \%file); |
378
|
|
|
|
|
|
|
} |
379
|
|
|
|
|
|
|
|
380
|
|
|
|
|
|
|
sub stmt_str { |
381
|
71
|
|
|
71
|
0
|
179
|
my ($self, $s) = @_; |
382
|
|
|
|
|
|
|
|
383
|
71
|
50
|
|
|
|
377
|
unless ($s =~ /^#\w+\d+$/) { |
384
|
0
|
|
|
|
|
0
|
return $s; |
385
|
|
|
|
|
|
|
} |
386
|
|
|
|
|
|
|
|
387
|
71
|
50
|
|
|
|
594
|
if ($s =~ /^#null$/) { |
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
388
|
0
|
|
|
|
|
0
|
return 'null'; # '' or 0 in str/num context |
389
|
|
|
|
|
|
|
} elsif ($s =~ /^#num\d+$/) { |
390
|
0
|
|
|
|
|
0
|
return $self->{strmap}{$s}; |
391
|
|
|
|
|
|
|
} elsif ($s =~ /^#const\d+$/) { |
392
|
0
|
|
|
|
|
0
|
return $self->{strmap}{$s}; |
393
|
|
|
|
|
|
|
} elsif ($s =~ /^#str\d+$/) { |
394
|
0
|
|
|
|
|
0
|
my $v = $self->{strmap}{$s}; |
395
|
0
|
|
|
|
|
0
|
return $self->shortstr($v, 60); |
396
|
|
|
|
|
|
|
} elsif ($s =~ /^#arr\d+$/) { |
397
|
0
|
|
|
|
|
0
|
my $arr = $self->{strmap}{$s}; |
398
|
0
|
|
|
|
|
0
|
my $keys = $arr->get_keys(); |
399
|
0
|
|
|
|
|
0
|
my $size = scalar @$keys; |
400
|
|
|
|
|
|
|
|
401
|
0
|
|
|
|
|
0
|
return $arr->{name} . "[size $size]"; |
402
|
|
|
|
|
|
|
} elsif ($s =~ /^#fun\d+$/) { |
403
|
0
|
|
|
|
|
0
|
my ($f, $a, $b, $p) = @{$self->{strmap}{$s}}; |
|
0
|
|
|
|
|
0
|
|
404
|
0
|
|
|
|
|
0
|
my ($type, $stmts) = @{$self->{strmap}{$b}}; |
|
0
|
|
|
|
|
0
|
|
405
|
|
|
|
|
|
|
|
406
|
0
|
0
|
|
|
|
0
|
return (defined $f ? $f : '') . "(" . join(', ', @$a) . ") { " . join(' ', @$stmts) . " }"; |
407
|
|
|
|
|
|
|
} elsif ($s =~ /^#call\d+$/) { |
408
|
69
|
|
|
|
|
104
|
my ($f, $a) = @{$self->{strmap}->{$s}}; |
|
69
|
|
|
|
|
222
|
|
409
|
|
|
|
|
|
|
|
410
|
69
|
|
|
|
|
460
|
return $f . "(" . join(', ', @$a) . ")"; |
411
|
|
|
|
|
|
|
} elsif ($s =~ /^#elem\d+$/) { |
412
|
2
|
|
|
|
|
4
|
my ($v, $i) = @{$self->{strmap}{$s}}; |
|
2
|
|
|
|
|
10
|
|
413
|
|
|
|
|
|
|
|
414
|
2
|
50
|
|
|
|
12
|
return $v . "[" . (defined $i ? $i : '') . "]"; |
415
|
|
|
|
|
|
|
} elsif ($s =~ /^#expr\d+$/) { |
416
|
|
|
|
|
|
|
# if v1 missing: prefix op |
417
|
|
|
|
|
|
|
# if v2 missing: postfix op |
418
|
0
|
|
|
|
|
0
|
my ($op, $v1, $v2) = @{$self->{strmap}{$s}}; |
|
0
|
|
|
|
|
0
|
|
419
|
|
|
|
|
|
|
|
420
|
0
|
0
|
|
|
|
0
|
return (defined $v1 ? $v1 . " " : '') . $op . (defined $v2 ? " " . $v2 : ''); |
|
|
0
|
|
|
|
|
|
421
|
|
|
|
|
|
|
} elsif ($s =~ /^#pfx\d+$/) { |
422
|
0
|
|
|
|
|
0
|
my $pfx = $self->{strmap}{$s}; |
423
|
0
|
|
|
|
|
0
|
return join(' ', sort keys %$pfx); |
424
|
|
|
|
|
|
|
} elsif ($s =~ /^#obj\d+$/) { |
425
|
0
|
|
|
|
|
0
|
my ($o, $m) = @{$self->{strmap}{$s}}; |
|
0
|
|
|
|
|
0
|
|
426
|
0
|
|
|
|
|
0
|
return $o . "->" . $m; |
427
|
|
|
|
|
|
|
} elsif ($s =~ /^#scope\d+$/) { |
428
|
0
|
|
|
|
|
0
|
my ($c, $e) = @{$self->{strmap}{$s}}; |
|
0
|
|
|
|
|
0
|
|
429
|
0
|
|
|
|
|
0
|
return $c . "::" . $e; |
430
|
|
|
|
|
|
|
} elsif ($s =~ /^#ns\d+$/) { |
431
|
0
|
|
|
|
|
0
|
my ($n, $e) = @{$self->{strmap}{$s}}; |
|
0
|
|
|
|
|
0
|
|
432
|
0
|
0
|
|
|
|
0
|
return (defined $n ? $n : '') . '\\' . $e; |
433
|
|
|
|
|
|
|
} elsif ($s =~ /^#inst\d+$/) { |
434
|
0
|
|
|
|
|
0
|
my ($c, $f, $i) = @{$self->{strmap}{$s}}; |
|
0
|
|
|
|
|
0
|
|
435
|
0
|
|
|
|
|
0
|
return $c; |
436
|
|
|
|
|
|
|
} elsif ($s =~ /^#ref\d+$/) { |
437
|
0
|
|
|
|
|
0
|
my ($v) = @{$self->{strmap}{$s}}; |
|
0
|
|
|
|
|
0
|
|
438
|
0
|
|
|
|
|
0
|
return "&" . $v; |
439
|
|
|
|
|
|
|
} elsif ($s =~ /^#class\d+$/) { |
440
|
0
|
|
|
|
|
0
|
my ($c, $b, $p) = @{$self->{strmap}{$s}}; |
|
0
|
|
|
|
|
0
|
|
441
|
0
|
|
|
|
|
0
|
my ($type, $stmts) = @{$self->{strmap}{$b}}; |
|
0
|
|
|
|
|
0
|
|
442
|
|
|
|
|
|
|
|
443
|
0
|
0
|
|
|
|
0
|
return (defined $c ? $c : '') . (exists $p->{parent} ? " extends $p->{parent}" : '') . " { " . join(' ', @$stmts) . " }"; |
|
|
0
|
|
|
|
|
|
444
|
|
|
|
|
|
|
} elsif ($s =~ /^#trait\d+$/) { |
445
|
0
|
|
|
|
|
0
|
my ($t, $b) = @{$self->{strmap}{$s}}; |
|
0
|
|
|
|
|
0
|
|
446
|
0
|
|
|
|
|
0
|
my ($type, $stmts) = @{$self->{strmap}{$b}}; |
|
0
|
|
|
|
|
0
|
|
447
|
|
|
|
|
|
|
|
448
|
0
|
0
|
|
|
|
0
|
return (defined $t ? $t : '') . " { " . join(' ', @$stmts) . " }"; |
449
|
|
|
|
|
|
|
} elsif ($s =~ /^#fh\d+$/) { |
450
|
0
|
|
|
|
|
0
|
my $f = $self->{strmap}{$s}{name}; |
451
|
0
|
|
|
|
|
0
|
my $m = $self->{strmap}{$s}{mode}; |
452
|
0
|
|
|
|
|
0
|
my $p = $self->{strmap}{$s}{pos}; |
453
|
|
|
|
|
|
|
|
454
|
0
|
|
|
|
|
0
|
return "(" . $f . ", " . $m . ")"; |
455
|
|
|
|
|
|
|
} elsif ($s =~ /^#blk\d+$/) { |
456
|
0
|
|
|
|
|
0
|
my ($type, $a) = @{$self->{strmap}{$s}}; |
|
0
|
|
|
|
|
0
|
|
457
|
0
|
|
|
|
|
0
|
return $type . " { " . join(' ', @$a) . " }"; |
458
|
|
|
|
|
|
|
} elsif ($s =~ /^#stmt\d+$/) { |
459
|
0
|
|
|
|
|
0
|
my $cmd = $self->{strmap}{$s}[0]; |
460
|
|
|
|
|
|
|
|
461
|
0
|
0
|
|
|
|
0
|
if ($cmd eq 'echo') { |
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
462
|
0
|
|
|
|
|
0
|
my $a = $self->{strmap}{$s}[1]; |
463
|
0
|
|
|
|
|
0
|
return $cmd . " " . join(', ', @$a); |
464
|
|
|
|
|
|
|
} elsif ($cmd eq 'print') { |
465
|
0
|
|
|
|
|
0
|
my $arg = $self->{strmap}{$s}[1]; |
466
|
0
|
|
|
|
|
0
|
return $cmd . " " . $arg; |
467
|
|
|
|
|
|
|
} elsif ($cmd eq 'namespace') { |
468
|
0
|
|
|
|
|
0
|
my ($arg, $block) = @{$self->{strmap}->{$s}}[1..2]; |
|
0
|
|
|
|
|
0
|
|
469
|
0
|
0
|
|
|
|
0
|
return $cmd . " " . $arg . (defined $block ? " { $block }" : ''); |
470
|
|
|
|
|
|
|
} elsif ($cmd =~ /^(include|include_once|require|require_once)$/) { |
471
|
0
|
|
|
|
|
0
|
my $arg = $self->{strmap}{$s}[1]; |
472
|
0
|
|
|
|
|
0
|
return $cmd . " " . $arg; |
473
|
|
|
|
|
|
|
} elsif ($cmd eq 'use') { |
474
|
0
|
|
|
|
|
0
|
my $a = $self->{strmap}{$s}[1]; |
475
|
0
|
|
|
|
|
0
|
return $cmd . " " . join(', ', @$a); |
476
|
|
|
|
|
|
|
} elsif ($cmd eq 'global') { |
477
|
0
|
|
|
|
|
0
|
my $a = $self->{strmap}{$s}[1]; |
478
|
0
|
|
|
|
|
0
|
return $cmd . " " . join(', ', @$a); |
479
|
|
|
|
|
|
|
} elsif ($cmd eq 'static') { |
480
|
0
|
|
|
|
|
0
|
my ($a, $p) = @{$self->{strmap}{$s}}[1..2]; |
|
0
|
|
|
|
|
0
|
|
481
|
0
|
|
|
|
|
0
|
return $cmd . join(' ', (grep { $_ ne $cmd } sort keys %$p), $cmd) . ' ' . join(', ', @$a); |
|
0
|
|
|
|
|
0
|
|
482
|
|
|
|
|
|
|
} elsif ($cmd eq 'const') { |
483
|
0
|
|
|
|
|
0
|
my ($a, $p) = @{$self->{strmap}{$s}}[1..2]; |
|
0
|
|
|
|
|
0
|
|
484
|
0
|
|
|
|
|
0
|
return $cmd . join(' ', (grep { $_ ne $cmd } sort keys %$p), $cmd) . ' ' . join(', ', @$a); |
|
0
|
|
|
|
|
0
|
|
485
|
|
|
|
|
|
|
} elsif ($cmd eq 'unset') { |
486
|
0
|
|
|
|
|
0
|
my $a = $self->{strmap}{$s}[1]; |
487
|
0
|
|
|
|
|
0
|
return $cmd . " (" . join(', ', @$a) . ")"; |
488
|
|
|
|
|
|
|
} elsif ($cmd eq 'return') { |
489
|
0
|
|
|
|
|
0
|
my $a = $self->{strmap}{$s}[1]; |
490
|
0
|
|
|
|
|
0
|
return $cmd . " " . $a; |
491
|
|
|
|
|
|
|
} elsif ($cmd eq 'goto') { |
492
|
0
|
|
|
|
|
0
|
my $a = $self->{strmap}{$s}[1]; |
493
|
0
|
|
|
|
|
0
|
return $cmd . " " . $a; |
494
|
|
|
|
|
|
|
} elsif ($cmd eq 'label') { |
495
|
0
|
|
|
|
|
0
|
my $a = $self->{strmap}{$s}[1]; |
496
|
0
|
|
|
|
|
0
|
return $cmd . " " . $a . ":"; |
497
|
|
|
|
|
|
|
} elsif ($cmd eq 'throw') { |
498
|
0
|
|
|
|
|
0
|
my $arg = $self->{strmap}{$s}[1]; |
499
|
0
|
|
|
|
|
0
|
return $cmd . " " . $arg; |
500
|
|
|
|
|
|
|
} elsif ($cmd eq 'if') { |
501
|
0
|
|
|
|
|
0
|
my ($cond, $then, $else) = @{$self->{strmap}{$s}}[1..3]; |
|
0
|
|
|
|
|
0
|
|
502
|
0
|
0
|
|
|
|
0
|
return $cmd . " ($cond) then $then" . (defined $else ? " else $else" : ''); |
503
|
|
|
|
|
|
|
} elsif ($cmd eq 'while') { |
504
|
0
|
|
|
|
|
0
|
my ($cond, $block) = @{$self->{strmap}{$s}}[1..2]; |
|
0
|
|
|
|
|
0
|
|
505
|
0
|
|
|
|
|
0
|
return $cmd . " ($cond) { $block }"; |
506
|
|
|
|
|
|
|
} elsif ($cmd eq 'do') { |
507
|
0
|
|
|
|
|
0
|
my ($cond, $block) = @{$self->{strmap}{$s}}[1..2]; |
|
0
|
|
|
|
|
0
|
|
508
|
0
|
|
|
|
|
0
|
return $cmd . " { $block } while ($cond)"; |
509
|
|
|
|
|
|
|
} elsif ($cmd eq 'for') { |
510
|
0
|
|
|
|
|
0
|
my ($pre, $cond, $post, $block) = @{$self->{strmap}{$s}}[1..4]; |
|
0
|
|
|
|
|
0
|
|
511
|
0
|
|
|
|
|
0
|
return $cmd . " ($pre; $cond; $post) { $block }"; |
512
|
|
|
|
|
|
|
} elsif ($cmd eq 'foreach') { |
513
|
0
|
|
|
|
|
0
|
my ($expr, $key, $value, $block) = @{$self->{strmap}{$s}}[1..4]; |
|
0
|
|
|
|
|
0
|
|
514
|
0
|
0
|
|
|
|
0
|
return $cmd . " ($expr " . (defined $key ? "$key => " : '') . "$value) { $block }"; |
515
|
|
|
|
|
|
|
} elsif ($cmd eq 'switch') { |
516
|
0
|
|
|
|
|
0
|
my ($expr, $cases) = @{$self->{strmap}{$s}}[1..2]; |
|
0
|
|
|
|
|
0
|
|
517
|
0
|
0
|
|
|
|
0
|
return $cmd . " ($expr) { " . join(' ', map { sprintf "%s %s", defined $_->[0] ? "case $_->[0]:" : "default:", $_->[1]; } @$cases) . " }"; |
|
0
|
|
|
|
|
0
|
|
518
|
|
|
|
|
|
|
} elsif ($cmd eq 'case') { |
519
|
0
|
|
|
|
|
0
|
my $expr = $self->{strmap}{$s}[1]; |
520
|
0
|
0
|
|
|
|
0
|
return (defined $expr ? "case $expr:" : "default:"); |
521
|
|
|
|
|
|
|
} elsif ($cmd eq 'try') { |
522
|
0
|
|
|
|
|
0
|
my ($try, $catches, $finally) = @{$self->{strmap}->{$s}}[1..3]; |
|
0
|
|
|
|
|
0
|
|
523
|
0
|
0
|
0
|
|
|
0
|
return $cmd . " { $try }" . join(' ', map { sprintf " catch (%s) { %s }", $_->[0] // '-', $_->[1]; } @$catches) . (defined $finally ? " finally { $finally }" : ''); |
|
0
|
|
|
|
|
0
|
|
524
|
|
|
|
|
|
|
} else { |
525
|
0
|
|
|
|
|
0
|
return $cmd; |
526
|
|
|
|
|
|
|
} |
527
|
|
|
|
|
|
|
} |
528
|
0
|
|
|
|
|
0
|
return $s; |
529
|
|
|
|
|
|
|
} |
530
|
|
|
|
|
|
|
|
531
|
|
|
|
|
|
|
sub val { |
532
|
0
|
|
|
0
|
0
|
0
|
my ($self, $s) = @_; |
533
|
|
|
|
|
|
|
#exists $self->{strmap}{$s} || die "assert: bad statement $s passed to parser->val()"; |
534
|
0
|
|
|
|
|
0
|
return $self->{strmap}{$s}; # for lookup after is_strval(), is_array(), .. |
535
|
|
|
|
|
|
|
} |
536
|
|
|
|
|
|
|
|
537
|
|
|
|
|
|
|
sub get_strval { |
538
|
1223
|
|
|
1223
|
0
|
2220
|
my ($self, $s) = @_; |
539
|
|
|
|
|
|
|
#defined($s) || die "assert: undefined statement passed to parser->get_strval()"; |
540
|
|
|
|
|
|
|
|
541
|
1223
|
100
|
|
|
|
6260
|
if ($s =~ /^(\#(str|num|const)\d+|\#null)$/) { |
542
|
1202
|
|
|
|
|
3835
|
return $self->{strmap}{$s}; |
543
|
|
|
|
|
|
|
} |
544
|
21
|
|
|
|
|
64
|
return; |
545
|
|
|
|
|
|
|
} |
546
|
|
|
|
|
|
|
|
547
|
|
|
|
|
|
|
sub get_strval_or_str { |
548
|
199
|
|
|
199
|
0
|
423
|
my ($self, $s) = @_; |
549
|
|
|
|
|
|
|
|
550
|
199
|
100
|
|
|
|
715
|
if ($s =~ /^(\#(str|num|const)\d+|\#null)$/) { |
551
|
64
|
|
|
|
|
149
|
$s = $self->{strmap}{$s}; |
552
|
|
|
|
|
|
|
} |
553
|
199
|
|
|
|
|
461
|
return $s; |
554
|
|
|
|
|
|
|
} |
555
|
|
|
|
|
|
|
|
556
|
|
|
|
|
|
|
sub get_numval { |
557
|
0
|
|
|
0
|
0
|
0
|
my ($self, $s) = @_; |
558
|
|
|
|
|
|
|
|
559
|
0
|
0
|
|
|
|
0
|
if ($s =~ /^(\#num\d+|\#null)$/) { |
560
|
0
|
|
|
|
|
0
|
$s = $self->{strmap}{$s}; |
561
|
|
|
|
|
|
|
} |
562
|
0
|
|
|
|
|
0
|
return $s; |
563
|
|
|
|
|
|
|
} |
564
|
|
|
|
|
|
|
|
565
|
|
|
|
|
|
|
sub is_null { |
566
|
1079
|
|
|
1079
|
0
|
1903
|
my ($s) = @_; |
567
|
|
|
|
|
|
|
|
568
|
1079
|
100
|
|
|
|
2531
|
if ($s =~ /^(\#null)$/) { |
569
|
57
|
|
|
|
|
275
|
return 1; |
570
|
|
|
|
|
|
|
} |
571
|
1022
|
|
|
|
|
3123
|
return 0; |
572
|
|
|
|
|
|
|
} |
573
|
|
|
|
|
|
|
|
574
|
|
|
|
|
|
|
sub is_const { |
575
|
7561
|
|
|
7561
|
0
|
12812
|
my ($s) = @_; |
576
|
|
|
|
|
|
|
|
577
|
7561
|
100
|
|
|
|
14497
|
if ($s =~ /^(\#const\d++)$/) { |
578
|
259
|
|
|
|
|
816
|
return 1; |
579
|
|
|
|
|
|
|
} |
580
|
7302
|
|
|
|
|
40908
|
return 0; |
581
|
|
|
|
|
|
|
} |
582
|
|
|
|
|
|
|
|
583
|
|
|
|
|
|
|
sub is_numval { |
584
|
190
|
|
|
190
|
0
|
352
|
my ($s) = @_; |
585
|
|
|
|
|
|
|
|
586
|
190
|
100
|
|
|
|
555
|
if ($s =~ /^(\#num\d+)$/) { |
587
|
135
|
|
|
|
|
507
|
return 1; |
588
|
|
|
|
|
|
|
} |
589
|
55
|
|
|
|
|
278
|
return 0; |
590
|
|
|
|
|
|
|
} |
591
|
|
|
|
|
|
|
|
592
|
|
|
|
|
|
|
sub is_strval { |
593
|
16224
|
|
|
16224
|
0
|
26651
|
my ($s) = @_; |
594
|
|
|
|
|
|
|
|
595
|
16224
|
100
|
|
|
|
46379
|
if ($s =~ /^(\#(str|num|const)\d+|\#null)$/) { |
596
|
5832
|
|
|
|
|
20886
|
return 1; |
597
|
|
|
|
|
|
|
} |
598
|
10392
|
|
|
|
|
31794
|
return 0; |
599
|
|
|
|
|
|
|
} |
600
|
|
|
|
|
|
|
|
601
|
|
|
|
|
|
|
sub is_array { |
602
|
2478
|
|
|
2478
|
0
|
4162
|
my ($s) = @_; |
603
|
|
|
|
|
|
|
|
604
|
2478
|
100
|
|
|
|
5763
|
if ($s =~ /^#arr\d+$/) { |
605
|
968
|
|
|
|
|
3508
|
return 1; |
606
|
|
|
|
|
|
|
} |
607
|
1510
|
|
|
|
|
6027
|
return 0; |
608
|
|
|
|
|
|
|
} |
609
|
|
|
|
|
|
|
|
610
|
|
|
|
|
|
|
sub is_block { |
611
|
12800
|
|
|
12800
|
0
|
20268
|
my ($s) = @_; |
612
|
|
|
|
|
|
|
|
613
|
12800
|
100
|
|
|
|
31013
|
if ($s =~ /^#blk\d+$/) { |
614
|
4254
|
|
|
|
|
11727
|
return 1; |
615
|
|
|
|
|
|
|
} |
616
|
8546
|
|
|
|
|
20161
|
return 0; |
617
|
|
|
|
|
|
|
} |
618
|
|
|
|
|
|
|
|
619
|
|
|
|
|
|
|
sub bighex { |
620
|
4
|
|
|
4
|
0
|
10
|
my ($hex) = @_; |
621
|
|
|
|
|
|
|
|
622
|
|
|
|
|
|
|
# hex() warns for 64-bit numbers like 0x10000000 |
623
|
|
|
|
|
|
|
# (Hexadecimal number > 0xffffffff non-portable) |
624
|
|
|
|
|
|
|
# php converts such numbers to float. |
625
|
|
|
|
|
|
|
# |
626
|
|
|
|
|
|
|
# The 'use bigint qw/hex/' workaround would transparently |
627
|
|
|
|
|
|
|
# use Math::BigInt internally. So convert 64-bit floats |
628
|
|
|
|
|
|
|
# manually to float. |
629
|
|
|
|
|
|
|
# |
630
|
|
|
|
|
|
|
# also: perl warns for '0X'-prefix - php not |
631
|
|
|
|
|
|
|
# |
632
|
4
|
100
|
|
|
|
14
|
if (length($hex) <= 10) { |
633
|
3
|
50
|
|
|
|
12
|
if ($hex =~ /^0X(.*)$/) { |
634
|
0
|
|
|
|
|
0
|
return hex($1); |
635
|
|
|
|
|
|
|
} else { |
636
|
3
|
|
|
|
|
14
|
return hex($hex); |
637
|
|
|
|
|
|
|
} |
638
|
|
|
|
|
|
|
} |
639
|
1
|
|
|
|
|
9
|
my ($high, $low) = $hex =~ /^0[xX]([0-9a-fA-F]{1,8})([0-9a-fA-F]{8})$/; |
640
|
1
|
50
|
|
|
|
5
|
unless (defined $high) { |
641
|
0
|
|
|
|
|
0
|
warn "$hex is not a 64-bit hex number"; |
642
|
0
|
|
|
|
|
0
|
return hex($hex); |
643
|
|
|
|
|
|
|
} |
644
|
|
|
|
|
|
|
# with 32bit integers perl truncates (1 << 32) to 0x1 |
645
|
|
|
|
|
|
|
# |
646
|
1
|
50
|
|
|
|
101
|
if ($Config{ivsize} == 4) { |
647
|
6
|
|
|
6
|
|
3305
|
use bigint; |
|
6
|
|
|
|
|
30212
|
|
|
6
|
|
|
|
|
29
|
|
648
|
0
|
|
|
|
|
0
|
return hex("0x$low") + (hex("0x$high") << 32); |
649
|
|
|
|
|
|
|
} else { |
650
|
1
|
|
|
|
|
27
|
return hex("0x$low") + (hex("0x$high") << 32); |
651
|
|
|
|
|
|
|
} |
652
|
|
|
|
|
|
|
} |
653
|
|
|
|
|
|
|
|
654
|
|
|
|
|
|
|
# override methods inherited from PhpTokenizer |
655
|
|
|
|
|
|
|
{ |
656
|
|
|
|
|
|
|
sub add { |
657
|
3143
|
|
|
3143
|
0
|
7729
|
my ($tab, $sym) = @_; |
658
|
3143
|
|
|
|
|
4542
|
push(@{$tab->{tok}}, $sym); |
|
3143
|
|
|
|
|
6562
|
|
659
|
3143
|
|
|
|
|
5760
|
return; |
660
|
|
|
|
|
|
|
} |
661
|
|
|
|
|
|
|
sub add_open { |
662
|
2271
|
|
|
2271
|
0
|
5774
|
my ($tab, $sym) = @_; |
663
|
2271
|
|
|
|
|
3472
|
push(@{$tab->{tok}}, $sym); |
|
2271
|
|
|
|
|
4804
|
|
664
|
2271
|
|
|
|
|
4215
|
return; |
665
|
|
|
|
|
|
|
} |
666
|
|
|
|
|
|
|
sub add_close { |
667
|
2263
|
|
|
2263
|
0
|
5853
|
my ($tab, $sym) = @_; |
668
|
2263
|
|
|
|
|
3399
|
my $pos = scalar @{$tab->{tok}}; |
|
2263
|
|
|
|
|
3876
|
|
669
|
|
|
|
|
|
|
|
670
|
|
|
|
|
|
|
# join string literals with '.' operator if possible |
671
|
|
|
|
|
|
|
# (this should also be done by php_decode) |
672
|
|
|
|
|
|
|
# |
673
|
2263
|
100
|
66
|
|
|
13463
|
if (defined $tab->{strmap} |
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
674
|
|
|
|
|
|
|
&& ($sym eq ')') |
675
|
|
|
|
|
|
|
&& ($pos > 2) |
676
|
|
|
|
|
|
|
&& ($tab->{tok}->[$pos-1] =~ /^#num\d+$/) |
677
|
|
|
|
|
|
|
&& ($tab->{tok}->[$pos-2] eq '(') |
678
|
|
|
|
|
|
|
&& ($tab->{tok}->[$pos-3] =~ /^chr$/i)) { |
679
|
6
|
|
|
|
|
16
|
my $val = $tab->{strmap}->{$tab->{tok}->[$pos-1]}; |
680
|
6
|
50
|
|
|
|
17
|
if ($val != 0) { |
681
|
6
|
|
|
|
|
18
|
my $ch = chr(int($val) & 0xff); |
682
|
6
|
|
|
|
|
11
|
pop(@{$tab->{tok}}); |
|
6
|
|
|
|
|
26
|
|
683
|
6
|
|
|
|
|
12
|
pop(@{$tab->{tok}}); |
|
6
|
|
|
|
|
8
|
|
684
|
6
|
|
|
|
|
13
|
pop(@{$tab->{tok}}); |
|
6
|
|
|
|
|
10
|
|
685
|
|
|
|
|
|
|
#$tab->{log}->('tokenize', "CHR chr($val) [$ch]") if $tab->{log}; |
686
|
6
|
|
|
|
|
18
|
$tab->add_str($ch); |
687
|
|
|
|
|
|
|
} else { |
688
|
0
|
|
|
|
|
0
|
push(@{$tab->{tok}}, $sym); |
|
0
|
|
|
|
|
0
|
|
689
|
|
|
|
|
|
|
} |
690
|
|
|
|
|
|
|
} else { |
691
|
2257
|
|
|
|
|
3272
|
push(@{$tab->{tok}}, $sym); |
|
2257
|
|
|
|
|
4806
|
|
692
|
|
|
|
|
|
|
} |
693
|
2263
|
|
|
|
|
4509
|
return; |
694
|
|
|
|
|
|
|
} |
695
|
|
|
|
|
|
|
sub add_white { |
696
|
3493
|
|
|
3493
|
0
|
8200
|
my ($tab, $sym) = @_; |
697
|
3493
|
100
|
|
|
|
7295
|
if ($sym eq "\n") { |
698
|
6
|
|
|
|
|
13
|
$tab->{strmap}->{'__LINE__'} += 1; |
699
|
6
|
50
|
|
|
|
15
|
$tab->{debug}->('tokenize', "set linenum: %d", $tab->{strmap}->{'__LINE__'}) if $tab->{debug}; |
700
|
|
|
|
|
|
|
} |
701
|
|
|
|
|
|
|
#push(@{$tab->{tok}}, ' '); |
702
|
3493
|
|
|
|
|
6296
|
return; |
703
|
|
|
|
|
|
|
} |
704
|
|
|
|
|
|
|
sub add_comment { |
705
|
8
|
|
|
8
|
0
|
28
|
my ($tab, $sym) = @_; |
706
|
|
|
|
|
|
|
#push(@{$tab->{tok}}, "/*$sym*/"); |
707
|
8
|
|
|
|
|
18
|
return; |
708
|
|
|
|
|
|
|
} |
709
|
|
|
|
|
|
|
sub add_sym { |
710
|
2187
|
|
|
2187
|
0
|
5738
|
my ($tab, $sym) = @_; |
711
|
2187
|
100
|
|
|
|
4475
|
if ($sym eq '__LINE__') { |
712
|
|
|
|
|
|
|
# TODO: track line-number for each symbol, so that |
713
|
|
|
|
|
|
|
# it is also valid in eval()-code? |
714
|
|
|
|
|
|
|
# |
715
|
4
|
|
|
|
|
21
|
$tab->{warn}->('tokenize', "substitute __LINE__ with %d", $tab->{strmap}->{'__LINE__'}); |
716
|
4
|
|
|
|
|
160
|
my $k = $tab->setnum($tab->{strmap}->{'__LINE__'}); |
717
|
4
|
|
|
|
|
10
|
push(@{$tab->{tok}}, $k); |
|
4
|
|
|
|
|
8
|
|
718
|
|
|
|
|
|
|
} else { |
719
|
2183
|
|
|
|
|
2903
|
push(@{$tab->{tok}}, $sym); |
|
2183
|
|
|
|
|
4684
|
|
720
|
|
|
|
|
|
|
} |
721
|
2187
|
|
|
|
|
4203
|
return; |
722
|
|
|
|
|
|
|
} |
723
|
|
|
|
|
|
|
sub add_var { |
724
|
1780
|
|
|
1780
|
0
|
4770
|
my ($tab, $sym) = @_; |
725
|
1780
|
|
|
|
|
2814
|
push(@{$tab->{tok}}, '$'.$sym); |
|
1780
|
|
|
|
|
4482
|
|
726
|
1780
|
|
|
|
|
3554
|
return; |
727
|
|
|
|
|
|
|
} |
728
|
|
|
|
|
|
|
sub add_str { |
729
|
1041
|
|
|
1041
|
0
|
2001
|
my ($tab, $sym) = @_; |
730
|
|
|
|
|
|
|
|
731
|
1041
|
50
|
|
|
|
2125
|
if (defined $tab->{strmap}) { |
732
|
1041
|
|
|
|
|
1422
|
my $pos = scalar @{$tab->{tok}}; |
|
1041
|
|
|
|
|
1831
|
|
733
|
|
|
|
|
|
|
|
734
|
|
|
|
|
|
|
# join string literals with '.' operator if possible |
735
|
|
|
|
|
|
|
# (this should also be done by php_decode) |
736
|
|
|
|
|
|
|
# |
737
|
1041
|
100
|
100
|
|
|
4668
|
if (($pos > 1) && ($tab->{tok}->[$pos-1] eq '.') && ($tab->{tok}->[$pos-2] =~ /^#str\d+$/)) { |
|
|
|
100
|
|
|
|
|
738
|
11
|
|
|
|
|
35
|
my $oldstr = $tab->{strmap}->{$tab->{tok}->[$pos-2]}; |
739
|
11
|
|
|
|
|
19
|
pop(@{$tab->{tok}}); |
|
11
|
|
|
|
|
17
|
|
740
|
11
|
|
|
|
|
21
|
pop(@{$tab->{tok}}); |
|
11
|
|
|
|
|
19
|
|
741
|
|
|
|
|
|
|
#$tab->{log}->('tokenize', "JOIN $oldstr . $sym") if $tab->{log}; |
742
|
11
|
|
|
|
|
27
|
$sym = $oldstr . $sym; |
743
|
|
|
|
|
|
|
} |
744
|
|
|
|
|
|
|
|
745
|
|
|
|
|
|
|
# remember last linenum for each new #str symbol |
746
|
|
|
|
|
|
|
# |
747
|
1041
|
|
|
|
|
4159
|
$tab->{strmap}->{'__LINEMAP__'}{"#str$stridx"} = $tab->{strmap}->{'__LINE__'}; |
748
|
|
|
|
|
|
|
|
749
|
|
|
|
|
|
|
# substitute: 'str' -> #str$i |
750
|
|
|
|
|
|
|
# |
751
|
1041
|
|
|
|
|
2231
|
my $k = $tab->setstr($sym); |
752
|
1041
|
|
|
|
|
1583
|
push(@{$tab->{tok}}, $k); |
|
1041
|
|
|
|
|
2502
|
|
753
|
|
|
|
|
|
|
} else { |
754
|
0
|
|
|
|
|
0
|
push(@{$tab->{tok}}, '\''); |
|
0
|
|
|
|
|
0
|
|
755
|
0
|
|
|
|
|
0
|
push(@{$tab->{tok}}, $sym); |
|
0
|
|
|
|
|
0
|
|
756
|
0
|
|
|
|
|
0
|
push(@{$tab->{tok}}, '\''); |
|
0
|
|
|
|
|
0
|
|
757
|
|
|
|
|
|
|
} |
758
|
1041
|
|
|
|
|
2098
|
return; |
759
|
|
|
|
|
|
|
} |
760
|
|
|
|
|
|
|
sub add_num { |
761
|
538
|
|
|
538
|
0
|
1079
|
my ($tab, $sym) = @_; |
762
|
|
|
|
|
|
|
|
763
|
538
|
50
|
|
|
|
1140
|
if (defined $tab->{strmap}) { |
764
|
|
|
|
|
|
|
# substitute: number -> #num$i |
765
|
|
|
|
|
|
|
# |
766
|
538
|
|
|
|
|
746
|
my $num; |
767
|
538
|
100
|
|
|
|
1794
|
if ($sym =~ /^0[xX][0-9a-fA-F]+$/) { |
|
|
50
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
768
|
|
|
|
|
|
|
#$num = hex($sym); |
769
|
4
|
|
|
|
|
17
|
$num = bighex($sym); |
770
|
|
|
|
|
|
|
} elsif ($sym =~ /^0[0-7]+$/) { |
771
|
0
|
|
|
|
|
0
|
$num = oct($sym); |
772
|
|
|
|
|
|
|
} elsif ($sym =~ /^[0-9]*\.[0-9]*/) { |
773
|
6
|
|
|
|
|
25
|
$num = $sym * 1; |
774
|
|
|
|
|
|
|
} else { |
775
|
528
|
|
|
|
|
793
|
$num = $sym; |
776
|
|
|
|
|
|
|
} |
777
|
538
|
|
|
|
|
1199
|
my $k = $tab->setnum($num); |
778
|
538
|
|
|
|
|
807
|
push(@{$tab->{tok}}, $k); |
|
538
|
|
|
|
|
1182
|
|
779
|
|
|
|
|
|
|
} else { |
780
|
0
|
|
|
|
|
0
|
push(@{$tab->{tok}}, $sym); |
|
0
|
|
|
|
|
0
|
|
781
|
|
|
|
|
|
|
} |
782
|
538
|
|
|
|
|
1122
|
return; |
783
|
|
|
|
|
|
|
} |
784
|
|
|
|
|
|
|
sub add_script_start { |
785
|
8
|
|
|
8
|
0
|
18
|
my ($tab, $sym) = @_; |
786
|
|
|
|
|
|
|
#push(@{$tab->{tok}}, $sym); |
787
|
8
|
|
|
|
|
17
|
return; |
788
|
|
|
|
|
|
|
} |
789
|
|
|
|
|
|
|
sub add_script_end { |
790
|
799
|
|
|
799
|
0
|
1895
|
my ($tab, $sym) = @_; |
791
|
|
|
|
|
|
|
#push(@{$tab->{tok}}, $sym); |
792
|
799
|
|
|
|
|
1539
|
return; |
793
|
|
|
|
|
|
|
} |
794
|
|
|
|
|
|
|
sub add_noscript { |
795
|
8
|
|
|
8
|
0
|
18
|
my ($tab, $sym) = @_; |
796
|
|
|
|
|
|
|
|
797
|
8
|
100
|
100
|
|
|
13
|
if ((scalar @{$tab->{tok}} > 0) && ($tab->{tok}->[-1] ne ';')) { |
|
8
|
|
|
|
|
35
|
|
798
|
|
|
|
|
|
|
# append ';' if missing at end of php-block |
799
|
1
|
|
|
|
|
4
|
$tab->add(';'); |
800
|
|
|
|
|
|
|
} |
801
|
8
|
|
|
|
|
90
|
$tab->add_sym('echo'); |
802
|
8
|
|
|
|
|
23
|
$tab->add_str($sym); |
803
|
8
|
|
|
|
|
26
|
$tab->add(';'); |
804
|
8
|
|
|
|
|
20
|
$tab->add_script_end(''); |
805
|
8
|
|
|
|
|
17
|
return; |
806
|
|
|
|
|
|
|
} |
807
|
|
|
|
|
|
|
sub add_bad_open { |
808
|
0
|
|
|
0
|
0
|
0
|
my ($tab, $sym) = @_; |
809
|
|
|
|
|
|
|
|
810
|
0
|
|
|
|
|
0
|
$tab->{warn}->('tokenize', "in script got bad open %s", $sym); |
811
|
0
|
|
|
|
|
0
|
$tab->add($sym); |
812
|
0
|
|
|
|
|
0
|
return; |
813
|
|
|
|
|
|
|
} |
814
|
|
|
|
|
|
|
sub tok_dump { |
815
|
0
|
|
|
0
|
0
|
0
|
my ($tab) = @_; |
816
|
0
|
|
|
|
|
0
|
return join('', @{$tab->{tok}}); |
|
0
|
|
|
|
|
0
|
|
817
|
|
|
|
|
|
|
} |
818
|
|
|
|
|
|
|
sub tok_count { |
819
|
0
|
|
|
0
|
0
|
0
|
my ($tab) = @_; |
820
|
0
|
|
|
|
|
0
|
return scalar @{$tab->{tok}}; |
|
0
|
|
|
|
|
0
|
|
821
|
|
|
|
|
|
|
} |
822
|
|
|
|
|
|
|
} |
823
|
|
|
|
|
|
|
|
824
|
|
|
|
|
|
|
# http://php.net/manual/en/reserved.keywords.php |
825
|
|
|
|
|
|
|
# |
826
|
|
|
|
|
|
|
my %php_keywords = map { $_ => 1 } ('__halt_compiler', 'abstract', 'and', 'array', 'as', 'break', 'callable', 'case', 'catch', 'class', 'clone', 'const', 'continue', 'declare', 'default', 'die', 'do', 'echo', 'else', 'elseif', 'empty', 'enddeclare', 'endfor', 'endforeach', 'endif', 'endswitch', 'endwhile', 'eval', 'exit', 'extends', 'final', 'for', 'foreach', 'function', 'global', 'goto', 'if', 'implements', 'include', 'include_once', 'instanceof', 'insteadof', 'interface', 'isset', 'list', 'namespace', 'new', 'or', 'print', 'private', 'protected', 'public', 'readonly', 'require', 'require_once', 'return', 'static', 'switch', 'throw', 'trait', 'try', 'unset', 'use', 'var', 'while', 'xor'); |
827
|
|
|
|
|
|
|
|
828
|
|
|
|
|
|
|
my %php_modifiers = map { $_ => 1 } ('const', 'final', 'private', 'protected', 'public', 'readonly', 'static', 'var'); |
829
|
|
|
|
|
|
|
|
830
|
|
|
|
|
|
|
# All magic constants are resolved at compile time |
831
|
|
|
|
|
|
|
# https://www.php.net/manual/en/language.constants.magic.php |
832
|
|
|
|
|
|
|
# |
833
|
|
|
|
|
|
|
my %magic_constants = map { $_ => 1 } ('__CLASS__', '__DIR__', '__FILE__', '__FUNCTION__', '__LINE__', '__METHOD__', '__NAMESPACE__', '__TRAIT__', 'ClassName::class'); |
834
|
|
|
|
|
|
|
|
835
|
|
|
|
|
|
|
# builtin types: https://www.php.net/manual/en/language.types.intro.php |
836
|
|
|
|
|
|
|
# |
837
|
|
|
|
|
|
|
use constant { |
838
|
6
|
|
|
|
|
154844
|
T_VOID => 0x0001, |
839
|
|
|
|
|
|
|
T_INT => 0x0002, |
840
|
|
|
|
|
|
|
T_FLOAT => 0x0004, |
841
|
|
|
|
|
|
|
T_BOOL => 0x0008, |
842
|
|
|
|
|
|
|
T_STR => 0x0010, |
843
|
|
|
|
|
|
|
T_ARRAY => 0x0020, |
844
|
|
|
|
|
|
|
T_OBJECT => 0x0040, |
845
|
|
|
|
|
|
|
T_CALL => 0x0080, |
846
|
|
|
|
|
|
|
T_MASK => 0xffff, |
847
|
6
|
|
|
6
|
|
307501
|
}; |
|
6
|
|
|
|
|
15
|
|
848
|
|
|
|
|
|
|
|
849
|
|
|
|
|
|
|
|
850
|
|
|
|
|
|
|
# see: http://perldoc.perl.org/perlop.html#Operator-Precedence-and-Associativity |
851
|
|
|
|
|
|
|
# http://php.net/manual/en/language.operators.precedence.php |
852
|
|
|
|
|
|
|
# |
853
|
|
|
|
|
|
|
my %op_prio = ( |
854
|
|
|
|
|
|
|
'\\' => 0, |
855
|
|
|
|
|
|
|
'->' => 1, |
856
|
|
|
|
|
|
|
'::' => 1, |
857
|
|
|
|
|
|
|
'+-' => 2, # sign |
858
|
|
|
|
|
|
|
'$' => 2, |
859
|
|
|
|
|
|
|
'++' => 2, |
860
|
|
|
|
|
|
|
'--' => 2, |
861
|
|
|
|
|
|
|
'new'=> 2, # unary |
862
|
|
|
|
|
|
|
'**' => 3, |
863
|
|
|
|
|
|
|
'!' => 4, # unary |
864
|
|
|
|
|
|
|
'~' => 4, # unary |
865
|
|
|
|
|
|
|
'*' => 5, |
866
|
|
|
|
|
|
|
'/' => 5, |
867
|
|
|
|
|
|
|
'%' => 5, |
868
|
|
|
|
|
|
|
'+' => 6, |
869
|
|
|
|
|
|
|
'-' => 6, |
870
|
|
|
|
|
|
|
'.' => 6, |
871
|
|
|
|
|
|
|
'<<' => 7, |
872
|
|
|
|
|
|
|
'>>' => 7, |
873
|
|
|
|
|
|
|
'<' => 8, |
874
|
|
|
|
|
|
|
'>' => 8, |
875
|
|
|
|
|
|
|
'<=' => 8, |
876
|
|
|
|
|
|
|
'>=' => 8, |
877
|
|
|
|
|
|
|
'lt' => 8, # (does not exist in php5-8) |
878
|
|
|
|
|
|
|
'gt' => 8, # (does not exist in php5-8) |
879
|
|
|
|
|
|
|
'le' => 8, # (does not exist in php5-8) |
880
|
|
|
|
|
|
|
'ge' => 8, # (does not exist in php5-8) |
881
|
|
|
|
|
|
|
'==' => 9, |
882
|
|
|
|
|
|
|
'!=' => 9, |
883
|
|
|
|
|
|
|
'<>' => 9, # diamond seems to work as != even if not documented |
884
|
|
|
|
|
|
|
'===' => 9, |
885
|
|
|
|
|
|
|
'!==' => 9, |
886
|
|
|
|
|
|
|
'<=>' => 9, # spaceship since php7 |
887
|
|
|
|
|
|
|
'eq' => 9, # (does not exist in php5-8) |
888
|
|
|
|
|
|
|
'ne' => 9, # (does not exist in php5-8) |
889
|
|
|
|
|
|
|
'&' => 10, |
890
|
|
|
|
|
|
|
'^' => 11, |
891
|
|
|
|
|
|
|
'|' => 12, |
892
|
|
|
|
|
|
|
'&&' => 13, |
893
|
|
|
|
|
|
|
'||' => 14, |
894
|
|
|
|
|
|
|
'??' => 15, # right since php7 |
895
|
|
|
|
|
|
|
':' => 16, # right |
896
|
|
|
|
|
|
|
'?' => 17, # right |
897
|
|
|
|
|
|
|
'?:' => 17, # right |
898
|
|
|
|
|
|
|
'=' => 18, # right |
899
|
|
|
|
|
|
|
'not'=> 19, # right (does not exist in php5-8) |
900
|
|
|
|
|
|
|
'and'=> 20, |
901
|
|
|
|
|
|
|
'or' => 21, |
902
|
|
|
|
|
|
|
'xor'=> 21, |
903
|
|
|
|
|
|
|
'instanceof'=> 21, |
904
|
|
|
|
|
|
|
'...'=> 22, # ellipses |
905
|
|
|
|
|
|
|
); |
906
|
|
|
|
|
|
|
|
907
|
|
|
|
|
|
|
my %op_right = ( |
908
|
|
|
|
|
|
|
'**' => 1, # right associative |
909
|
|
|
|
|
|
|
'->' => 1, # right associative |
910
|
|
|
|
|
|
|
'::' => 1, # right associative |
911
|
|
|
|
|
|
|
'??' => 1, # right associative |
912
|
|
|
|
|
|
|
'$' => 1, # right associative |
913
|
|
|
|
|
|
|
'=' => 1, # right associative |
914
|
|
|
|
|
|
|
); |
915
|
|
|
|
|
|
|
|
916
|
|
|
|
|
|
|
my %op_unary = ( |
917
|
|
|
|
|
|
|
'new'=> 1, # unary |
918
|
|
|
|
|
|
|
'!' => 1, # unary |
919
|
|
|
|
|
|
|
'~' => 1, # unary |
920
|
|
|
|
|
|
|
'?' => 1, # in ternary (dummy for op_prio) |
921
|
|
|
|
|
|
|
':' => 1, # in ternary (dummy for op_prio) |
922
|
|
|
|
|
|
|
); |
923
|
|
|
|
|
|
|
|
924
|
|
|
|
|
|
|
# Variables, constants & function names: ^[a-zA-Z_\x80-\xff][a-zA-Z0-9_\x80-\xff]*$ |
925
|
|
|
|
|
|
|
# see: https://www.php.net/manual/en/language.variables.basics.php |
926
|
|
|
|
|
|
|
# see: https://www.php.net/manual/en/language.constants.php |
927
|
|
|
|
|
|
|
# see: https://www.php.net/manual/en/functions.user-defined.php |
928
|
|
|
|
|
|
|
# |
929
|
|
|
|
|
|
|
sub is_variable { |
930
|
21476
|
|
|
21476
|
0
|
35770
|
my ($s) = @_; |
931
|
|
|
|
|
|
|
|
932
|
|
|
|
|
|
|
# represent global vars as $GLOBALS$varname |
933
|
|
|
|
|
|
|
# represent class vars as $classname$varname |
934
|
|
|
|
|
|
|
# represent instance vars as $#instNNN$varname |
935
|
|
|
|
|
|
|
# represent non symbol ${"xxx"} vars also as $#instNNN$varname |
936
|
|
|
|
|
|
|
# |
937
|
21476
|
100
|
|
|
|
57799
|
if ($s =~/^\$(GLOBALS\$|#inst\d+\$|[\w\x80-\xff]+\$)?(\$|[^\$]*)$/) { |
938
|
7443
|
|
|
|
|
20773
|
return 1; |
939
|
|
|
|
|
|
|
} |
940
|
14033
|
|
|
|
|
40715
|
return 0; |
941
|
|
|
|
|
|
|
} |
942
|
|
|
|
|
|
|
|
943
|
|
|
|
|
|
|
sub is_strict_variable { |
944
|
10339
|
|
|
10339
|
0
|
20044
|
my ($s) = @_; |
945
|
|
|
|
|
|
|
|
946
|
10339
|
100
|
|
|
|
29402
|
if ($s =~/^\$(GLOBALS\$|#inst\d+\$|[\w\x80-\xff]+\$)?[a-zA-Z_\x80-\xff][a-zA-Z0-9_\x80-\xff]*$/) { |
947
|
4442
|
|
|
|
|
26235
|
return 1; |
948
|
|
|
|
|
|
|
} |
949
|
5897
|
|
|
|
|
30588
|
return 0; |
950
|
|
|
|
|
|
|
} |
951
|
|
|
|
|
|
|
|
952
|
|
|
|
|
|
|
sub is_symbol { |
953
|
2086
|
|
|
2086
|
0
|
4576
|
my ($s) = @_; |
954
|
|
|
|
|
|
|
|
955
|
2086
|
100
|
|
|
|
6412
|
if ($s =~/^[a-zA-Z_\x80-\xff][a-zA-Z0-9_\x80-\xff]*$/) { |
956
|
1814
|
|
|
|
|
5272
|
return 1; |
957
|
|
|
|
|
|
|
} |
958
|
272
|
|
|
|
|
1395
|
return 0; |
959
|
|
|
|
|
|
|
} |
960
|
|
|
|
|
|
|
|
961
|
|
|
|
|
|
|
sub is_magic_const { |
962
|
17
|
|
|
17
|
0
|
35
|
my ($self, $s) = @_; |
963
|
|
|
|
|
|
|
|
964
|
17
|
50
|
|
|
|
87
|
if ($s =~ /^#const\d+$/) { |
965
|
17
|
100
|
|
|
|
65
|
if (exists $magic_constants{$self->{strmap}->{$s}}) { |
966
|
12
|
|
|
|
|
81
|
return $self->{strmap}->{$s}; |
967
|
|
|
|
|
|
|
} |
968
|
|
|
|
|
|
|
} |
969
|
5
|
|
|
|
|
47
|
return; |
970
|
|
|
|
|
|
|
} |
971
|
|
|
|
|
|
|
|
972
|
|
|
|
|
|
|
# check if statement is empty block |
973
|
|
|
|
|
|
|
# |
974
|
|
|
|
|
|
|
sub is_empty_block { |
975
|
148
|
|
|
148
|
0
|
294
|
my ($self, $s) = @_; |
976
|
|
|
|
|
|
|
|
977
|
148
|
100
|
|
|
|
287
|
if (is_block($s)) { |
978
|
84
|
|
|
|
|
131
|
my ($type, $a) = @{$self->{strmap}->{$s}}; |
|
84
|
|
|
|
|
217
|
|
979
|
84
|
100
|
|
|
|
214
|
if (scalar @$a == 0) { |
980
|
79
|
|
|
|
|
203
|
return 1; |
981
|
|
|
|
|
|
|
} |
982
|
|
|
|
|
|
|
} |
983
|
69
|
|
|
|
|
182
|
return 0; |
984
|
|
|
|
|
|
|
} |
985
|
|
|
|
|
|
|
|
986
|
|
|
|
|
|
|
# flatten block (and remove #null statements) |
987
|
|
|
|
|
|
|
# |
988
|
|
|
|
|
|
|
sub flatten_block { |
989
|
3793
|
|
|
3793
|
0
|
6929
|
my ($self, $s, $out) = @_; |
990
|
|
|
|
|
|
|
|
991
|
3793
|
100
|
|
|
|
6419
|
if (is_block($s)) { |
992
|
694
|
|
|
|
|
980
|
my ($type, $a) = @{$self->{strmap}{$s}}; |
|
694
|
|
|
|
|
1599
|
|
993
|
694
|
|
|
|
|
1360
|
foreach my $stmt (@$a) { |
994
|
876
|
|
|
|
|
1724
|
$self->flatten_block($stmt, $out); |
995
|
|
|
|
|
|
|
} |
996
|
|
|
|
|
|
|
} else { |
997
|
3099
|
100
|
|
|
|
5656
|
if ($s ne '#null') { |
998
|
2996
|
|
|
|
|
5600
|
push(@$out, $s); |
999
|
|
|
|
|
|
|
} |
1000
|
|
|
|
|
|
|
} |
1001
|
3793
|
|
|
|
|
8496
|
return; |
1002
|
|
|
|
|
|
|
} |
1003
|
|
|
|
|
|
|
|
1004
|
|
|
|
|
|
|
# flatten block with single statement |
1005
|
|
|
|
|
|
|
# |
1006
|
|
|
|
|
|
|
sub flatten_block_if_single { |
1007
|
245
|
|
|
245
|
0
|
545
|
my ($self, $s) = @_; |
1008
|
|
|
|
|
|
|
|
1009
|
245
|
100
|
|
|
|
499
|
if (is_block($s)) { |
1010
|
238
|
|
|
|
|
367
|
my ($type, $a) = @{$self->{strmap}{$s}}; |
|
238
|
|
|
|
|
578
|
|
1011
|
238
|
100
|
|
|
|
657
|
if (scalar @$a == 1) { |
1012
|
147
|
|
|
|
|
426
|
return $a->[0]; |
1013
|
|
|
|
|
|
|
} |
1014
|
|
|
|
|
|
|
} |
1015
|
98
|
|
|
|
|
256
|
return $s; |
1016
|
|
|
|
|
|
|
} |
1017
|
|
|
|
|
|
|
|
1018
|
|
|
|
|
|
|
# create and split global var |
1019
|
|
|
|
|
|
|
# |
1020
|
|
|
|
|
|
|
sub global_var { |
1021
|
59
|
|
|
59
|
0
|
116
|
my ($global) = @_; |
1022
|
59
|
|
|
|
|
158
|
return '$GLOBALS' . $global; |
1023
|
|
|
|
|
|
|
} |
1024
|
|
|
|
|
|
|
|
1025
|
|
|
|
|
|
|
sub global_split { |
1026
|
6053
|
|
|
6053
|
0
|
10272
|
my ($var) = @_; |
1027
|
6053
|
|
|
|
|
10372
|
my ($global) = $var =~ /^\$GLOBALS(\$.*)$/; |
1028
|
6053
|
|
|
|
|
12762
|
return $global; |
1029
|
|
|
|
|
|
|
} |
1030
|
|
|
|
|
|
|
|
1031
|
|
|
|
|
|
|
# create and split method name |
1032
|
|
|
|
|
|
|
# |
1033
|
|
|
|
|
|
|
sub method_name { |
1034
|
354
|
|
|
354
|
0
|
705
|
my ($class, $name) = @_; |
1035
|
354
|
|
|
|
|
996
|
return $class . '::' . $name; |
1036
|
|
|
|
|
|
|
} |
1037
|
|
|
|
|
|
|
|
1038
|
|
|
|
|
|
|
sub method_split { |
1039
|
2080
|
|
|
2080
|
0
|
3423
|
my ($method) = @_; |
1040
|
|
|
|
|
|
|
# allow namespace prefix |
1041
|
2080
|
|
|
|
|
4549
|
my ($class, $name) = $method =~ /^(#inst\d+|[\w\x80-\xff\\]+)::([\w\x80-\xff]+)$/; |
1042
|
2080
|
|
|
|
|
4765
|
return ($class, $name); |
1043
|
|
|
|
|
|
|
} |
1044
|
|
|
|
|
|
|
|
1045
|
|
|
|
|
|
|
# create and split instance var |
1046
|
|
|
|
|
|
|
# |
1047
|
|
|
|
|
|
|
sub inst_var { |
1048
|
53
|
|
|
53
|
0
|
142
|
my ($inst, $var) = @_; |
1049
|
53
|
|
|
|
|
174
|
return '$' . $inst . $var; |
1050
|
|
|
|
|
|
|
} |
1051
|
|
|
|
|
|
|
|
1052
|
|
|
|
|
|
|
sub inst_split { |
1053
|
7042
|
|
|
7042
|
0
|
11471
|
my ($instvar) = @_; |
1054
|
7042
|
|
|
|
|
12599
|
my ($inst, $var) = $instvar =~ /^\$(#inst\d+|[\w\x80-\xff]+)(\$.*)$/; |
1055
|
7042
|
|
|
|
|
15420
|
return ($inst, $var); |
1056
|
|
|
|
|
|
|
} |
1057
|
|
|
|
|
|
|
|
1058
|
|
|
|
|
|
|
# create and split namespace name |
1059
|
|
|
|
|
|
|
# |
1060
|
|
|
|
|
|
|
sub ns_name { |
1061
|
31
|
|
|
31
|
0
|
58
|
my ($name, $elem) = @_; |
1062
|
31
|
|
|
|
|
95
|
return $name . '\\' . $elem; |
1063
|
|
|
|
|
|
|
} |
1064
|
|
|
|
|
|
|
|
1065
|
|
|
|
|
|
|
sub ns_split { |
1066
|
0
|
|
|
0
|
0
|
0
|
my ($name) = @_; |
1067
|
0
|
|
|
|
|
0
|
my ($ns, $elem) = $name =~ /^([^\\]*)\\(.+)$/; |
1068
|
0
|
|
|
|
|
0
|
return ($ns, $elem); |
1069
|
|
|
|
|
|
|
} |
1070
|
|
|
|
|
|
|
|
1071
|
|
|
|
|
|
|
# create path from namespace |
1072
|
|
|
|
|
|
|
# |
1073
|
|
|
|
|
|
|
sub ns_to_str { |
1074
|
14
|
|
|
14
|
0
|
25
|
my ($self, $var) = @_; |
1075
|
|
|
|
|
|
|
|
1076
|
14
|
100
|
|
|
|
45
|
if ($var =~ /^#ns\d+$/) { |
|
|
100
|
|
|
|
|
|
1077
|
3
|
|
|
|
|
5
|
my ($n, $e) = @{$self->{strmap}{$var}}; |
|
3
|
|
|
|
|
11
|
|
1078
|
|
|
|
|
|
|
|
1079
|
3
|
100
|
|
|
|
7
|
unless (defined $n) { |
1080
|
2
|
|
|
|
|
4
|
$n = ''; # toplevel |
1081
|
|
|
|
|
|
|
} |
1082
|
3
|
|
|
|
|
10
|
$e = $self->ns_to_str($e); |
1083
|
3
|
50
|
|
|
|
8
|
if (defined $e) { |
1084
|
3
|
|
|
|
|
18
|
return ns_name($n, $e); |
1085
|
|
|
|
|
|
|
} |
1086
|
|
|
|
|
|
|
} elsif (is_strval($var)) { |
1087
|
8
|
|
|
|
|
33
|
return $self->{strmap}{$var}; |
1088
|
|
|
|
|
|
|
} else { |
1089
|
3
|
|
|
|
|
17
|
return $var; |
1090
|
|
|
|
|
|
|
} |
1091
|
0
|
|
|
|
|
0
|
return; |
1092
|
|
|
|
|
|
|
} |
1093
|
|
|
|
|
|
|
|
1094
|
|
|
|
|
|
|
# create variable from variable variable |
1095
|
|
|
|
|
|
|
# $$var -> $val |
1096
|
|
|
|
|
|
|
# ${$var} -> $val |
1097
|
|
|
|
|
|
|
# |
1098
|
|
|
|
|
|
|
sub varvar_to_var { |
1099
|
90
|
|
|
90
|
0
|
198
|
my ($self, $var) = @_; |
1100
|
|
|
|
|
|
|
|
1101
|
90
|
100
|
|
|
|
173
|
if (is_strval($var)) { |
1102
|
79
|
|
|
|
|
167
|
my $str = $self->{strmap}{$var}; |
1103
|
|
|
|
|
|
|
|
1104
|
|
|
|
|
|
|
# variable names are only handled up to first '$'. |
1105
|
|
|
|
|
|
|
# also 'null' is allowed (represented as '' or ${null}) |
1106
|
|
|
|
|
|
|
# |
1107
|
79
|
|
|
|
|
300
|
my ($suffix) = $str =~ /^(\$$|[^\$]*)/; |
1108
|
79
|
|
|
|
|
295
|
return '$' . $suffix; |
1109
|
|
|
|
|
|
|
} |
1110
|
11
|
|
|
|
|
35
|
return; |
1111
|
|
|
|
|
|
|
} |
1112
|
|
|
|
|
|
|
|
1113
|
|
|
|
|
|
|
# $GLOBALS['str'] -> $str |
1114
|
|
|
|
|
|
|
# |
1115
|
|
|
|
|
|
|
sub globalvar_to_var { |
1116
|
604
|
|
|
604
|
0
|
1192
|
my ($self, $base, $idx) = @_; |
1117
|
|
|
|
|
|
|
|
1118
|
604
|
100
|
|
|
|
1386
|
if ($base =~ /^\$GLOBALS$/) { |
1119
|
124
|
|
|
|
|
316
|
my $idxval = $self->get_strval($idx); |
1120
|
124
|
100
|
|
|
|
284
|
if (defined $idxval) { |
1121
|
|
|
|
|
|
|
# variable names are only handled up to first '$'. |
1122
|
|
|
|
|
|
|
# also 'null' is allowed (represented as '' or ${null}) |
1123
|
|
|
|
|
|
|
# |
1124
|
123
|
|
|
|
|
404
|
my ($suffix) = $idxval =~ /^(\$$|[^\$]*)/; |
1125
|
123
|
|
|
|
|
436
|
return '$' . $suffix; |
1126
|
|
|
|
|
|
|
} |
1127
|
|
|
|
|
|
|
} |
1128
|
481
|
|
|
|
|
951
|
return; |
1129
|
|
|
|
|
|
|
} |
1130
|
|
|
|
|
|
|
|
1131
|
|
|
|
|
|
|
# return base var of multi dimensional elem |
1132
|
|
|
|
|
|
|
# |
1133
|
|
|
|
|
|
|
sub elem_base { |
1134
|
363
|
|
|
363
|
0
|
658
|
my ($self, $s) = @_; |
1135
|
|
|
|
|
|
|
|
1136
|
363
|
|
|
|
|
888
|
while ($s =~ /^#elem\d+$/) { |
1137
|
54
|
|
|
|
|
94
|
my ($v, $i) = @{$self->{strmap}->{$s}}; |
|
54
|
|
|
|
|
137
|
|
1138
|
|
|
|
|
|
|
|
1139
|
54
|
100
|
|
|
|
138
|
if (defined $i) { |
1140
|
|
|
|
|
|
|
# add resolvable globals |
1141
|
|
|
|
|
|
|
# |
1142
|
37
|
|
|
|
|
97
|
my $g = $self->globalvar_to_var($v, $i); |
1143
|
37
|
100
|
|
|
|
104
|
if (defined $g) { |
1144
|
8
|
|
|
|
|
31
|
$g = global_var($g); |
1145
|
8
|
|
|
|
|
24
|
return $g; |
1146
|
|
|
|
|
|
|
} |
1147
|
|
|
|
|
|
|
} |
1148
|
46
|
|
|
|
|
161
|
$s = $v; |
1149
|
|
|
|
|
|
|
} |
1150
|
355
|
|
|
|
|
725
|
return $s; |
1151
|
|
|
|
|
|
|
} |
1152
|
|
|
|
|
|
|
|
1153
|
|
|
|
|
|
|
sub getline { |
1154
|
0
|
|
|
0
|
0
|
0
|
my ($self) = @_; |
1155
|
|
|
|
|
|
|
|
1156
|
|
|
|
|
|
|
#$self->{log}->('getline', "%d", $self->{strmap}->{'__LINE__'}) if $self->{log}; |
1157
|
0
|
|
|
|
|
0
|
return $self->{strmap}->{'__LINE__'}; |
1158
|
|
|
|
|
|
|
} |
1159
|
|
|
|
|
|
|
|
1160
|
|
|
|
|
|
|
sub updateline { |
1161
|
1027
|
|
|
1027
|
0
|
1843
|
my ($self, $var) = @_; |
1162
|
|
|
|
|
|
|
|
1163
|
|
|
|
|
|
|
#$self->{log}->('updateline', "test $var") if $self->{log}; |
1164
|
|
|
|
|
|
|
|
1165
|
|
|
|
|
|
|
# update line number based on preceeding string |
1166
|
|
|
|
|
|
|
# |
1167
|
1027
|
100
|
|
|
|
2624
|
if (exists $self->{strmap}->{'__LINEMAP__'}{$var}) { |
1168
|
1026
|
|
|
|
|
1620
|
my $val = $self->{strmap}->{'__LINEMAP__'}{$var}; |
1169
|
1026
|
50
|
|
|
|
2364
|
if ($self->{strmap}->{'__LINE__'} < $val) { |
1170
|
0
|
0
|
|
|
|
0
|
$self->{log}->('updateline', "[$var] %d -> %d", $self->{strmap}->{'__LINE__'}, $val) if $self->{log}; |
1171
|
0
|
|
|
|
|
0
|
$self->{strmap}->{'__LINE__'} = $val; |
1172
|
|
|
|
|
|
|
} |
1173
|
|
|
|
|
|
|
} |
1174
|
1027
|
|
|
|
|
1688
|
return; |
1175
|
|
|
|
|
|
|
} |
1176
|
|
|
|
|
|
|
|
1177
|
|
|
|
|
|
|
sub trim_list { |
1178
|
0
|
|
|
0
|
0
|
0
|
my ($list) = @_; |
1179
|
|
|
|
|
|
|
|
1180
|
0
|
|
0
|
|
|
0
|
while ((scalar @$list > 0) && ($list->[0] =~ /^\s+$/)) { |
1181
|
0
|
|
|
|
|
0
|
shift @$list; |
1182
|
|
|
|
|
|
|
} |
1183
|
0
|
|
0
|
|
|
0
|
while ((scalar @$list > 0) && ($list->[-1] =~ /^\s+$/)) { |
1184
|
0
|
|
|
|
|
0
|
pop @$list; |
1185
|
|
|
|
|
|
|
} |
1186
|
|
|
|
|
|
|
} |
1187
|
|
|
|
|
|
|
|
1188
|
|
|
|
|
|
|
sub unspace_list { |
1189
|
785
|
|
|
785
|
0
|
1273
|
my ($list) = @_; |
1190
|
|
|
|
|
|
|
# remove empty fields |
1191
|
785
|
|
|
|
|
1666
|
my @filtered = grep { $_ !~ /^\s+$/ } @$list; |
|
13177
|
|
|
|
|
27293
|
|
1192
|
|
|
|
|
|
|
|
1193
|
|
|
|
|
|
|
# remove comments |
1194
|
785
|
|
|
|
|
1531
|
@filtered = grep { $_ !~ /^\/\*.*\*\/$/ } @filtered; |
|
13177
|
|
|
|
|
24620
|
|
1195
|
|
|
|
|
|
|
|
1196
|
785
|
|
|
|
|
1854
|
return \@filtered; |
1197
|
|
|
|
|
|
|
} |
1198
|
|
|
|
|
|
|
|
1199
|
|
|
|
|
|
|
sub unquote_names { |
1200
|
6083
|
|
|
6083
|
0
|
10464
|
my ($str) = @_; |
1201
|
|
|
|
|
|
|
|
1202
|
|
|
|
|
|
|
# todo: is this really needed? |
1203
|
6083
|
|
|
|
|
7800
|
if (1) { |
1204
|
|
|
|
|
|
|
# \xXX |
1205
|
6083
|
|
|
|
|
11582
|
$str =~ s/\\x([0-9a-fA-F]{2})/chr(hex($1))/ge; |
|
0
|
|
|
|
|
0
|
|
1206
|
|
|
|
|
|
|
} |
1207
|
6083
|
|
|
|
|
11279
|
return $str; |
1208
|
|
|
|
|
|
|
} |
1209
|
|
|
|
|
|
|
|
1210
|
|
|
|
|
|
|
sub dump_line { |
1211
|
0
|
|
|
0
|
0
|
0
|
my ($self, $prefix, $tok) = @_; |
1212
|
|
|
|
|
|
|
|
1213
|
0
|
|
|
|
|
0
|
for (my $i=0; $i < scalar @$tok; $i++) { |
1214
|
0
|
|
|
|
|
0
|
my $word = $tok->[$i]; |
1215
|
|
|
|
|
|
|
|
1216
|
0
|
0
|
|
|
|
0
|
if ($word =~ /^#/) { |
1217
|
0
|
|
|
|
|
0
|
my $s = $self->shortstr($self->{strmap}->{$word}, 100); |
1218
|
0
|
|
|
|
|
0
|
print "$prefix> $word [$s]\n"; |
1219
|
|
|
|
|
|
|
} else { |
1220
|
0
|
|
|
|
|
0
|
my $t = unquote_names($word); |
1221
|
0
|
|
|
|
|
0
|
print "$prefix> $t [$word]\n"; |
1222
|
|
|
|
|
|
|
} |
1223
|
|
|
|
|
|
|
} |
1224
|
0
|
|
|
|
|
0
|
my $q = join('', @$tok); |
1225
|
0
|
|
|
|
|
0
|
print "$prefix> SHORTQ: $q\n"; |
1226
|
0
|
|
|
|
|
0
|
return; |
1227
|
|
|
|
|
|
|
} |
1228
|
|
|
|
|
|
|
|
1229
|
|
|
|
|
|
|
sub read_array { |
1230
|
145
|
|
|
145
|
0
|
328
|
my ($self, $tok, $close, $arr) = @_; |
1231
|
|
|
|
|
|
|
|
1232
|
145
|
|
|
|
|
265
|
while (1) { |
1233
|
244
|
50
|
|
|
|
577
|
if (scalar @$tok == 0) { |
1234
|
0
|
|
|
|
|
0
|
last; |
1235
|
|
|
|
|
|
|
} |
1236
|
244
|
100
|
|
|
|
580
|
if ($tok->[0] eq $close) { |
1237
|
25
|
|
|
|
|
55
|
shift @$tok; |
1238
|
25
|
|
|
|
|
51
|
last; |
1239
|
|
|
|
|
|
|
} |
1240
|
219
|
|
|
|
|
548
|
my $val = $self->read_statement($tok, undef); |
1241
|
219
|
50
|
33
|
|
|
889
|
if (!defined $val || ($val eq $close)) { |
1242
|
0
|
|
|
|
|
0
|
last; |
1243
|
|
|
|
|
|
|
} |
1244
|
219
|
100
|
|
|
|
435
|
if ($val eq ',') { |
1245
|
1
|
|
|
|
|
6
|
$arr->set(undef, undef); |
1246
|
1
|
|
|
|
|
1
|
next; # allow empty fields for list() |
1247
|
|
|
|
|
|
|
} |
1248
|
218
|
50
|
|
|
|
431
|
if (scalar @$tok > 0) { |
1249
|
218
|
100
|
|
|
|
577
|
if ($tok->[0] eq $close) { |
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
1250
|
103
|
|
|
|
|
186
|
shift @$tok; |
1251
|
103
|
|
|
|
|
417
|
$arr->set(undef, $val); |
1252
|
103
|
|
|
|
|
184
|
last; |
1253
|
|
|
|
|
|
|
} elsif ($tok->[0] eq ',') { |
1254
|
82
|
|
|
|
|
139
|
shift @$tok; |
1255
|
82
|
|
|
|
|
333
|
$arr->set(undef, $val); |
1256
|
82
|
|
|
|
|
180
|
next; |
1257
|
|
|
|
|
|
|
} elsif ($tok->[0] eq '=>') { |
1258
|
33
|
|
|
|
|
55
|
shift @$tok; |
1259
|
33
|
|
|
|
|
69
|
my $key = $val; |
1260
|
33
|
100
|
|
|
|
123
|
if ($key =~ /^#expr\d+$/) { |
|
|
100
|
|
|
|
|
|
1261
|
2
|
|
|
|
|
3
|
my ($op, $v1, $v2) = @{$self->{strmap}->{$key}}; |
|
2
|
|
|
|
|
23
|
|
1262
|
2
|
50
|
33
|
|
|
14
|
if (($op eq '-') && !defined $v1) { |
1263
|
2
|
|
|
|
|
11
|
my $str = $self->get_strval($v2); |
1264
|
2
|
50
|
33
|
|
|
15
|
if (defined $str && is_int_index($str)) { |
1265
|
2
|
|
|
|
|
10
|
$key = -$str; |
1266
|
|
|
|
|
|
|
} |
1267
|
|
|
|
|
|
|
} |
1268
|
|
|
|
|
|
|
} elsif (is_null($key)) { |
1269
|
1
|
|
|
|
|
11
|
$key = $self->setstr(''); # null maps to '' array index |
1270
|
|
|
|
|
|
|
} |
1271
|
33
|
|
|
|
|
95
|
$val = $self->read_statement($tok, undef); |
1272
|
33
|
50
|
33
|
|
|
142
|
if (!defined $val || ($val eq $close)) { |
1273
|
0
|
|
|
|
|
0
|
$arr->set($key, undef); |
1274
|
0
|
|
|
|
|
0
|
last; |
1275
|
|
|
|
|
|
|
} |
1276
|
33
|
|
|
|
|
140
|
$arr->set($key, $val); |
1277
|
33
|
50
|
|
|
|
87
|
if (scalar @$tok > 0) { |
1278
|
33
|
100
|
|
|
|
93
|
if ($tok->[0] eq $close) { |
|
|
50
|
|
|
|
|
|
1279
|
17
|
|
|
|
|
30
|
shift @$tok; |
1280
|
17
|
|
|
|
|
46
|
last; |
1281
|
|
|
|
|
|
|
} elsif ($tok->[0] eq ',') { |
1282
|
16
|
|
|
|
|
23
|
shift @$tok; |
1283
|
16
|
|
|
|
|
42
|
next; |
1284
|
|
|
|
|
|
|
} |
1285
|
|
|
|
|
|
|
} else { |
1286
|
0
|
|
|
|
|
0
|
last; |
1287
|
|
|
|
|
|
|
} |
1288
|
|
|
|
|
|
|
} |
1289
|
|
|
|
|
|
|
} |
1290
|
|
|
|
|
|
|
} |
1291
|
145
|
|
|
|
|
287
|
return; |
1292
|
|
|
|
|
|
|
} |
1293
|
|
|
|
|
|
|
|
1294
|
|
|
|
|
|
|
# last_op is optional param |
1295
|
|
|
|
|
|
|
# |
1296
|
|
|
|
|
|
|
sub _read_statement { |
1297
|
13401
|
|
|
13401
|
|
21299
|
my ($self, $tok, $last_op) = @_; |
1298
|
|
|
|
|
|
|
|
1299
|
13401
|
100
|
66
|
|
|
381816
|
if ((scalar @$tok > 0) && ($tok->[0] =~ /^([\;\:\,\)\]\}]|else|endif|endwhile|endfor|endforeach|as|=>|catch|finally)$/i)) { |
|
|
100
|
66
|
|
|
|
|
|
|
100
|
100
|
|
|
|
|
|
|
100
|
100
|
|
|
|
|
|
|
100
|
100
|
|
|
|
|
|
|
100
|
100
|
|
|
|
|
|
|
100
|
100
|
|
|
|
|
|
|
50
|
100
|
|
|
|
|
|
|
50
|
33
|
|
|
|
|
|
|
50
|
33
|
|
|
|
|
|
|
100
|
66
|
|
|
|
|
|
|
50
|
33
|
|
|
|
|
|
|
100
|
33
|
|
|
|
|
|
|
50
|
0
|
|
|
|
|
|
|
50
|
0
|
|
|
|
|
|
|
100
|
33
|
|
|
|
|
|
|
100
|
33
|
|
|
|
|
|
|
100
|
66
|
|
|
|
|
|
|
50
|
33
|
|
|
|
|
|
|
100
|
66
|
|
|
|
|
|
|
50
|
33
|
|
|
|
|
|
|
100
|
33
|
|
|
|
|
|
|
50
|
66
|
|
|
|
|
|
|
100
|
66
|
|
|
|
|
|
|
100
|
66
|
|
|
|
|
|
|
100
|
33
|
|
|
|
|
|
|
50
|
66
|
|
|
|
|
|
|
100
|
33
|
|
|
|
|
|
|
100
|
66
|
|
|
|
|
|
|
100
|
33
|
|
|
|
|
|
|
100
|
100
|
|
|
|
|
|
|
100
|
66
|
|
|
|
|
|
|
100
|
100
|
|
|
|
|
|
|
100
|
66
|
|
|
|
|
|
|
100
|
100
|
|
|
|
|
|
|
100
|
33
|
|
|
|
|
|
|
100
|
100
|
|
|
|
|
|
|
100
|
66
|
|
|
|
|
|
|
50
|
100
|
|
|
|
|
|
|
100
|
66
|
|
|
|
|
|
|
100
|
100
|
|
|
|
|
|
|
100
|
66
|
|
|
|
|
|
|
100
|
100
|
|
|
|
|
|
|
50
|
66
|
|
|
|
|
|
|
100
|
100
|
|
|
|
|
|
|
100
|
66
|
|
|
|
|
|
|
100
|
100
|
|
|
|
|
|
|
|
66
|
|
|
|
|
|
|
|
66
|
|
|
|
|
|
|
|
66
|
|
|
|
|
|
|
|
66
|
|
|
|
|
|
|
|
66
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
66
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
66
|
|
|
|
|
|
|
|
66
|
|
|
|
|
|
|
|
66
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
66
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
66
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
66
|
|
|
|
|
|
|
|
33
|
|
|
|
|
|
|
|
33
|
|
|
|
|
|
|
|
66
|
|
|
|
|
|
|
|
66
|
|
|
|
|
|
|
|
66
|
|
|
|
|
1300
|
3389
|
|
|
|
|
6036
|
my $sym = shift @$tok; |
1301
|
3389
|
|
|
|
|
7353
|
return $sym; |
1302
|
|
|
|
|
|
|
} elsif ((scalar @$tok > 0) && ($tok->[0] =~ /^null$/i)) { |
1303
|
16
|
|
|
|
|
27
|
shift @$tok; |
1304
|
16
|
|
|
|
|
46
|
unshift(@$tok, '#null'); |
1305
|
16
|
|
|
|
|
44
|
my $res = $self->read_statement($tok, $last_op); |
1306
|
16
|
|
|
|
|
45
|
return $res; |
1307
|
|
|
|
|
|
|
} elsif ((scalar @$tok > 1) && ($tok->[0] eq '{')) { |
1308
|
|
|
|
|
|
|
# block expression { statement1; statement2; ... } |
1309
|
|
|
|
|
|
|
# also allow empty { } block |
1310
|
|
|
|
|
|
|
# |
1311
|
184
|
|
|
|
|
378
|
shift @$tok; |
1312
|
184
|
|
|
|
|
551
|
my $arglist = $self->read_code_block($tok, '}', ';'); |
1313
|
184
|
|
|
|
|
519
|
my $k = $self->setblk('std', $arglist); |
1314
|
184
|
|
|
|
|
400
|
return $k; |
1315
|
|
|
|
|
|
|
} elsif ((scalar @$tok > 1) && ($tok->[0] eq '(')) { |
1316
|
|
|
|
|
|
|
# brace expression ( expr | call ) => result |
1317
|
|
|
|
|
|
|
# also: allow empty ( ) block |
1318
|
|
|
|
|
|
|
# also: type casting (int|bool|float|array|object|unset) |
1319
|
|
|
|
|
|
|
# http://php.net/manual/en/language.types.type-juggling.php |
1320
|
|
|
|
|
|
|
# |
1321
|
60
|
|
|
|
|
116
|
shift @$tok; |
1322
|
60
|
|
|
|
|
190
|
my $arglist = $self->read_block($tok, ')', undef); |
1323
|
|
|
|
|
|
|
|
1324
|
60
|
50
|
|
|
|
239
|
if (scalar @$arglist > 0) { |
1325
|
60
|
50
|
|
|
|
160
|
if (scalar @$arglist == 1) { |
1326
|
60
|
|
|
|
|
99
|
my $ref = $arglist->[0]; |
1327
|
60
|
|
|
|
|
166
|
my $str = $self->get_strval_or_str($ref); |
1328
|
|
|
|
|
|
|
#$self->{log}->('parse', "braces: $ref, $str") if $self->{log}; |
1329
|
60
|
100
|
100
|
|
|
141
|
if (is_strval($ref) && ($str =~ /^(int|bool|float|string|array|object|unset)$/)) { |
1330
|
|
|
|
|
|
|
# type casting |
1331
|
|
|
|
|
|
|
# https://www.php.net/manual/en/language.types.type-juggling.php |
1332
|
|
|
|
|
|
|
# https://www.php.net/manual/en/function.settype.php |
1333
|
|
|
|
|
|
|
# |
1334
|
2
|
|
|
|
|
6
|
my $res = $self->read_statement($tok, $last_op); |
1335
|
2
|
|
|
|
|
10
|
my $k; |
1336
|
2
|
100
|
|
|
|
15
|
if ($str eq 'int') { |
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
1337
|
1
|
|
|
|
|
5
|
$k = $self->setcall('intval', [$res]); |
1338
|
|
|
|
|
|
|
} elsif ($str eq 'integer') { |
1339
|
0
|
|
|
|
|
0
|
$k = $self->setcall('intval', [$res]); |
1340
|
|
|
|
|
|
|
} elsif ($str eq 'string') { |
1341
|
1
|
|
|
|
|
4
|
$k = $self->setcall('strval', [$res]); |
1342
|
|
|
|
|
|
|
} elsif ($str eq 'binary') { |
1343
|
0
|
|
|
|
|
0
|
$k = $self->setcall('strval', [$res]); |
1344
|
|
|
|
|
|
|
} elsif ($str eq 'float') { |
1345
|
0
|
|
|
|
|
0
|
$k = $self->setcall('floatval', [$res]); |
1346
|
|
|
|
|
|
|
} elsif ($str eq 'double') { |
1347
|
0
|
|
|
|
|
0
|
$k = $self->setcall('floatval', [$res]); |
1348
|
|
|
|
|
|
|
} elsif ($str eq 'real') { # removed in php8 |
1349
|
0
|
|
|
|
|
0
|
$k = $self->setcall('floatval', [$res]); |
1350
|
|
|
|
|
|
|
} elsif ($str eq 'bool') { |
1351
|
0
|
|
|
|
|
0
|
$k = $self->setcall('boolval', [$res]); |
1352
|
|
|
|
|
|
|
} elsif ($str eq 'boolean') { |
1353
|
0
|
|
|
|
|
0
|
$k = $self->setcall('boolval', [$res]); |
1354
|
|
|
|
|
|
|
} elsif ($str eq 'array') { |
1355
|
0
|
|
|
|
|
0
|
$k = $self->setcall('array', [$res]); |
1356
|
|
|
|
|
|
|
} elsif ($str eq 'object') { |
1357
|
0
|
|
|
|
|
0
|
$k = $self->setcall('object', [$res]); |
1358
|
|
|
|
|
|
|
} elsif ($str eq 'unset') { # removed in php8 |
1359
|
0
|
|
|
|
|
0
|
my $t = $self->setstr('null'); |
1360
|
0
|
|
|
|
|
0
|
$k = $self->setcall('settype', [$res, $t]); |
1361
|
|
|
|
|
|
|
} else { |
1362
|
0
|
|
|
|
|
0
|
$k = $self->setcall('settype', [$res, $ref]); |
1363
|
|
|
|
|
|
|
} |
1364
|
2
|
|
|
|
|
7
|
unshift(@$tok, $k); |
1365
|
2
|
|
|
|
|
6
|
$res = $self->read_statement($tok, $last_op); |
1366
|
2
|
|
|
|
|
7
|
return $res; |
1367
|
|
|
|
|
|
|
} |
1368
|
58
|
100
|
100
|
|
|
128
|
if (is_strval($ref) || ($ref =~ /^#expr\d+$/) || ($ref =~ /^#call\d+$/) || ($ref =~ /^#inst\d+$/)) { |
|
|
|
100
|
|
|
|
|
|
|
|
66
|
|
|
|
|
1369
|
56
|
|
|
|
|
143
|
unshift(@$tok, $ref); |
1370
|
56
|
|
|
|
|
142
|
my $res = $self->read_statement($tok, $last_op); |
1371
|
56
|
|
|
|
|
150
|
return $res; |
1372
|
|
|
|
|
|
|
} |
1373
|
|
|
|
|
|
|
} |
1374
|
2
|
|
|
|
|
9
|
my $res = $self->setblk('brace', $arglist); |
1375
|
|
|
|
|
|
|
|
1376
|
|
|
|
|
|
|
# - anonymous functions might be called directly -> '(function () { return 1; })()' |
1377
|
|
|
|
|
|
|
# - also subexpressions might use braces -> '$x = ($y) ? 1 : 2' |
1378
|
|
|
|
|
|
|
# |
1379
|
2
|
|
|
|
|
8
|
unshift(@$tok, $res); |
1380
|
2
|
|
|
|
|
6
|
$res = $self->read_statement($tok, $last_op); |
1381
|
2
|
|
|
|
|
6
|
return $res; |
1382
|
|
|
|
|
|
|
} |
1383
|
0
|
|
|
|
|
0
|
my $res = $self->setblk('brace', []); |
1384
|
0
|
|
|
|
|
0
|
return $res; |
1385
|
|
|
|
|
|
|
} elsif ((scalar @$tok > 1) && ($tok->[0] eq '[')) { |
1386
|
|
|
|
|
|
|
# $array = ['a','b','c'] |
1387
|
|
|
|
|
|
|
# |
1388
|
12
|
|
|
|
|
29
|
shift @$tok; |
1389
|
|
|
|
|
|
|
|
1390
|
12
|
|
|
|
|
37
|
my $arr = $self->newarr(); |
1391
|
12
|
|
|
|
|
39
|
$self->read_array($tok, ']', $arr); |
1392
|
|
|
|
|
|
|
|
1393
|
|
|
|
|
|
|
#my $arglist = $self->read_block($tok, ']', ','); |
1394
|
|
|
|
|
|
|
#foreach my $val (@$arglist) { |
1395
|
|
|
|
|
|
|
# $arr->set(undef, $val); |
1396
|
|
|
|
|
|
|
#} |
1397
|
12
|
|
|
|
|
27
|
unshift(@$tok, $arr->{name}); |
1398
|
12
|
|
|
|
|
28
|
my $res = $self->read_statement($tok, $last_op); |
1399
|
12
|
|
|
|
|
26
|
return $res; |
1400
|
|
|
|
|
|
|
} elsif ((scalar @$tok > 1) && ($tok->[0] eq '&')) { |
1401
|
|
|
|
|
|
|
# variable reference |
1402
|
|
|
|
|
|
|
# & $var |
1403
|
|
|
|
|
|
|
# |
1404
|
8
|
|
|
|
|
48
|
shift @$tok; |
1405
|
|
|
|
|
|
|
|
1406
|
8
|
|
|
|
|
37
|
my $var = $self->read_statement($tok, undef); |
1407
|
8
|
|
|
|
|
58
|
my $k = $self->setref($var); |
1408
|
8
|
|
|
|
|
18
|
return $k; |
1409
|
|
|
|
|
|
|
} elsif (((scalar @$tok == 1) |
1410
|
|
|
|
|
|
|
|| ((scalar @$tok > 1) && ($tok->[1] =~ /^([\;\,\)\]\}]|as|=>)$/)) |
1411
|
|
|
|
|
|
|
|| ((scalar @$tok > 2) && ($tok->[1] eq ':') && ($tok->[2] ne ':'))) && !exists $php_keywords{$tok->[0]}) { |
1412
|
|
|
|
|
|
|
# variable dereference |
1413
|
|
|
|
|
|
|
# #str/#num/#const |
1414
|
|
|
|
|
|
|
# constant |
1415
|
|
|
|
|
|
|
# __FILE__ |
1416
|
|
|
|
|
|
|
# __LINE__ |
1417
|
|
|
|
|
|
|
# |
1418
|
6083
|
|
|
|
|
12293
|
my $sym = shift @$tok; |
1419
|
6083
|
|
|
|
|
11915
|
my $var = unquote_names($sym); |
1420
|
|
|
|
|
|
|
|
1421
|
6083
|
100
|
100
|
|
|
11055
|
if (is_strict_variable($var) || ($var =~ /^#/)) { |
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
1422
|
5733
|
100
|
|
|
|
12276
|
if ($var =~ /^#str/) { |
1423
|
1027
|
|
|
|
|
2320
|
$self->updateline($var); |
1424
|
|
|
|
|
|
|
} |
1425
|
5733
|
|
|
|
|
13325
|
return $var; |
1426
|
|
|
|
|
|
|
} elsif ($var =~ /^__FILE__$/) { |
1427
|
0
|
|
|
|
|
0
|
my $v = $self->{filename}; |
1428
|
0
|
|
|
|
|
0
|
my $k = $self->setstr($v); |
1429
|
0
|
0
|
|
|
|
0
|
$self->{log}->('parse', "getfile: $k -> $v") if $self->{log}; |
1430
|
0
|
|
|
|
|
0
|
return $k; |
1431
|
|
|
|
|
|
|
} elsif ($var =~ /^__LINE__$/) { |
1432
|
0
|
|
|
|
|
0
|
my $k = $self->setnum($self->getline()); |
1433
|
0
|
0
|
|
|
|
0
|
$self->{log}->('parse', "getline: $k -> %d", $self->{strmap}->{$k}) if $self->{log}; |
1434
|
0
|
|
|
|
|
0
|
return $k; |
1435
|
|
|
|
|
|
|
} elsif ($var =~ /^false$/i) { |
1436
|
3
|
|
|
|
|
11
|
return $self->setnum(0); |
1437
|
|
|
|
|
|
|
} elsif ($var =~ /^true$/i) { |
1438
|
3
|
|
|
|
|
14
|
return $self->setnum(1); |
1439
|
|
|
|
|
|
|
} elsif (is_symbol($var)) { |
1440
|
|
|
|
|
|
|
# constants are always global |
1441
|
|
|
|
|
|
|
# (undefined constants are propagated to string in exec) |
1442
|
|
|
|
|
|
|
# |
1443
|
344
|
|
|
|
|
934
|
my $k = $self->setconst($var); |
1444
|
344
|
50
|
100
|
|
|
1195
|
if ((scalar @$tok > 1) && ($tok->[0] eq ':') && ($tok->[1] ne ':') && !defined $last_op) { |
|
|
|
66
|
|
|
|
|
|
|
|
66
|
|
|
|
|
1445
|
2
|
|
|
|
|
8
|
shift @$tok; |
1446
|
2
|
|
|
|
|
7
|
$k = $self->setstmt(['label', $k]); # goto label |
1447
|
|
|
|
|
|
|
} |
1448
|
344
|
|
|
|
|
792
|
return $k; |
1449
|
|
|
|
|
|
|
} |
1450
|
0
|
|
|
|
|
0
|
return $var; |
1451
|
|
|
|
|
|
|
} elsif ((scalar @$tok > 1) && ($tok->[0] eq '<') && ($tok->[1] eq '?')) { |
1452
|
0
|
0
|
0
|
|
|
0
|
if ((scalar @$tok > 2) && ($tok->[2] eq 'php')) { |
1453
|
0
|
|
|
|
|
0
|
shift @$tok; |
1454
|
0
|
|
|
|
|
0
|
shift @$tok; |
1455
|
0
|
|
|
|
|
0
|
shift @$tok; |
1456
|
0
|
|
|
|
|
0
|
return '
|
1457
|
|
|
|
|
|
|
} else { |
1458
|
0
|
|
|
|
|
0
|
shift @$tok; |
1459
|
0
|
|
|
|
|
0
|
shift @$tok; |
1460
|
0
|
|
|
|
|
0
|
return ''; |
1461
|
|
|
|
|
|
|
} |
1462
|
|
|
|
|
|
|
} elsif ((scalar @$tok > 5) && ($tok->[0] eq '<') && ($tok->[1] eq 'script') && ($tok->[2] eq 'type') && ($tok->[3] eq '=') && ($tok->[5] eq '>')) { |
1463
|
|
|
|
|
|
|
# filter out bad javascript tags in scripts with no proper end-tag |
1464
|
|
|
|
|
|
|
# (this avoids misinterpretations of javascript while(1)-loops) |
1465
|
|
|
|
|
|
|
# |
1466
|
0
|
|
|
|
|
0
|
my @list = (); |
1467
|
0
|
|
|
|
|
0
|
push(@list, shift @$tok); |
1468
|
0
|
|
|
|
|
0
|
push(@list, shift @$tok); |
1469
|
0
|
|
|
|
|
0
|
push(@list, shift @$tok); |
1470
|
0
|
|
|
|
|
0
|
push(@list, shift @$tok); |
1471
|
0
|
|
|
|
|
0
|
push(@list, shift @$tok); # type |
1472
|
0
|
|
|
|
|
0
|
push(@list, shift @$tok); |
1473
|
|
|
|
|
|
|
|
1474
|
0
|
|
|
|
|
0
|
while (scalar @$tok > 0) { |
1475
|
0
|
0
|
0
|
|
|
0
|
if ((scalar @$tok > 3) && ($tok->[0] eq '<') && ($tok->[1] eq '/') && ($tok->[2] eq 'script') && ($tok->[3] eq '>')) { |
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
1476
|
0
|
|
|
|
|
0
|
push(@list, shift @$tok); |
1477
|
0
|
|
|
|
|
0
|
push(@list, shift @$tok); |
1478
|
0
|
|
|
|
|
0
|
push(@list, shift @$tok); |
1479
|
0
|
|
|
|
|
0
|
push(@list, shift @$tok); |
1480
|
0
|
|
|
|
|
0
|
last; |
1481
|
|
|
|
|
|
|
} |
1482
|
0
|
|
|
|
|
0
|
my $sym = shift @$tok; |
1483
|
0
|
|
|
|
|
0
|
push(@list, $sym); |
1484
|
|
|
|
|
|
|
} |
1485
|
0
|
|
|
|
|
0
|
my $script = join(' ', @list); |
1486
|
0
|
|
|
|
|
0
|
my $s = $self->setstr($script); |
1487
|
0
|
|
|
|
|
0
|
my $k = $self->setstmt(['echo', [$s]]); |
1488
|
0
|
0
|
|
|
|
0
|
$self->{log}->('parse', "javascript string: %s", $script) if $self->{log}; |
1489
|
0
|
|
|
|
|
0
|
return $k; |
1490
|
|
|
|
|
|
|
} elsif ((scalar @$tok > 1) && ($tok->[0] eq '?') && ($tok->[1] eq '>')) { |
1491
|
0
|
|
|
|
|
0
|
shift @$tok; |
1492
|
0
|
|
|
|
|
0
|
shift @$tok; |
1493
|
0
|
|
|
|
|
0
|
return '?>'; |
1494
|
|
|
|
|
|
|
} elsif ((scalar @$tok > 1) && (lc($tok->[0]) eq 'echo')) { |
1495
|
147
|
|
|
|
|
276
|
shift @$tok; |
1496
|
147
|
|
|
|
|
308
|
my $all_str = 1; |
1497
|
147
|
|
|
|
|
300
|
my @args = (); |
1498
|
147
|
|
|
|
|
256
|
while (1) { |
1499
|
156
|
|
|
|
|
432
|
my $arg = $self->read_statement($tok, undef); |
1500
|
|
|
|
|
|
|
|
1501
|
156
|
100
|
|
|
|
431
|
unless (is_strval($arg)) { |
1502
|
64
|
|
|
|
|
131
|
$all_str = 0; |
1503
|
|
|
|
|
|
|
} |
1504
|
156
|
50
|
|
|
|
459
|
if ($arg ne ',') { |
1505
|
156
|
|
|
|
|
400
|
push(@args, $arg); |
1506
|
|
|
|
|
|
|
} |
1507
|
156
|
100
|
100
|
|
|
701
|
unless ((scalar @$tok > 0) && ($tok->[0] eq ',')) { |
1508
|
147
|
|
|
|
|
264
|
last; |
1509
|
|
|
|
|
|
|
} |
1510
|
9
|
|
|
|
|
19
|
shift @$tok; |
1511
|
|
|
|
|
|
|
} |
1512
|
147
|
|
|
|
|
470
|
my $k = $self->setstmt(['echo', \@args]); |
1513
|
|
|
|
|
|
|
|
1514
|
|
|
|
|
|
|
# execute expr & might continue with operation |
1515
|
|
|
|
|
|
|
# |
1516
|
147
|
|
|
|
|
387
|
unshift(@$tok, $k); |
1517
|
147
|
|
|
|
|
425
|
return $self->read_statement($tok, $last_op); |
1518
|
|
|
|
|
|
|
} elsif ((scalar @$tok > 1) && (lc($tok->[0]) eq 'print')) { |
1519
|
0
|
|
|
|
|
0
|
shift @$tok; |
1520
|
0
|
|
|
|
|
0
|
my $arg = $self->read_statement($tok, undef); |
1521
|
0
|
|
|
|
|
0
|
my $k = $self->setstmt(['print', $arg]); |
1522
|
|
|
|
|
|
|
|
1523
|
|
|
|
|
|
|
# execute expr & might continue with operation |
1524
|
|
|
|
|
|
|
# |
1525
|
0
|
|
|
|
|
0
|
unshift(@$tok, $k); |
1526
|
0
|
|
|
|
|
0
|
return $self->read_statement($tok, $last_op); |
1527
|
|
|
|
|
|
|
} elsif ((scalar @$tok > 1) && (lc($tok->[0]) eq 'namespace')) { |
1528
|
10
|
|
|
|
|
24
|
shift @$tok; |
1529
|
|
|
|
|
|
|
|
1530
|
10
|
|
|
|
|
16
|
my $arg = ''; # toplevel |
1531
|
10
|
100
|
|
|
|
25
|
if ($tok->[0] ne '{') { |
1532
|
9
|
|
|
|
|
21
|
$arg = $self->read_statement($tok, undef); |
1533
|
9
|
|
|
|
|
24
|
my $str = $self->ns_to_str($arg); |
1534
|
9
|
50
|
|
|
|
19
|
if (defined $str) { |
1535
|
9
|
|
|
|
|
17
|
$arg = $str; |
1536
|
|
|
|
|
|
|
} else { |
1537
|
0
|
|
|
|
|
0
|
$self->{warn}->('parse', "bad namespace: %s", $arg); |
1538
|
|
|
|
|
|
|
} |
1539
|
|
|
|
|
|
|
} |
1540
|
10
|
|
|
|
|
12
|
my $block; |
1541
|
10
|
100
|
66
|
|
|
41
|
if ((scalar @$tok > 0) && ($tok->[0] eq '{')) { |
1542
|
2
|
|
|
|
|
4
|
shift @$tok; |
1543
|
2
|
|
|
|
|
19
|
my $arglist = $self->read_code_block($tok, '}', ';'); |
1544
|
2
|
|
|
|
|
15
|
$block = $self->setblk('std', $arglist); |
1545
|
|
|
|
|
|
|
} |
1546
|
10
|
|
|
|
|
48
|
return $self->setstmt(['namespace', $arg, $block]); |
1547
|
|
|
|
|
|
|
} elsif ((scalar @$tok > 1) && (lc($tok->[0]) eq 'use')) { |
1548
|
0
|
|
|
|
|
0
|
shift @$tok; |
1549
|
|
|
|
|
|
|
# https://php.net/manual/en/language.oop5.traits.php |
1550
|
0
|
|
|
|
|
0
|
my @args = (); |
1551
|
0
|
|
|
|
|
0
|
while (1) { |
1552
|
0
|
|
|
|
|
0
|
my $arg = $self->read_statement($tok, undef); |
1553
|
|
|
|
|
|
|
|
1554
|
0
|
|
|
|
|
0
|
push(@args, $arg); |
1555
|
0
|
0
|
0
|
|
|
0
|
unless ((scalar @$tok > 0) && ($tok->[0] eq ',')) { |
1556
|
0
|
|
|
|
|
0
|
last; |
1557
|
|
|
|
|
|
|
} |
1558
|
0
|
|
|
|
|
0
|
shift @$tok; |
1559
|
|
|
|
|
|
|
} |
1560
|
0
|
|
|
|
|
0
|
return $self->setstmt(['use', \@args]); |
1561
|
|
|
|
|
|
|
} elsif ((scalar @$tok > 1) && ($tok->[0] =~ /^(include|include_once|require|require_once)$/i)) { |
1562
|
0
|
|
|
|
|
0
|
my $type = lc(shift @$tok); |
1563
|
0
|
|
|
|
|
0
|
my $arg = $self->read_statement($tok, undef); |
1564
|
0
|
|
|
|
|
0
|
return $self->setstmt([$type, $arg]); |
1565
|
|
|
|
|
|
|
} elsif ((scalar @$tok > 1) && (lc($tok->[0]) eq 'global')) { |
1566
|
6
|
|
|
|
|
27
|
shift @$tok; |
1567
|
6
|
|
|
|
|
15
|
my @args = (); |
1568
|
6
|
|
|
|
|
23
|
while (1) { |
1569
|
6
|
|
|
|
|
22
|
my $arg = $self->read_statement($tok, undef); |
1570
|
|
|
|
|
|
|
|
1571
|
6
|
|
|
|
|
19
|
push(@args, $arg); |
1572
|
6
|
50
|
33
|
|
|
45
|
unless ((scalar @$tok > 0) && ($tok->[0] eq ',')) { |
1573
|
6
|
|
|
|
|
12
|
last; |
1574
|
|
|
|
|
|
|
} |
1575
|
0
|
|
|
|
|
0
|
shift @$tok; |
1576
|
|
|
|
|
|
|
} |
1577
|
6
|
|
|
|
|
23
|
return $self->setstmt(['global', \@args]); |
1578
|
|
|
|
|
|
|
} elsif ((scalar @$tok > 1) && (lc($tok->[0]) eq 'return')) { |
1579
|
118
|
|
|
|
|
266
|
shift @$tok; |
1580
|
118
|
|
|
|
|
355
|
my $res = $self->read_statement($tok, undef); |
1581
|
|
|
|
|
|
|
# remove trailing ';' if evaluated as string |
1582
|
|
|
|
|
|
|
# |
1583
|
118
|
100
|
66
|
|
|
697
|
if ((scalar @$tok > 0) && ($tok->[0] eq ';')) { |
1584
|
99
|
|
|
|
|
171
|
shift @$tok; |
1585
|
|
|
|
|
|
|
} |
1586
|
118
|
|
|
|
|
435
|
return $self->setstmt(['return', $res]); |
1587
|
|
|
|
|
|
|
} elsif ((scalar @$tok > 1) && (lc($tok->[0]) eq 'goto')) { |
1588
|
1
|
|
|
|
|
7
|
shift @$tok; |
1589
|
1
|
|
|
|
|
5
|
my $res = $self->read_statement($tok, undef); |
1590
|
|
|
|
|
|
|
# remove trailing ';' if evaluated as string |
1591
|
|
|
|
|
|
|
# |
1592
|
1
|
50
|
33
|
|
|
15
|
if ((scalar @$tok > 0) && ($tok->[0] eq ';')) { |
1593
|
1
|
|
|
|
|
3
|
shift @$tok; |
1594
|
|
|
|
|
|
|
} |
1595
|
1
|
|
|
|
|
4
|
return $self->setstmt(['goto', $res]); |
1596
|
|
|
|
|
|
|
} elsif ((scalar @$tok > 1) && (lc($tok->[0]) eq 'throw')) { |
1597
|
0
|
|
|
|
|
0
|
shift @$tok; |
1598
|
0
|
|
|
|
|
0
|
my $arg = $self->read_statement($tok, undef); |
1599
|
0
|
|
|
|
|
0
|
return $self->setstmt(['throw', $arg]); |
1600
|
|
|
|
|
|
|
} elsif ((scalar @$tok > 0) && (lc($tok->[0]) eq 'break')) { |
1601
|
2
|
|
|
|
|
13
|
shift @$tok; |
1602
|
2
|
|
|
|
|
8
|
my $res = $self->read_statement($tok, undef); # optional level |
1603
|
2
|
50
|
33
|
|
|
31
|
if ((scalar @$tok > 0) && ($tok->[0] eq ';')) { |
1604
|
0
|
|
|
|
|
0
|
shift @$tok; |
1605
|
|
|
|
|
|
|
} |
1606
|
2
|
|
|
|
|
13
|
return $self->setstmt(['break', $res]); |
1607
|
|
|
|
|
|
|
} elsif ((scalar @$tok > 0) && (lc($tok->[0]) eq 'continue')) { |
1608
|
0
|
|
|
|
|
0
|
shift @$tok; |
1609
|
0
|
|
|
|
|
0
|
my $res = $self->read_statement($tok, undef); # optional level |
1610
|
0
|
0
|
0
|
|
|
0
|
if ((scalar @$tok > 0) && ($tok->[0] eq ';')) { |
1611
|
0
|
|
|
|
|
0
|
shift @$tok; |
1612
|
|
|
|
|
|
|
} |
1613
|
0
|
|
|
|
|
0
|
return $self->setstmt(['continue', $res]); |
1614
|
|
|
|
|
|
|
} elsif ((scalar @$tok > 0) && (lc($tok->[0]) =~ /^(var|static|public|protected|private|final|const)$/)) { |
1615
|
55
|
|
|
|
|
163
|
my $type = shift @$tok; |
1616
|
55
|
|
|
|
|
171
|
my $pfx = {$type => 1}; |
1617
|
|
|
|
|
|
|
|
1618
|
55
|
100
|
66
|
|
|
304
|
if ((scalar @$tok > 0) && (lc($tok->[0]) =~ /^(var|static|public|protected|private|final|const)$/)) { |
1619
|
7
|
|
|
|
|
15
|
$type = shift @$tok; |
1620
|
7
|
|
|
|
|
14
|
$pfx->{$type} = 1; |
1621
|
|
|
|
|
|
|
} |
1622
|
55
|
|
|
|
|
167
|
my $k = $self->setpfx($pfx); |
1623
|
55
|
|
|
|
|
143
|
unshift(@$tok, $k); |
1624
|
55
|
|
|
|
|
127
|
return $self->read_statement($tok); |
1625
|
|
|
|
|
|
|
} elsif ((scalar @$tok > 0) && (lc($tok->[0]) eq '__halt_compiler')) { |
1626
|
0
|
|
|
|
|
0
|
my $k = shift @$tok; |
1627
|
0
|
|
|
|
|
0
|
@$tok = (); |
1628
|
0
|
|
|
|
|
0
|
return $k; |
1629
|
|
|
|
|
|
|
} elsif ((scalar @$tok > 3) && (lc($tok->[0]) eq 'if') && ($tok->[1] eq '(')) { |
1630
|
124
|
|
|
|
|
295
|
shift @$tok; |
1631
|
124
|
|
|
|
|
269
|
shift @$tok; |
1632
|
124
|
|
|
|
|
360
|
my $expr = $self->read_block($tok, ')', undef); |
1633
|
124
|
|
|
|
|
317
|
my $then; |
1634
|
|
|
|
|
|
|
my $else; |
1635
|
|
|
|
|
|
|
|
1636
|
124
|
100
|
66
|
|
|
506
|
if ((scalar @$tok > 0) && ($tok->[0] eq ':')) { |
1637
|
|
|
|
|
|
|
# allow alternative block syntax |
1638
|
|
|
|
|
|
|
# http://php.net/manual/en/control-structures.alternative-syntax.php |
1639
|
|
|
|
|
|
|
# |
1640
|
1
|
|
|
|
|
5
|
shift @$tok; |
1641
|
1
|
|
|
|
|
7
|
my $block = $self->read_code_block($tok, 'endif', ';'); |
1642
|
1
|
|
|
|
|
9
|
$then = $self->setblk('std', $block); |
1643
|
|
|
|
|
|
|
} else { |
1644
|
123
|
|
|
|
|
262
|
$then = $self->read_statement($tok); |
1645
|
123
|
100
|
|
|
|
324
|
if (!is_block($then)) { |
1646
|
16
|
50
|
66
|
|
|
135
|
if ((scalar @$tok > 0) && ($tok->[0] eq ';')) { |
1647
|
0
|
|
|
|
|
0
|
shift @$tok; |
1648
|
|
|
|
|
|
|
} |
1649
|
|
|
|
|
|
|
# always put '{ .. }' braces around if/else |
1650
|
16
|
|
|
|
|
63
|
$then = $self->setblk('std', [$then]); |
1651
|
|
|
|
|
|
|
} |
1652
|
|
|
|
|
|
|
} |
1653
|
124
|
100
|
100
|
|
|
919
|
if ((scalar @$tok > 0) && (lc($tok->[0]) eq 'else')) { |
|
|
100
|
100
|
|
|
|
|
1654
|
17
|
|
|
|
|
51
|
shift @$tok; |
1655
|
17
|
50
|
33
|
|
|
106
|
if ((scalar @$tok > 0) && ($tok->[0] eq ':')) { |
1656
|
|
|
|
|
|
|
# allow alternative block syntax |
1657
|
|
|
|
|
|
|
# http://php.net/manual/en/control-structures.alternative-syntax.php |
1658
|
|
|
|
|
|
|
# |
1659
|
0
|
|
|
|
|
0
|
shift @$tok; |
1660
|
0
|
|
|
|
|
0
|
my $block = $self->read_code_block($tok, 'endif', ';'); |
1661
|
0
|
|
|
|
|
0
|
$else = $self->setblk('std', $block); |
1662
|
|
|
|
|
|
|
} else { |
1663
|
17
|
|
|
|
|
53
|
$else = $self->read_statement($tok); |
1664
|
17
|
100
|
|
|
|
95
|
if (!is_block($else)) { |
1665
|
1
|
50
|
33
|
|
|
8
|
if ((scalar @$tok > 0) && ($tok->[0] eq ';')) { |
1666
|
1
|
|
|
|
|
3
|
shift @$tok; |
1667
|
|
|
|
|
|
|
} |
1668
|
1
|
|
|
|
|
4
|
$else = $self->setblk('std', [$else]); |
1669
|
|
|
|
|
|
|
} |
1670
|
|
|
|
|
|
|
} |
1671
|
|
|
|
|
|
|
} elsif ((scalar @$tok > 0) && (lc($tok->[0]) eq 'elseif')) { |
1672
|
6
|
|
|
|
|
16
|
shift @$tok; |
1673
|
6
|
|
|
|
|
16
|
unshift(@$tok, 'if'); |
1674
|
6
|
|
|
|
|
21
|
$else = $self->read_statement($tok, undef); |
1675
|
6
|
50
|
|
|
|
21
|
if (!is_block($else)) { |
1676
|
6
|
|
|
|
|
20
|
$else = $self->setblk('std', [$else]); |
1677
|
|
|
|
|
|
|
} |
1678
|
|
|
|
|
|
|
} |
1679
|
124
|
50
|
|
|
|
320
|
if (scalar @$expr > 1) { |
1680
|
0
|
|
|
|
|
0
|
$self->{warn}->('parse', "if: bad cond %s", join(' ', @$expr)); |
1681
|
0
|
|
|
|
|
0
|
my $badcond = $self->setblk('expr', $expr); |
1682
|
0
|
|
|
|
|
0
|
$expr = [$badcond]; |
1683
|
|
|
|
|
|
|
} |
1684
|
124
|
|
|
|
|
475
|
return $self->setstmt(['if', $expr->[0], $then, $else]); |
1685
|
|
|
|
|
|
|
} elsif ((scalar @$tok > 3) && (lc($tok->[0]) eq 'switch') && ($tok->[1] eq '(')) { |
1686
|
9
|
|
|
|
|
34
|
shift @$tok; |
1687
|
9
|
|
|
|
|
18
|
shift @$tok; |
1688
|
9
|
|
|
|
|
29
|
my $expr = $self->read_block($tok, ')', undef); |
1689
|
9
|
|
|
|
|
38
|
my $block = []; |
1690
|
9
|
50
|
33
|
|
|
72
|
if ((scalar @$tok > 0) && ($tok->[0] eq ':')) { |
|
|
50
|
33
|
|
|
|
|
1691
|
|
|
|
|
|
|
# allow alternative block syntax |
1692
|
|
|
|
|
|
|
# http://php.net/manual/en/control-structures.alternative-syntax.php |
1693
|
|
|
|
|
|
|
# |
1694
|
0
|
|
|
|
|
0
|
shift @$tok; |
1695
|
0
|
|
|
|
|
0
|
$block = $self->read_code_block($tok, 'endswitch', ';'); |
1696
|
|
|
|
|
|
|
} elsif ((scalar @$tok > 0) && ($tok->[0] eq '{')) { |
1697
|
9
|
|
|
|
|
13
|
shift @$tok; |
1698
|
9
|
|
|
|
|
30
|
$block = $self->read_code_block($tok, '}', ';'); |
1699
|
|
|
|
|
|
|
} else { |
1700
|
0
|
|
|
|
|
0
|
$self->{warn}->('parse', "expected switch block {}"); |
1701
|
|
|
|
|
|
|
} |
1702
|
9
|
50
|
|
|
|
66
|
if (scalar @$expr > 1) { |
1703
|
0
|
|
|
|
|
0
|
$self->{warn}->('parse', "switch: bad cond %s", join(' ', @$expr)); |
1704
|
0
|
|
|
|
|
0
|
my $badcond = $self->setblk('expr', $expr); |
1705
|
0
|
|
|
|
|
0
|
$expr = [$badcond]; |
1706
|
|
|
|
|
|
|
} |
1707
|
9
|
|
|
|
|
32
|
my @cases = (); |
1708
|
9
|
|
|
|
|
15
|
my $inst; |
1709
|
9
|
|
|
|
|
26
|
foreach my $e (@$block) { |
1710
|
29
|
100
|
100
|
|
|
151
|
if ($e =~ /^#stmt\d+$/ && (lc($self->{strmap}->{$e}->[0]) eq 'case')) { |
1711
|
15
|
|
|
|
|
34
|
my $c = $self->{strmap}->{$e}->[1]; # undef for default case |
1712
|
15
|
|
|
|
|
27
|
$inst = []; |
1713
|
15
|
|
|
|
|
35
|
my $b = $self->setblk('case', $inst); # block content added in next iterations |
1714
|
15
|
|
|
|
|
65
|
push (@cases, [$c, $b]); |
1715
|
|
|
|
|
|
|
} else { |
1716
|
14
|
50
|
|
|
|
37
|
if (!defined $inst) { |
1717
|
0
|
|
|
|
|
0
|
$self->{warn}->('parse', "switch: inst w/o case: %s", $e); |
1718
|
0
|
|
|
|
|
0
|
$inst = []; |
1719
|
|
|
|
|
|
|
} |
1720
|
14
|
|
|
|
|
32
|
push (@$inst, $e); |
1721
|
|
|
|
|
|
|
} |
1722
|
|
|
|
|
|
|
} |
1723
|
9
|
|
|
|
|
32
|
return $self->setstmt(['switch', $expr->[0], \@cases]); |
1724
|
|
|
|
|
|
|
} elsif ((scalar @$tok > 2) && (lc($tok->[0]) eq 'case')) { |
1725
|
15
|
|
|
|
|
42
|
shift @$tok; |
1726
|
15
|
|
|
|
|
48
|
my $expr = $self->read_statement($tok, undef); |
1727
|
|
|
|
|
|
|
# 'case' might also be terminated by ';' |
1728
|
|
|
|
|
|
|
# |
1729
|
15
|
100
|
66
|
|
|
95
|
if ((scalar @$tok > 0) && ($tok->[0] eq ':') || ($tok->[0] eq ';')) { |
|
|
|
66
|
|
|
|
|
1730
|
14
|
|
|
|
|
25
|
shift @$tok; |
1731
|
|
|
|
|
|
|
} |
1732
|
15
|
100
|
66
|
|
|
63
|
if ($expr =~ /^#stmt\d+$/ && (lc($self->{strmap}->{$expr}->[0]) eq 'label')) { |
1733
|
1
|
|
|
|
|
4
|
$expr = $self->{strmap}->{$expr}->[1]; # label -> const |
1734
|
|
|
|
|
|
|
} |
1735
|
15
|
|
|
|
|
53
|
return $self->setstmt(['case', $expr]); |
1736
|
|
|
|
|
|
|
} elsif ((scalar @$tok > 1) && (lc($tok->[0]) eq 'default')) { |
1737
|
0
|
|
|
|
|
0
|
shift @$tok; |
1738
|
|
|
|
|
|
|
# 'case' might also be terminated by ';' |
1739
|
|
|
|
|
|
|
# |
1740
|
0
|
0
|
0
|
|
|
0
|
if ((scalar @$tok > 0) && ($tok->[0] eq ':') || ($tok->[0] eq ';')) { |
|
|
|
0
|
|
|
|
|
1741
|
0
|
|
|
|
|
0
|
shift @$tok; |
1742
|
|
|
|
|
|
|
} |
1743
|
0
|
|
|
|
|
0
|
return $self->setstmt(['case', undef]); |
1744
|
|
|
|
|
|
|
} elsif ((scalar @$tok > 3) && (lc($tok->[0]) eq 'try') && ($tok->[1] eq '{')) { |
1745
|
1
|
|
|
|
|
3
|
shift @$tok; |
1746
|
1
|
|
|
|
|
3
|
my $try; |
1747
|
|
|
|
|
|
|
my $finally; |
1748
|
|
|
|
|
|
|
|
1749
|
|
|
|
|
|
|
# https://www.php.net/manual/en/language.exceptions.php |
1750
|
|
|
|
|
|
|
# |
1751
|
1
|
|
|
|
|
10
|
$try = $self->read_statement($tok); |
1752
|
1
|
50
|
|
|
|
5
|
if (!is_block($try)) { |
1753
|
0
|
0
|
0
|
|
|
0
|
if ((scalar @$tok > 0) && ($tok->[0] eq ';')) { |
1754
|
0
|
|
|
|
|
0
|
shift @$tok; |
1755
|
|
|
|
|
|
|
} |
1756
|
|
|
|
|
|
|
# always put '{ .. }' braces around try |
1757
|
0
|
|
|
|
|
0
|
$try = $self->setblk('std', [$try]); |
1758
|
|
|
|
|
|
|
} |
1759
|
1
|
|
|
|
|
3
|
my @catches = (); |
1760
|
1
|
|
66
|
|
|
12
|
while ((scalar @$tok > 1) && (lc($tok->[0]) eq 'catch') && ($tok->[1] eq '(')) { |
|
|
|
66
|
|
|
|
|
1761
|
1
|
|
|
|
|
2
|
shift @$tok; |
1762
|
1
|
|
|
|
|
3
|
shift @$tok; |
1763
|
1
|
|
|
|
|
4
|
my $exception = $self->read_block($tok, ')', undef); |
1764
|
1
|
|
|
|
|
15
|
my $block= $self->read_statement($tok); |
1765
|
|
|
|
|
|
|
|
1766
|
1
|
50
|
|
|
|
11
|
if (!is_block($block)) { |
1767
|
0
|
0
|
0
|
|
|
0
|
if ((scalar @$tok > 0) && ($tok->[0] eq ';')) { |
1768
|
0
|
|
|
|
|
0
|
shift @$tok; |
1769
|
|
|
|
|
|
|
} |
1770
|
|
|
|
|
|
|
# always put '{ .. }' braces around catch |
1771
|
0
|
|
|
|
|
0
|
$block = $self->setblk('std', [$block]); |
1772
|
|
|
|
|
|
|
} |
1773
|
1
|
|
|
|
|
13
|
push (@catches, [$exception->[0], $block]); |
1774
|
|
|
|
|
|
|
} |
1775
|
1
|
50
|
33
|
|
|
12
|
if ((scalar @$tok > 0) && (lc($tok->[0]) eq 'finally')) { |
1776
|
1
|
|
|
|
|
3
|
shift @$tok; |
1777
|
1
|
|
|
|
|
5
|
$finally= $self->read_statement($tok); |
1778
|
|
|
|
|
|
|
|
1779
|
1
|
50
|
|
|
|
10
|
if (!is_block($finally)) { |
1780
|
0
|
0
|
0
|
|
|
0
|
if ((scalar @$tok > 0) && ($tok->[0] eq ';')) { |
1781
|
0
|
|
|
|
|
0
|
shift @$tok; |
1782
|
|
|
|
|
|
|
} |
1783
|
|
|
|
|
|
|
# always put '{ .. }' braces around finally |
1784
|
0
|
|
|
|
|
0
|
$finally = $self->setblk('std', [$finally]); |
1785
|
|
|
|
|
|
|
} |
1786
|
|
|
|
|
|
|
} |
1787
|
1
|
|
|
|
|
7
|
return $self->setstmt(['try', $try, \@catches, $finally]); |
1788
|
|
|
|
|
|
|
} elsif ((scalar @$tok > 3) && (lc($tok->[0]) eq 'for') && ($tok->[1] eq '(')) { |
1789
|
|
|
|
|
|
|
# note: just for-loops can take ',' operators in pre- and post-cond. |
1790
|
|
|
|
|
|
|
# All 3 expressions can be empty; |
1791
|
|
|
|
|
|
|
# http://php.net/manual/en/control-structures.for.php |
1792
|
|
|
|
|
|
|
# |
1793
|
20
|
|
|
|
|
47
|
shift @$tok; |
1794
|
20
|
|
|
|
|
42
|
shift @$tok; |
1795
|
20
|
|
|
|
|
60
|
my $expr1 = $self->read_code_block($tok, ';', ','); |
1796
|
20
|
|
|
|
|
66
|
my $expr2 = $self->read_code_block($tok, ';', ','); |
1797
|
20
|
|
|
|
|
54
|
my $expr3 = $self->read_code_block($tok, ')', ','); |
1798
|
20
|
|
|
|
|
59
|
my $block; |
1799
|
20
|
50
|
33
|
|
|
88
|
if ((scalar @$tok > 0) && ($tok->[0] eq ':')) { |
1800
|
|
|
|
|
|
|
# allow alternative block syntax |
1801
|
|
|
|
|
|
|
# http://php.net/manual/en/control-structures.alternative-syntax.php |
1802
|
|
|
|
|
|
|
# |
1803
|
0
|
|
|
|
|
0
|
shift @$tok; |
1804
|
0
|
|
|
|
|
0
|
$block = $self->read_code_block($tok, 'endfor', ';'); |
1805
|
0
|
|
|
|
|
0
|
$block = $self->setblk('std', $block); |
1806
|
|
|
|
|
|
|
} else { |
1807
|
20
|
|
|
|
|
47
|
$block = $self->read_statement($tok); |
1808
|
20
|
50
|
|
|
|
52
|
if (!is_block($block)) { |
1809
|
0
|
0
|
0
|
|
|
0
|
if ((scalar @$tok > 0) && ($tok->[0] eq ';')) { |
1810
|
0
|
|
|
|
|
0
|
shift @$tok; |
1811
|
|
|
|
|
|
|
} |
1812
|
|
|
|
|
|
|
# always put '{ .. }' braces around if/else |
1813
|
0
|
|
|
|
|
0
|
$block = $self->setblk('std', [$block]); |
1814
|
|
|
|
|
|
|
} |
1815
|
|
|
|
|
|
|
} |
1816
|
20
|
|
|
|
|
50
|
my $pre = $self->setblk('expr', $expr1); |
1817
|
20
|
|
|
|
|
56
|
my $cond = $self->setblk('expr', $expr2); |
1818
|
20
|
|
|
|
|
63
|
my $post = $self->setblk('expr', $expr3); |
1819
|
20
|
|
|
|
|
80
|
return $self->setstmt(['for', $pre, $cond, $post, $block]); |
1820
|
|
|
|
|
|
|
} elsif ((scalar @$tok > 3) && (lc($tok->[0]) eq 'while') && ($tok->[1] eq '(')) { |
1821
|
10
|
|
|
|
|
24
|
shift @$tok; |
1822
|
10
|
|
|
|
|
22
|
shift @$tok; |
1823
|
10
|
|
|
|
|
28
|
my $expr = $self->read_block($tok, ')', ','); |
1824
|
10
|
|
|
|
|
20
|
my $block; |
1825
|
10
|
50
|
33
|
|
|
45
|
if ((scalar @$tok > 0) && ($tok->[0] eq ':')) { |
1826
|
|
|
|
|
|
|
# allow alternative block syntax |
1827
|
|
|
|
|
|
|
# http://php.net/manual/en/control-structures.alternative-syntax.php |
1828
|
|
|
|
|
|
|
# |
1829
|
0
|
|
|
|
|
0
|
shift @$tok; |
1830
|
0
|
|
|
|
|
0
|
$block = $self->read_code_block($tok, 'endwhile', ';'); |
1831
|
0
|
|
|
|
|
0
|
$block = $self->setblk('std', $block); |
1832
|
|
|
|
|
|
|
} else { |
1833
|
10
|
|
|
|
|
23
|
$block = $self->read_statement($tok); |
1834
|
10
|
100
|
|
|
|
27
|
if (!is_block($block)) { |
1835
|
1
|
50
|
33
|
|
|
7
|
if ((scalar @$tok > 0) && ($tok->[0] eq ';')) { |
1836
|
1
|
|
|
|
|
3
|
shift @$tok; |
1837
|
|
|
|
|
|
|
} |
1838
|
|
|
|
|
|
|
# always put '{ .. }' braces around if/else |
1839
|
1
|
|
|
|
|
5
|
$block = $self->setblk('std', [$block]); |
1840
|
|
|
|
|
|
|
} |
1841
|
|
|
|
|
|
|
} |
1842
|
10
|
50
|
|
|
|
37
|
if (scalar @$expr > 1) { |
1843
|
0
|
|
|
|
|
0
|
$self->{warn}->('parse', "while: bad cond %s", join(' ', @$expr)); |
1844
|
0
|
|
|
|
|
0
|
my $badcond = $self->setblk('expr', $expr); |
1845
|
0
|
|
|
|
|
0
|
$expr = [$badcond]; |
1846
|
|
|
|
|
|
|
} |
1847
|
10
|
|
|
|
|
36
|
return $self->setstmt(['while', $expr->[0], $block]); |
1848
|
|
|
|
|
|
|
} elsif ((scalar @$tok > 3) && (lc($tok->[0]) eq 'do') && ($tok->[1] eq '{')) { |
1849
|
7
|
|
|
|
|
18
|
shift @$tok; |
1850
|
7
|
|
|
|
|
18
|
my $block; |
1851
|
|
|
|
|
|
|
my $expr; |
1852
|
|
|
|
|
|
|
|
1853
|
7
|
|
|
|
|
18
|
$block = $self->read_statement($tok); |
1854
|
7
|
50
|
|
|
|
25
|
if (!is_block($block)) { |
1855
|
0
|
0
|
0
|
|
|
0
|
if ((scalar @$tok > 0) && ($tok->[0] eq ';')) { |
1856
|
0
|
|
|
|
|
0
|
shift @$tok; |
1857
|
|
|
|
|
|
|
} |
1858
|
|
|
|
|
|
|
# always put '{ .. }' braces around do-while block |
1859
|
0
|
|
|
|
|
0
|
$block = $self->setblk('std', [$block]); |
1860
|
|
|
|
|
|
|
} |
1861
|
7
|
50
|
33
|
|
|
59
|
if ((scalar @$tok > 3) && (lc($tok->[0]) eq 'while') && ($tok->[1] eq '(')) { |
|
|
|
33
|
|
|
|
|
1862
|
7
|
|
|
|
|
16
|
shift @$tok; |
1863
|
7
|
|
|
|
|
12
|
shift @$tok; |
1864
|
7
|
|
|
|
|
20
|
$expr = $self->read_block($tok, ')', ','); |
1865
|
|
|
|
|
|
|
|
1866
|
7
|
50
|
|
|
|
55
|
if (scalar @$expr > 1) { |
1867
|
0
|
|
|
|
|
0
|
$self->{warn}->('parse', "do-while: bad cond %s", join(' ', @$expr)); |
1868
|
0
|
|
|
|
|
0
|
my $badcond = $self->setblk('expr', $expr); |
1869
|
0
|
|
|
|
|
0
|
$expr = [$badcond]; |
1870
|
|
|
|
|
|
|
} |
1871
|
|
|
|
|
|
|
} else { |
1872
|
0
|
|
|
|
|
0
|
$self->{warn}->('parse', "do-while: miss while"); |
1873
|
0
|
|
|
|
|
0
|
my $badcond = $self->setblk('expr', undef); |
1874
|
0
|
|
|
|
|
0
|
$expr = [$badcond]; |
1875
|
|
|
|
|
|
|
} |
1876
|
7
|
|
|
|
|
38
|
return $self->setstmt(['do', $expr->[0], $block]); |
1877
|
|
|
|
|
|
|
} elsif ((scalar @$tok > 3) && (lc($tok->[0]) eq 'foreach') && ($tok->[1] eq '(')) { |
1878
|
18
|
|
|
|
|
40
|
shift @$tok; |
1879
|
18
|
|
|
|
|
32
|
shift @$tok; |
1880
|
18
|
|
|
|
|
62
|
my $expr = $self->read_block($tok, ')', ','); |
1881
|
18
|
|
|
|
|
44
|
my $key; |
1882
|
|
|
|
|
|
|
my $value; |
1883
|
|
|
|
|
|
|
|
1884
|
18
|
100
|
66
|
|
|
146
|
if ((scalar @$expr == 3) && (lc($expr->[1]) eq 'as')) { |
|
|
50
|
33
|
|
|
|
|
|
|
|
33
|
|
|
|
|
1885
|
6
|
|
|
|
|
15
|
$value = $expr->[2]; |
1886
|
|
|
|
|
|
|
} elsif ((scalar @$expr == 5) && (lc($expr->[1]) eq 'as') && ($expr->[3] eq '=>')) { |
1887
|
12
|
|
|
|
|
24
|
$key = $expr->[2]; |
1888
|
12
|
|
|
|
|
17
|
$value = $expr->[4]; |
1889
|
|
|
|
|
|
|
} else { |
1890
|
0
|
|
|
|
|
0
|
$self->{warn}->('parse', "foreach: bad expr %s", join(' ', @$expr)); |
1891
|
0
|
|
|
|
|
0
|
my $badcond = $self->setblk('expr', $expr); |
1892
|
0
|
|
|
|
|
0
|
$expr = [$badcond]; |
1893
|
|
|
|
|
|
|
} |
1894
|
18
|
|
|
|
|
33
|
my $block; |
1895
|
18
|
50
|
33
|
|
|
75
|
if ((scalar @$tok > 0) && ($tok->[0] eq ':')) { |
1896
|
|
|
|
|
|
|
# allow alternative block syntax |
1897
|
|
|
|
|
|
|
# http://php.net/manual/en/control-structures.alternative-syntax.php |
1898
|
|
|
|
|
|
|
# |
1899
|
0
|
|
|
|
|
0
|
shift @$tok; |
1900
|
0
|
|
|
|
|
0
|
$block = $self->read_code_block($tok, 'endforeach', ';'); |
1901
|
0
|
|
|
|
|
0
|
$block = $self->setblk('std', $block); |
1902
|
|
|
|
|
|
|
} else { |
1903
|
18
|
|
|
|
|
42
|
$block = $self->read_statement($tok); |
1904
|
18
|
100
|
|
|
|
60
|
if (!is_block($block)) { |
1905
|
1
|
50
|
33
|
|
|
12
|
if ((scalar @$tok > 0) && ($tok->[0] eq ';')) { |
1906
|
1
|
|
|
|
|
3
|
shift @$tok; |
1907
|
|
|
|
|
|
|
} |
1908
|
|
|
|
|
|
|
# always put '{ .. }' braces around if/else |
1909
|
1
|
|
|
|
|
6
|
$block = $self->setblk('std', [$block]); |
1910
|
|
|
|
|
|
|
} |
1911
|
|
|
|
|
|
|
} |
1912
|
18
|
|
|
|
|
106
|
return $self->setstmt(['foreach', $expr->[0], $key, $value, $block]); |
1913
|
|
|
|
|
|
|
} elsif ((scalar @$tok > 2) && ($tok->[0] =~ /^array$/i) && ($tok->[1] eq '(')) { |
1914
|
133
|
|
|
|
|
309
|
shift @$tok; |
1915
|
133
|
|
|
|
|
252
|
shift @$tok; |
1916
|
|
|
|
|
|
|
|
1917
|
133
|
|
|
|
|
395
|
my $arr = $self->newarr(); |
1918
|
133
|
|
|
|
|
507
|
$self->read_array($tok, ')', $arr); |
1919
|
|
|
|
|
|
|
|
1920
|
|
|
|
|
|
|
# execute expr & might continue with operation -> 'array(...)[idx]'? |
1921
|
|
|
|
|
|
|
# |
1922
|
133
|
|
|
|
|
342
|
unshift(@$tok, $arr->{name}); |
1923
|
133
|
|
|
|
|
315
|
return $self->read_statement($tok, $last_op); |
1924
|
|
|
|
|
|
|
} elsif ((scalar @$tok > 4) && ((lc($tok->[0]) eq 'function') || (($tok->[0] =~ /^#pfx\d+$/) && (lc($tok->[1]) eq 'function')))) { |
1925
|
228
|
|
|
|
|
651
|
my $pfx = shift @$tok; |
1926
|
228
|
|
|
|
|
476
|
my $p = {}; |
1927
|
|
|
|
|
|
|
|
1928
|
228
|
100
|
|
|
|
683
|
if ($pfx =~ /^#pfx\d+$/) { |
1929
|
19
|
|
|
|
|
68
|
$p = $self->{strmap}->{$pfx}; |
1930
|
19
|
|
|
|
|
33
|
shift @$tok; |
1931
|
|
|
|
|
|
|
} |
1932
|
228
|
|
|
|
|
355
|
my $cmd; |
1933
|
|
|
|
|
|
|
|
1934
|
|
|
|
|
|
|
# also allow anonymous funcs: http://php.net/manual/en/functions.anonymous.php |
1935
|
|
|
|
|
|
|
# |
1936
|
228
|
100
|
|
|
|
580
|
if ($tok->[0] ne '(') { |
1937
|
212
|
|
|
|
|
433
|
my $sym = shift @$tok; |
1938
|
212
|
|
|
|
|
771
|
$cmd = $self->read_statement([$sym], undef); |
1939
|
212
|
100
|
|
|
|
619
|
if (is_strval($cmd)) { |
1940
|
211
|
|
|
|
|
498
|
$cmd = $self->{strmap}{$cmd}; |
1941
|
|
|
|
|
|
|
} |
1942
|
|
|
|
|
|
|
} |
1943
|
228
|
|
|
|
|
477
|
my $arglist = []; |
1944
|
228
|
50
|
33
|
|
|
907
|
if ((scalar @$tok > 0) && ($tok->[0] eq '(')) { |
1945
|
228
|
|
|
|
|
363
|
shift @$tok; |
1946
|
228
|
|
|
|
|
655
|
$arglist = $self->read_block($tok, ')', ','); |
1947
|
|
|
|
|
|
|
} else { |
1948
|
0
|
|
|
|
|
0
|
$self->{warn}->('parse', "expected function arglist ()"); |
1949
|
|
|
|
|
|
|
} |
1950
|
228
|
|
|
|
|
517
|
my $block = []; |
1951
|
228
|
50
|
33
|
|
|
828
|
if ((scalar @$tok > 0) && ($tok->[0] eq '{')) { |
1952
|
228
|
|
|
|
|
338
|
shift @$tok; |
1953
|
228
|
|
|
|
|
631
|
$block = $self->read_code_block($tok, '}', ';'); |
1954
|
|
|
|
|
|
|
} else { |
1955
|
0
|
|
|
|
|
0
|
$self->{warn}->('parse', "expected function block {}"); |
1956
|
|
|
|
|
|
|
} |
1957
|
228
|
|
|
|
|
660
|
$block = $self->setblk('std', $block); |
1958
|
|
|
|
|
|
|
|
1959
|
|
|
|
|
|
|
# function are registered later via registerfun |
1960
|
|
|
|
|
|
|
# |
1961
|
228
|
|
|
|
|
635
|
my $k = $self->setfun($cmd, $arglist, $block, $p); |
1962
|
|
|
|
|
|
|
|
1963
|
228
|
100
|
|
|
|
509
|
unless (defined $cmd) { |
1964
|
|
|
|
|
|
|
# anonymous functions might be called directly -> 'function () { return 1; }()' |
1965
|
|
|
|
|
|
|
# |
1966
|
16
|
|
|
|
|
39
|
unshift(@$tok, $k); |
1967
|
16
|
|
|
|
|
37
|
$k = $self->read_statement($tok, $last_op); |
1968
|
|
|
|
|
|
|
} |
1969
|
228
|
|
|
|
|
530
|
return $k; |
1970
|
|
|
|
|
|
|
} elsif ((scalar @$tok > 3) && ((lc($tok->[0]) eq 'class') || (($tok->[0] =~ /^#pfx\d+$/) && (lc($tok->[1]) eq 'class')))) { |
1971
|
56
|
|
|
|
|
182
|
my $pfx = shift @$tok; |
1972
|
56
|
|
|
|
|
124
|
my $p = {}; |
1973
|
|
|
|
|
|
|
|
1974
|
56
|
50
|
|
|
|
160
|
if ($pfx =~ /^#pfx\d+$/) { |
1975
|
0
|
|
|
|
|
0
|
$p = $self->{strmap}->{$pfx}; |
1976
|
0
|
|
|
|
|
0
|
shift @$tok; |
1977
|
|
|
|
|
|
|
} |
1978
|
56
|
|
|
|
|
96
|
my $name = shift @$tok; |
1979
|
|
|
|
|
|
|
|
1980
|
|
|
|
|
|
|
# http://php.net/manual/en/language.oop5.basic.php |
1981
|
|
|
|
|
|
|
# |
1982
|
56
|
50
|
|
|
|
154
|
if ($tok->[0] eq 'extends') { |
1983
|
0
|
|
|
|
|
0
|
shift @$tok; |
1984
|
0
|
|
|
|
|
0
|
$p->{parent} = shift @$tok; |
1985
|
|
|
|
|
|
|
} |
1986
|
56
|
|
|
|
|
102
|
my $block = []; |
1987
|
56
|
50
|
33
|
|
|
274
|
if ((scalar @$tok > 0) && ($tok->[0] eq '{')) { |
1988
|
56
|
|
|
|
|
90
|
shift @$tok; |
1989
|
56
|
|
|
|
|
183
|
$block = $self->read_block($tok, '}', ';'); |
1990
|
|
|
|
|
|
|
} |
1991
|
56
|
|
|
|
|
151
|
$block = $self->setblk('std', $block); |
1992
|
56
|
|
|
|
|
180
|
return $self->setclass($name, $block, $p); |
1993
|
|
|
|
|
|
|
} elsif ((scalar @$tok > 3) && (lc($tok->[0]) eq 'trait')) { |
1994
|
1
|
|
|
|
|
3
|
shift @$tok; |
1995
|
1
|
|
|
|
|
3
|
my $name = shift @$tok; |
1996
|
|
|
|
|
|
|
|
1997
|
|
|
|
|
|
|
# https://www.php.net/manual/en/language.oop5.traits.php |
1998
|
|
|
|
|
|
|
# |
1999
|
1
|
|
|
|
|
2
|
my $block = []; |
2000
|
1
|
50
|
33
|
|
|
10
|
if ((scalar @$tok > 0) && ($tok->[0] eq '{')) { |
2001
|
1
|
|
|
|
|
4
|
shift @$tok; |
2002
|
1
|
|
|
|
|
6
|
$block = $self->read_block($tok, '}', ';'); |
2003
|
|
|
|
|
|
|
} |
2004
|
1
|
|
|
|
|
3
|
$block = $self->setblk('std', $block); |
2005
|
1
|
|
|
|
|
5
|
return $self->settrait($name, $block); |
2006
|
|
|
|
|
|
|
} elsif ((scalar @$tok > 1) && ($tok->[0] =~ /^#pfx\d+$/)) { |
2007
|
36
|
|
|
|
|
121
|
my $sym = shift @$tok; |
2008
|
|
|
|
|
|
|
|
2009
|
|
|
|
|
|
|
# TODO: support const and other visibility modifiers |
2010
|
|
|
|
|
|
|
# https://www.php.net/manual/en/language.oop5.visibility.php |
2011
|
|
|
|
|
|
|
# |
2012
|
36
|
50
|
|
|
|
490
|
if (exists $self->{strmap}->{$sym}) { |
2013
|
36
|
|
|
|
|
101
|
my $pfx = $self->{strmap}->{$sym}; |
2014
|
36
|
100
|
|
|
|
103
|
if (exists $pfx->{static}) { |
2015
|
11
|
|
|
|
|
23
|
my @args = (); |
2016
|
11
|
|
|
|
|
17
|
while (1) { |
2017
|
11
|
|
|
|
|
31
|
my $arg = $self->read_statement($tok, undef); |
2018
|
|
|
|
|
|
|
|
2019
|
11
|
|
|
|
|
31
|
push(@args, $arg); |
2020
|
11
|
50
|
33
|
|
|
60
|
unless ((scalar @$tok > 0) && ($tok->[0] eq ',')) { |
2021
|
11
|
|
|
|
|
22
|
last; |
2022
|
|
|
|
|
|
|
} |
2023
|
0
|
|
|
|
|
0
|
shift @$tok; |
2024
|
|
|
|
|
|
|
} |
2025
|
11
|
|
|
|
|
39
|
return $self->setstmt(['static', \@args, $pfx]); |
2026
|
|
|
|
|
|
|
} |
2027
|
25
|
100
|
|
|
|
70
|
if (exists $pfx->{const}) { |
2028
|
9
|
|
|
|
|
41
|
my @args = (); |
2029
|
9
|
|
|
|
|
14
|
while (1) { |
2030
|
9
|
|
|
|
|
42
|
my $arg = $self->read_statement($tok, undef); |
2031
|
|
|
|
|
|
|
|
2032
|
9
|
|
|
|
|
48
|
push(@args, $arg); |
2033
|
9
|
50
|
33
|
|
|
58
|
unless ((scalar @$tok > 0) && ($tok->[0] eq ',')) { |
2034
|
9
|
|
|
|
|
29
|
last; |
2035
|
|
|
|
|
|
|
} |
2036
|
0
|
|
|
|
|
0
|
shift @$tok; |
2037
|
|
|
|
|
|
|
} |
2038
|
9
|
|
|
|
|
30
|
return $self->setstmt(['const', \@args, $pfx]); |
2039
|
|
|
|
|
|
|
} |
2040
|
|
|
|
|
|
|
} |
2041
|
16
|
|
|
|
|
47
|
return $sym; |
2042
|
|
|
|
|
|
|
} elsif ((scalar @$tok > 2) && ($tok->[0] !~ /^([\~\!\+\-\\]|new)$/i) && ($tok->[1] eq '(')) { |
2043
|
|
|
|
|
|
|
# function call |
2044
|
|
|
|
|
|
|
# (function name might be variable) |
2045
|
|
|
|
|
|
|
# |
2046
|
721
|
|
|
|
|
2070
|
my $sym = shift @$tok; |
2047
|
721
|
|
|
|
|
1503
|
my $cmd = $sym; |
2048
|
|
|
|
|
|
|
|
2049
|
721
|
100
|
|
|
|
1641
|
unless (is_symbol($sym)) { |
2050
|
78
|
|
|
|
|
323
|
$cmd = $self->read_statement([$sym], undef); |
2051
|
|
|
|
|
|
|
} |
2052
|
721
|
100
|
100
|
|
|
1994
|
if (defined $last_op && ($last_op eq '$')) { |
2053
|
|
|
|
|
|
|
# handle case: $$var(x) is ${$var}(x) |
2054
|
1
|
|
|
|
|
4
|
return $cmd; |
2055
|
|
|
|
|
|
|
} |
2056
|
720
|
100
|
100
|
|
|
1925
|
if (defined $last_op && ($last_op eq '::')) { |
2057
|
|
|
|
|
|
|
# handle case: (class::member)(x) |
2058
|
23
|
|
|
|
|
90
|
return $cmd; |
2059
|
|
|
|
|
|
|
} |
2060
|
697
|
100
|
100
|
|
|
1629
|
if (defined $last_op && ($last_op eq '->')) { |
2061
|
|
|
|
|
|
|
# handle case: ($obj->method)(x) |
2062
|
26
|
|
|
|
|
92
|
return $cmd; |
2063
|
|
|
|
|
|
|
} |
2064
|
671
|
100
|
100
|
|
|
1612
|
if (defined $last_op && ($last_op eq '\\')) { |
2065
|
|
|
|
|
|
|
# handle case: (ns \\ cmd)(x) |
2066
|
2
|
|
|
|
|
7
|
return $cmd; |
2067
|
|
|
|
|
|
|
} |
2068
|
669
|
100
|
|
|
|
1378
|
if (is_strict_variable($sym)) { |
2069
|
16
|
|
|
|
|
47
|
$cmd = $sym; # don't insert copy anonymous function here |
2070
|
|
|
|
|
|
|
} |
2071
|
669
|
|
|
|
|
1120
|
shift @$tok; |
2072
|
|
|
|
|
|
|
|
2073
|
669
|
50
|
33
|
|
|
1734
|
if (is_strval($cmd) && !is_null($cmd)) { |
2074
|
0
|
|
|
|
|
0
|
$cmd = $self->{strmap}{$cmd}; |
2075
|
|
|
|
|
|
|
} |
2076
|
669
|
50
|
|
|
|
1576
|
if ($cmd =~ /^\@(.*)$/) { |
2077
|
|
|
|
|
|
|
# remove optional '@' error suppress operator |
2078
|
0
|
|
|
|
|
0
|
$cmd = $1; |
2079
|
|
|
|
|
|
|
} |
2080
|
|
|
|
|
|
|
# get arglist so that ref-params are not resolved to value |
2081
|
|
|
|
|
|
|
# (need function definition to decide how to resolve variables) |
2082
|
|
|
|
|
|
|
# |
2083
|
669
|
|
|
|
|
1961
|
my $arglist = $self->read_block($tok, ')', ','); |
2084
|
669
|
|
|
|
|
1230
|
my $k; |
2085
|
669
|
100
|
|
|
|
1594
|
if ($cmd eq 'unset') { |
|
|
100
|
|
|
|
|
|
2086
|
5
|
|
|
|
|
17
|
$k = $self->setstmt(['unset', $arglist]); |
2087
|
|
|
|
|
|
|
} elsif ($cmd eq 'list') { |
2088
|
2
|
|
|
|
|
9
|
my $arr = $self->newarr(); |
2089
|
2
|
|
|
|
|
19
|
foreach my $val (@$arglist) { |
2090
|
4
|
|
|
|
|
16
|
$arr->set(undef, $val); |
2091
|
|
|
|
|
|
|
} |
2092
|
2
|
|
|
|
|
24
|
$k = $arr->{name}; |
2093
|
|
|
|
|
|
|
} else { |
2094
|
662
|
|
|
|
|
1503
|
$k = $self->setcall($cmd, $arglist); |
2095
|
|
|
|
|
|
|
} |
2096
|
669
|
|
|
|
|
1454
|
unshift(@$tok, $k); |
2097
|
669
|
|
|
|
|
1471
|
return $self->read_statement($tok, $last_op); |
2098
|
|
|
|
|
|
|
} elsif ((scalar @$tok > 1) && ($tok->[0] eq '$') && (is_symbol($tok->[1]))) { |
2099
|
|
|
|
|
|
|
# variable reference via $ val => $val |
2100
|
|
|
|
|
|
|
# |
2101
|
0
|
|
|
|
|
0
|
shift @$tok; |
2102
|
0
|
|
|
|
|
0
|
my $sym = shift @$tok; |
2103
|
|
|
|
|
|
|
|
2104
|
0
|
|
|
|
|
0
|
my $str = $self->get_strval_or_str($sym); |
2105
|
0
|
|
|
|
|
0
|
my $var = '$' . $str; |
2106
|
0
|
|
|
|
|
0
|
unshift(@$tok, $var); |
2107
|
0
|
|
|
|
|
0
|
return $self->read_statement($tok, $last_op); |
2108
|
|
|
|
|
|
|
} elsif ((scalar @$tok > 1) && ($tok->[0] eq '$') && ($tok->[1] =~ /^\$/)) { |
2109
|
|
|
|
|
|
|
# variable variable via $ $var => $ |
2110
|
|
|
|
|
|
|
# Attention: |
2111
|
|
|
|
|
|
|
# - $$var[x] is ${$var[x]} |
2112
|
|
|
|
|
|
|
# - $$var(x) is ${$var}(x) |
2113
|
|
|
|
|
|
|
# |
2114
|
6
|
|
|
|
|
13
|
shift @$tok; |
2115
|
6
|
|
|
|
|
15
|
my $res = $self->read_statement($tok, '$'); |
2116
|
6
|
|
|
|
|
19
|
my $k = $self->setexpr('$', undef, $res); |
2117
|
|
|
|
|
|
|
|
2118
|
6
|
|
|
|
|
16
|
unshift(@$tok, $k); |
2119
|
6
|
|
|
|
|
17
|
return $self->read_statement($tok, $last_op); |
2120
|
|
|
|
|
|
|
#} elsif ((scalar @$tok > 1) && ($tok->[0] eq '#') && ($tok->[1] =~ /^(str|num)\d+$/)) { |
2121
|
|
|
|
|
|
|
# # for re-eval: literal reference via # str/num => #str |
2122
|
|
|
|
|
|
|
# # |
2123
|
|
|
|
|
|
|
# shift @$tok; |
2124
|
|
|
|
|
|
|
# my $sym = shift @$tok; |
2125
|
|
|
|
|
|
|
# |
2126
|
|
|
|
|
|
|
# my $var = '#' . $sym; |
2127
|
|
|
|
|
|
|
# unshift(@$tok, $var); |
2128
|
|
|
|
|
|
|
# return $self->read_statement($tok, $last_op); |
2129
|
|
|
|
|
|
|
} elsif ((scalar @$tok > 3) && ($tok->[0] eq '$') && ($tok->[1] eq '{')) { |
2130
|
|
|
|
|
|
|
# variable variable via $ { string } => $string |
2131
|
|
|
|
|
|
|
# variable variable via $ { func(xxx) } is also allowed |
2132
|
|
|
|
|
|
|
# |
2133
|
78
|
|
|
|
|
145
|
shift @$tok; |
2134
|
78
|
|
|
|
|
176
|
shift @$tok; |
2135
|
|
|
|
|
|
|
|
2136
|
78
|
|
|
|
|
254
|
my $arglist = $self->read_block($tok, '}', undef); |
2137
|
78
|
|
|
|
|
143
|
my $k; |
2138
|
78
|
50
|
|
|
|
185
|
if (scalar @$arglist == 1) { |
2139
|
78
|
|
|
|
|
145
|
my $res = $arglist->[0]; |
2140
|
78
|
100
|
|
|
|
160
|
if (is_strval($res)) { |
2141
|
21
|
|
|
|
|
44
|
my $str = $self->{strmap}{$res}; |
2142
|
21
|
100
|
|
|
|
59
|
if (is_symbol($str)) { |
2143
|
16
|
|
|
|
|
66
|
my $var = '$' . $str; |
2144
|
16
|
|
|
|
|
40
|
unshift(@$tok, $var); |
2145
|
16
|
|
|
|
|
34
|
return $self->read_statement($tok, $last_op); |
2146
|
|
|
|
|
|
|
} |
2147
|
|
|
|
|
|
|
} |
2148
|
62
|
|
|
|
|
169
|
$k = $self->setexpr('$', undef, $res); |
2149
|
|
|
|
|
|
|
} else { |
2150
|
0
|
|
|
|
|
0
|
$self->{warn}->('parse', "bad arglist \$ { %s }", join(' ', @$arglist)); |
2151
|
0
|
|
|
|
|
0
|
my $res = $self->setblk('std', $arglist); |
2152
|
0
|
|
|
|
|
0
|
$k = $self->setexpr('$', undef, $res); |
2153
|
|
|
|
|
|
|
} |
2154
|
62
|
|
|
|
|
229
|
unshift(@$tok, $k); |
2155
|
62
|
|
|
|
|
183
|
return $self->read_statement($tok, $last_op); |
2156
|
|
|
|
|
|
|
} elsif ((scalar @$tok > 3) && (is_strict_variable($tok->[0]) || ($tok->[0] =~ /^#/)) && (($tok->[1] eq '[') || ($tok->[1] eq '{'))) { |
2157
|
|
|
|
|
|
|
# array reference via $var['string'] |
2158
|
|
|
|
|
|
|
# or: variable $GLOBALS['string'] -> $string |
2159
|
|
|
|
|
|
|
# or: $strvar[idx] -> char |
2160
|
|
|
|
|
|
|
# |
2161
|
|
|
|
|
|
|
# or: $var[string] -> string |
2162
|
|
|
|
|
|
|
# (old: php autoconverts bare string into string const which |
2163
|
|
|
|
|
|
|
# contains the string - not always the same as the 'str' index |
2164
|
|
|
|
|
|
|
# see: http://php.net/manual/en/language.types.array.php |
2165
|
|
|
|
|
|
|
# see: define('const', 'val') |
2166
|
|
|
|
|
|
|
# ) |
2167
|
|
|
|
|
|
|
# |
2168
|
|
|
|
|
|
|
# http://php.net/manual/de/language.types.string.php |
2169
|
|
|
|
|
|
|
# - Strings may also be accessed using braces, as in $str{42}, |
2170
|
|
|
|
|
|
|
# for the same purpose. However, this syntax is deprecated as |
2171
|
|
|
|
|
|
|
# of php7.4 and disabled in php8. Use square brackets instead. |
2172
|
|
|
|
|
|
|
# |
2173
|
420
|
|
|
|
|
989
|
my $sym = shift @$tok; |
2174
|
|
|
|
|
|
|
|
2175
|
420
|
100
|
100
|
|
|
1358
|
if (defined $last_op && ($last_op eq '::')) { |
2176
|
|
|
|
|
|
|
# handle case: (class::$var)(x) |
2177
|
4
|
|
|
|
|
14
|
return $sym; |
2178
|
|
|
|
|
|
|
} |
2179
|
416
|
50
|
66
|
|
|
936
|
if (defined $last_op && ($last_op eq '->')) { |
2180
|
|
|
|
|
|
|
# handle case: ($obj->var)(x) |
2181
|
0
|
|
|
|
|
0
|
return $sym; |
2182
|
|
|
|
|
|
|
} |
2183
|
416
|
|
|
|
|
757
|
my $bracket = shift @$tok; |
2184
|
416
|
|
|
|
|
629
|
my $arglist; |
2185
|
|
|
|
|
|
|
|
2186
|
416
|
100
|
|
|
|
753
|
if ($bracket eq '[') { |
2187
|
414
|
|
|
|
|
1122
|
$arglist = $self->read_index_block($tok, ']', undef); |
2188
|
|
|
|
|
|
|
} else { |
2189
|
2
|
|
|
|
|
10
|
$arglist = $self->read_index_block($tok, '}', undef); |
2190
|
|
|
|
|
|
|
} |
2191
|
416
|
50
|
|
|
|
1115
|
if (scalar @$arglist > 1) { |
2192
|
0
|
|
|
|
|
0
|
$self->{warn}->('parse', "bad arglist %s [ %s ]", $sym, join(' ', @$arglist)); |
2193
|
0
|
|
|
|
|
0
|
unshift(@$tok, ('[', @$arglist, ']')); |
2194
|
0
|
|
|
|
|
0
|
return $sym; |
2195
|
|
|
|
|
|
|
} |
2196
|
416
|
100
|
100
|
|
|
1519
|
if ((scalar @$arglist == 1) && is_strval($arglist->[0])) { |
|
|
50
|
66
|
|
|
|
|
2197
|
320
|
|
|
|
|
612
|
my $str = $arglist->[0]; |
2198
|
320
|
|
|
|
|
496
|
if (0) { |
2199
|
|
|
|
|
|
|
if ($sym =~ /^\$GLOBALS$/) { |
2200
|
|
|
|
|
|
|
my $val = $self->get_strval($str); |
2201
|
|
|
|
|
|
|
my $var = '$' . $val; |
2202
|
|
|
|
|
|
|
unshift(@$tok, $var); |
2203
|
|
|
|
|
|
|
my $res = $self->read_statement($tok, $last_op); |
2204
|
|
|
|
|
|
|
return $res; |
2205
|
|
|
|
|
|
|
} |
2206
|
|
|
|
|
|
|
} |
2207
|
|
|
|
|
|
|
} elsif ((scalar @$arglist == 1) && (is_symbol($arglist->[0]))) { |
2208
|
|
|
|
|
|
|
# bare string |
2209
|
0
|
|
|
|
|
0
|
my $str = $arglist->[0]; |
2210
|
0
|
|
|
|
|
0
|
my $k = $self->setstr($str); |
2211
|
0
|
|
|
|
|
0
|
unshift(@$tok, ($sym, '[', $k, ']')); |
2212
|
0
|
|
|
|
|
0
|
my $res = $self->read_statement($tok, $last_op); |
2213
|
0
|
|
|
|
|
0
|
return $res; |
2214
|
|
|
|
|
|
|
} |
2215
|
416
|
|
|
|
|
1205
|
my $k = $self->setelem($sym, $arglist->[0]); |
2216
|
|
|
|
|
|
|
|
2217
|
|
|
|
|
|
|
# execute expr & might continue with lower prio operation |
2218
|
|
|
|
|
|
|
# |
2219
|
416
|
|
|
|
|
942
|
unshift(@$tok, $k); |
2220
|
416
|
|
|
|
|
935
|
return $self->read_statement($tok, $last_op); |
2221
|
|
|
|
|
|
|
} elsif ((scalar @$tok > 2) && ($tok->[0] =~ /^(\+|\-)$/) && ($tok->[1] eq $tok->[0])) { |
2222
|
|
|
|
|
|
|
# ++$var |
2223
|
|
|
|
|
|
|
# --$var |
2224
|
|
|
|
|
|
|
# |
2225
|
12
|
|
|
|
|
35
|
my $op = shift @$tok; |
2226
|
12
|
|
|
|
|
23
|
shift @$tok; |
2227
|
|
|
|
|
|
|
|
2228
|
12
|
|
|
|
|
66
|
my $var = $self->read_statement($tok, "$op$op"); |
2229
|
12
|
|
|
|
|
99
|
my $k = $self->setexpr($op.$op, undef, $var); |
2230
|
|
|
|
|
|
|
|
2231
|
|
|
|
|
|
|
# execute expr & might continue with lower prio operation |
2232
|
|
|
|
|
|
|
# |
2233
|
12
|
|
|
|
|
40
|
unshift(@$tok, $k); |
2234
|
12
|
|
|
|
|
37
|
return $self->read_statement($tok, $last_op); |
2235
|
|
|
|
|
|
|
} elsif ((scalar @$tok > 3) && ($tok->[0] eq '.') && ($tok->[1] eq '.') && ($tok->[2] eq '.')) { |
2236
|
|
|
|
|
|
|
# ...$var |
2237
|
|
|
|
|
|
|
# |
2238
|
0
|
|
|
|
|
0
|
shift @$tok; |
2239
|
0
|
|
|
|
|
0
|
shift @$tok; |
2240
|
0
|
|
|
|
|
0
|
shift @$tok; |
2241
|
|
|
|
|
|
|
|
2242
|
0
|
|
|
|
|
0
|
my $var = $self->read_statement($tok, '...'); |
2243
|
0
|
|
|
|
|
0
|
my $k = $self->setexpr('...', undef, $var); |
2244
|
|
|
|
|
|
|
|
2245
|
|
|
|
|
|
|
# execute expr & might continue with lower prio operation |
2246
|
|
|
|
|
|
|
# |
2247
|
0
|
|
|
|
|
0
|
unshift(@$tok, $k); |
2248
|
0
|
|
|
|
|
0
|
return $self->read_statement($tok, $last_op); |
2249
|
|
|
|
|
|
|
} elsif ((scalar @$tok > 1) && ($tok->[0] =~ /^\\$/)) { |
2250
|
|
|
|
|
|
|
# \val |
2251
|
|
|
|
|
|
|
# |
2252
|
7
|
|
|
|
|
17
|
my $op = shift @$tok; |
2253
|
|
|
|
|
|
|
|
2254
|
7
|
|
|
|
|
23
|
my $val = $self->read_statement($tok, $op); |
2255
|
7
|
|
|
|
|
18
|
my $k = $self->setns(undef, $val); # toplevel namespace |
2256
|
|
|
|
|
|
|
|
2257
|
|
|
|
|
|
|
# execute expr & might continue with lower prio operation |
2258
|
|
|
|
|
|
|
# |
2259
|
7
|
|
|
|
|
16
|
unshift(@$tok, $k); |
2260
|
7
|
|
|
|
|
18
|
return $self->read_statement($tok, $last_op); |
2261
|
|
|
|
|
|
|
} elsif ((scalar @$tok > 1) && ($tok->[0] =~ /^([\~\!\+\-]|new|exception)$/i)) { |
2262
|
|
|
|
|
|
|
# ~val |
2263
|
|
|
|
|
|
|
# !val |
2264
|
|
|
|
|
|
|
# +val |
2265
|
|
|
|
|
|
|
# -val |
2266
|
|
|
|
|
|
|
# new val |
2267
|
|
|
|
|
|
|
# |
2268
|
66
|
|
|
|
|
178
|
my $op = shift @$tok; |
2269
|
66
|
|
|
|
|
155
|
my $val; |
2270
|
|
|
|
|
|
|
|
2271
|
66
|
100
|
100
|
|
|
361
|
if (($op eq '+') || ($op eq '-')) { |
|
|
100
|
|
|
|
|
|
2272
|
7
|
|
|
|
|
24
|
$val = $self->read_statement($tok, '+-'); |
2273
|
|
|
|
|
|
|
} elsif (lc($op) eq 'new') { |
2274
|
|
|
|
|
|
|
# add optional parenthesis for 'new a' if necessary |
2275
|
|
|
|
|
|
|
# -> with parenthesis $val is parsed as #call |
2276
|
|
|
|
|
|
|
# |
2277
|
39
|
|
|
|
|
109
|
$val = $self->read_statement($tok, $op); |
2278
|
39
|
100
|
|
|
|
167
|
if ($val =~ /^#(str|const)/) { |
2279
|
7
|
|
|
|
|
28
|
$val = $self->setcall($self->{strmap}->{$val}, []); |
2280
|
|
|
|
|
|
|
} |
2281
|
|
|
|
|
|
|
} else { |
2282
|
20
|
|
|
|
|
68
|
$val = $self->read_statement($tok, $op); |
2283
|
|
|
|
|
|
|
} |
2284
|
66
|
|
|
|
|
222
|
my $k = $self->setexpr($op, undef, $val); |
2285
|
|
|
|
|
|
|
|
2286
|
|
|
|
|
|
|
# execute expr & might continue with lower prio operation |
2287
|
|
|
|
|
|
|
# |
2288
|
66
|
|
|
|
|
172
|
unshift(@$tok, $k); |
2289
|
66
|
|
|
|
|
216
|
return $self->read_statement($tok, $last_op); |
2290
|
|
|
|
|
|
|
} elsif ((scalar @$tok > 2) && ($tok->[1] =~ /^([\.\+\-\*\/\^\&\|\%<>\?\:]|=|\!|==|\!=|<>|<=|>=|<<|>>|===|\!==|<=>|\?\:|\?\?|\&\&|\|\||\+\+|\-\-|and|or|xor|instanceof|\->|::|\\)$/i)) { |
2291
|
|
|
|
|
|
|
# val1 . val2 |
2292
|
|
|
|
|
|
|
# val1 + val2 |
2293
|
|
|
|
|
|
|
# val1 - val2 |
2294
|
|
|
|
|
|
|
# val1 ^ val2 |
2295
|
|
|
|
|
|
|
# ... |
2296
|
|
|
|
|
|
|
# |
2297
|
1329
|
100
|
100
|
|
|
3836
|
if (($tok->[1] =~ /^[<>\&\|\*\?]$/) && ($tok->[2] eq $tok->[1])) { |
2298
|
|
|
|
|
|
|
# val1 << val2 (also: <<=) |
2299
|
|
|
|
|
|
|
# val1 >> val2 (also: >>=) |
2300
|
|
|
|
|
|
|
# val1 ** val2 (also: **=) |
2301
|
|
|
|
|
|
|
# val1 ?? val2 (also: ??=) |
2302
|
|
|
|
|
|
|
# val1 || val2 |
2303
|
|
|
|
|
|
|
# val1 && val2 |
2304
|
|
|
|
|
|
|
# |
2305
|
16
|
|
|
|
|
47
|
my $sym = shift @$tok; |
2306
|
16
|
|
|
|
|
43
|
my $op = shift @$tok; |
2307
|
16
|
|
|
|
|
27
|
shift @$tok; |
2308
|
16
|
|
|
|
|
89
|
unshift(@$tok, ($sym, $op.$op)); |
2309
|
|
|
|
|
|
|
# fall through |
2310
|
|
|
|
|
|
|
} |
2311
|
1329
|
100
|
100
|
|
|
3937
|
if (($tok->[2] eq '=') && ($tok->[1] =~ /^([\.\+\-\*\/\^\&\|\%]|<<|>>|\*\*|\?\?)$/)) { |
2312
|
|
|
|
|
|
|
# num += ... |
2313
|
|
|
|
|
|
|
# num .= ... |
2314
|
|
|
|
|
|
|
# |
2315
|
29
|
|
|
|
|
78
|
my $sym = shift @$tok; |
2316
|
29
|
|
|
|
|
67
|
my $op = shift @$tok; |
2317
|
29
|
|
|
|
|
54
|
shift @$tok; |
2318
|
|
|
|
|
|
|
|
2319
|
|
|
|
|
|
|
# keep in_block flag for '=' |
2320
|
29
|
|
|
|
|
97
|
my $op2 = $self->read_statement($tok, undef); |
2321
|
|
|
|
|
|
|
|
2322
|
|
|
|
|
|
|
# keep precedence of $op against following expr |
2323
|
29
|
|
|
|
|
99
|
my $k2 = $self->setexpr($op, $sym, $op2); |
2324
|
29
|
|
|
|
|
97
|
unshift(@$tok, ($sym, '=', $k2)); |
2325
|
29
|
|
|
|
|
75
|
return $self->read_statement($tok, $last_op); |
2326
|
|
|
|
|
|
|
} |
2327
|
1300
|
100
|
100
|
|
|
4115
|
if (($tok->[1] eq '=') && ($tok->[2] eq '>')) { |
2328
|
|
|
|
|
|
|
# $expr1 => |
2329
|
|
|
|
|
|
|
# |
2330
|
45
|
|
|
|
|
151
|
my $sym = shift @$tok; |
2331
|
45
|
|
|
|
|
87
|
shift @$tok; |
2332
|
45
|
|
|
|
|
67
|
shift @$tok; |
2333
|
45
|
|
|
|
|
125
|
unshift(@$tok, ($sym, '=>')); |
2334
|
|
|
|
|
|
|
|
2335
|
45
|
|
|
|
|
128
|
return $self->read_statement($tok, $last_op); |
2336
|
|
|
|
|
|
|
} |
2337
|
1255
|
100
|
100
|
|
|
19806
|
if (($tok->[1] =~ /^(\+|\-)$/) && ($tok->[2] eq $tok->[1]) && (is_strict_variable($tok->[0]) || ($tok->[0] =~ /^#(scope|inst)\d+$/))) { |
|
|
100
|
66
|
|
|
|
|
|
|
100
|
100
|
|
|
|
|
|
|
100
|
100
|
|
|
|
|
|
|
50
|
100
|
|
|
|
|
|
|
50
|
100
|
|
|
|
|
|
|
100
|
100
|
|
|
|
|
|
|
100
|
100
|
|
|
|
|
|
|
100
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
66
|
|
|
|
|
|
|
|
66
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
66
|
|
|
|
|
|
|
|
100
|
|
|
|
|
2338
|
|
|
|
|
|
|
# $var++ |
2339
|
|
|
|
|
|
|
# $var-- |
2340
|
|
|
|
|
|
|
# |
2341
|
35
|
|
|
|
|
130
|
my $sym = shift @$tok; |
2342
|
35
|
|
|
|
|
94
|
my $op = shift @$tok; |
2343
|
35
|
|
|
|
|
61
|
shift @$tok; |
2344
|
35
|
|
|
|
|
121
|
unshift(@$tok, ($sym, $op.$op)); |
2345
|
|
|
|
|
|
|
# fall through |
2346
|
|
|
|
|
|
|
} elsif ((scalar @$tok > 3) && ($tok->[1] =~ /^[=\!]$/) && ($tok->[2] eq '=') && ($tok->[3] eq '=')) { |
2347
|
|
|
|
|
|
|
# val1 === val2 |
2348
|
|
|
|
|
|
|
# val1 !== val2 |
2349
|
|
|
|
|
|
|
# |
2350
|
5
|
|
|
|
|
16
|
my $sym = shift @$tok; |
2351
|
5
|
|
|
|
|
13
|
my $op = shift @$tok; |
2352
|
5
|
|
|
|
|
13
|
shift @$tok; |
2353
|
5
|
|
|
|
|
9
|
shift @$tok; |
2354
|
5
|
|
|
|
|
19
|
unshift(@$tok, ($sym, $op.'==')); |
2355
|
|
|
|
|
|
|
# fall through |
2356
|
|
|
|
|
|
|
} elsif ((scalar @$tok > 3) && ($tok->[1] eq '<') && ($tok->[2] eq '=') && ($tok->[3] eq '>')) { |
2357
|
|
|
|
|
|
|
# val1 <=> val2 |
2358
|
|
|
|
|
|
|
# |
2359
|
3
|
|
|
|
|
7
|
my $sym = shift @$tok; |
2360
|
3
|
|
|
|
|
5
|
my $op = shift @$tok; |
2361
|
3
|
|
|
|
|
6
|
shift @$tok; |
2362
|
3
|
|
|
|
|
5
|
shift @$tok; |
2363
|
3
|
|
|
|
|
10
|
unshift(@$tok, ($sym, '<=>')); |
2364
|
|
|
|
|
|
|
# fall through |
2365
|
|
|
|
|
|
|
} elsif (($tok->[1] =~ /^[=\!<>]$/) && ($tok->[2] eq '=')) { |
2366
|
|
|
|
|
|
|
# val1 == val2 |
2367
|
|
|
|
|
|
|
# val1 != val2 |
2368
|
|
|
|
|
|
|
# val1 <= val2 |
2369
|
|
|
|
|
|
|
# val1 >= val2 |
2370
|
|
|
|
|
|
|
# |
2371
|
20
|
|
|
|
|
79
|
my $sym = shift @$tok; |
2372
|
20
|
|
|
|
|
54
|
my $op = shift @$tok; |
2373
|
20
|
|
|
|
|
45
|
shift @$tok; |
2374
|
20
|
|
|
|
|
69
|
unshift(@$tok, ($sym, $op.'=')); |
2375
|
|
|
|
|
|
|
# fall through |
2376
|
|
|
|
|
|
|
} elsif (($tok->[1] eq '<') && ($tok->[2] eq '>')) { |
2377
|
|
|
|
|
|
|
# val1 <> val2 (diamond operator work as !=) |
2378
|
|
|
|
|
|
|
# |
2379
|
0
|
|
|
|
|
0
|
my $sym = shift @$tok; |
2380
|
0
|
|
|
|
|
0
|
my $op = shift @$tok; |
2381
|
0
|
|
|
|
|
0
|
shift @$tok; |
2382
|
0
|
|
|
|
|
0
|
unshift(@$tok, ($sym, '!=')); |
2383
|
|
|
|
|
|
|
# fall through |
2384
|
|
|
|
|
|
|
} elsif (($tok->[1] =~ /^[=\!]$/) && ($tok->[2] eq '==')) { # TODO: does this occur? |
2385
|
|
|
|
|
|
|
# val1 === val2 |
2386
|
|
|
|
|
|
|
# val1 !== val2 |
2387
|
|
|
|
|
|
|
# |
2388
|
0
|
|
|
|
|
0
|
my $sym = shift @$tok; |
2389
|
0
|
|
|
|
|
0
|
my $op = shift @$tok; |
2390
|
0
|
|
|
|
|
0
|
shift @$tok; |
2391
|
0
|
|
|
|
|
0
|
unshift(@$tok, ($sym, $op.'==')); |
2392
|
|
|
|
|
|
|
# fall through |
2393
|
|
|
|
|
|
|
} elsif (($tok->[1] eq '-') && ($tok->[2] eq '>')) { |
2394
|
|
|
|
|
|
|
# $obj -> member |
2395
|
|
|
|
|
|
|
# |
2396
|
52
|
|
|
|
|
120
|
my $sym = shift @$tok; |
2397
|
52
|
|
|
|
|
100
|
shift @$tok; |
2398
|
52
|
|
|
|
|
92
|
shift @$tok; |
2399
|
52
|
|
|
|
|
151
|
unshift(@$tok, ($sym, '->')); # for operator precedence |
2400
|
|
|
|
|
|
|
# fall through |
2401
|
|
|
|
|
|
|
} elsif (($tok->[1] eq ':') && ($tok->[2] eq ':')) { |
2402
|
|
|
|
|
|
|
# class :: elem |
2403
|
|
|
|
|
|
|
# |
2404
|
41
|
|
|
|
|
114
|
my $sym = shift @$tok; |
2405
|
41
|
|
|
|
|
94
|
shift @$tok; |
2406
|
41
|
|
|
|
|
63
|
shift @$tok; |
2407
|
41
|
|
|
|
|
130
|
unshift(@$tok, ($sym, '::')); |
2408
|
|
|
|
|
|
|
# fall through |
2409
|
|
|
|
|
|
|
} elsif (($tok->[1] eq '?') && ($tok->[2] eq ':')) { |
2410
|
|
|
|
|
|
|
# ternary: $expr1 ?: $expr3 |
2411
|
|
|
|
|
|
|
# |
2412
|
3
|
|
|
|
|
12
|
my $sym = shift @$tok; |
2413
|
3
|
|
|
|
|
9
|
shift @$tok; |
2414
|
3
|
|
|
|
|
5
|
shift @$tok; |
2415
|
3
|
|
|
|
|
10
|
unshift(@$tok, ($sym, '?:')); |
2416
|
|
|
|
|
|
|
# fall through |
2417
|
|
|
|
|
|
|
} |
2418
|
|
|
|
|
|
|
# remaining binary ops |
2419
|
|
|
|
|
|
|
# variable assignment |
2420
|
|
|
|
|
|
|
# |
2421
|
1255
|
|
|
|
|
2718
|
my $sym = shift @$tok; |
2422
|
1255
|
|
|
|
|
2521
|
my $op = shift @$tok; |
2423
|
1255
|
|
|
|
|
1741
|
my $op1; |
2424
|
1255
|
|
|
|
|
2063
|
$op = lc($op); |
2425
|
|
|
|
|
|
|
|
2426
|
1255
|
100
|
100
|
|
|
5047
|
if (($op eq '->') || ($op eq '::') || ($op eq '\\')) { |
|
|
|
100
|
|
|
|
|
2427
|
103
|
|
|
|
|
172
|
$op1 = $sym; # don't evaluate lefthand side variable |
2428
|
|
|
|
|
|
|
} else { |
2429
|
1152
|
|
|
|
|
3983
|
$op1 = $self->read_statement([$sym], undef); |
2430
|
|
|
|
|
|
|
} |
2431
|
1255
|
100
|
|
|
|
2928
|
if (defined $last_op) { |
2432
|
175
|
50
|
|
|
|
632
|
unless (exists $op_prio{$op}) { |
2433
|
0
|
|
|
|
|
0
|
$self->{warn}->('parse', "missing op_prio(%s) [last %s]", $op, $last_op); |
2434
|
|
|
|
|
|
|
} |
2435
|
175
|
50
|
|
|
|
441
|
unless (exists $op_prio{$last_op}) { |
2436
|
0
|
|
|
|
|
0
|
$self->{warn}->('parse', "op_prio(%s) [op %s]", $last_op, $op); |
2437
|
|
|
|
|
|
|
} |
2438
|
175
|
50
|
|
|
|
442
|
$self->{debug}->('parse', "SYM $sym OP %s LAST %s", $op, $last_op) if $self->{debug}; |
2439
|
175
|
100
|
|
|
|
492
|
if ($op_prio{$op} >= $op_prio{$last_op}) { |
2440
|
|
|
|
|
|
|
# - for right associative ops like '=' continue to parse left-hand side. |
2441
|
|
|
|
|
|
|
# - but for identical ops like '$a=$b=1' parse right-hand side first. |
2442
|
|
|
|
|
|
|
# - there is a special case for unary op and '=' ('!$x=2' is same as '!($x=2)') |
2443
|
|
|
|
|
|
|
# |
2444
|
66
|
100
|
100
|
|
|
329
|
if (($op ne $last_op) || !exists $op_right{$op}) { |
2445
|
62
|
100
|
100
|
|
|
266
|
unless (($op eq '=') && (exists $op_unary{$last_op} || !exists $op_right{$last_op})) { |
|
|
|
100
|
|
|
|
|
2446
|
58
|
50
|
|
|
|
145
|
$self->{log}->('parse', "curr %s %s has higher/equal prio than last %s", $op1, $op, $last_op) if $self->{log}; |
2447
|
58
|
|
|
|
|
131
|
unshift(@$tok, $op); |
2448
|
58
|
|
|
|
|
147
|
return $op1; |
2449
|
|
|
|
|
|
|
} |
2450
|
|
|
|
|
|
|
} |
2451
|
|
|
|
|
|
|
} |
2452
|
|
|
|
|
|
|
} |
2453
|
1197
|
|
|
|
|
1741
|
my $k; |
2454
|
1197
|
100
|
100
|
|
|
5663
|
if ($op eq '?') { |
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
2455
|
|
|
|
|
|
|
# ternary: $op1 ? $expr2 : $expr3 |
2456
|
|
|
|
|
|
|
# |
2457
|
15
|
|
|
|
|
41
|
my $expr2 = $self->read_statement($tok, $op); |
2458
|
15
|
50
|
33
|
|
|
81
|
if ((scalar @$tok > 0) && $tok->[0] eq ':') { |
2459
|
15
|
|
|
|
|
28
|
shift @$tok; |
2460
|
|
|
|
|
|
|
} else { |
2461
|
0
|
|
|
|
|
0
|
$self->{warn}->('parse', "ternary: missing : [%s ? %s]", $sym, $expr2); |
2462
|
|
|
|
|
|
|
} |
2463
|
15
|
|
|
|
|
39
|
my $expr3 = $self->read_statement($tok, ':'); |
2464
|
15
|
|
|
|
|
44
|
my $op2 = $self->setexpr(':', $expr2, $expr3); |
2465
|
15
|
|
|
|
|
37
|
$k = $self->setexpr('?', $op1, $op2); |
2466
|
|
|
|
|
|
|
} elsif ($op eq '->') { |
2467
|
|
|
|
|
|
|
# $obj -> member |
2468
|
|
|
|
|
|
|
# |
2469
|
52
|
|
|
|
|
162
|
my $op2 = $self->read_statement($tok, $op); |
2470
|
|
|
|
|
|
|
|
2471
|
52
|
100
|
|
|
|
129
|
if (is_block($op2)) { |
2472
|
|
|
|
|
|
|
# $obj -> {'member'} |
2473
|
|
|
|
|
|
|
# |
2474
|
2
|
|
|
|
|
8
|
my ($type, $a) = @{$self->{strmap}->{$op2}}; |
|
2
|
|
|
|
|
45
|
|
2475
|
2
|
50
|
|
|
|
8
|
if (scalar @$a == 1) { |
2476
|
2
|
|
|
|
|
7
|
$op2 = $a->[0]; |
2477
|
|
|
|
|
|
|
} |
2478
|
|
|
|
|
|
|
} |
2479
|
52
|
|
|
|
|
143
|
$op2 = $self->get_strval_or_str($op2); |
2480
|
|
|
|
|
|
|
|
2481
|
52
|
|
|
|
|
167
|
$k = $self->setobj($op1, $op2); |
2482
|
|
|
|
|
|
|
} elsif ($op eq '::') { |
2483
|
|
|
|
|
|
|
# class :: member |
2484
|
|
|
|
|
|
|
# |
2485
|
41
|
|
|
|
|
71
|
my $class = $sym; |
2486
|
41
|
100
|
|
|
|
127
|
unless (is_symbol($sym)) { |
2487
|
1
|
|
|
|
|
8
|
$class = $self->read_statement([$sym], undef); |
2488
|
1
|
|
|
|
|
16
|
$class = $self->get_strval_or_str($class); |
2489
|
|
|
|
|
|
|
} |
2490
|
41
|
|
|
|
|
139
|
my $elem = $self->read_statement($tok, $op); |
2491
|
41
|
|
|
|
|
140
|
$elem = $self->get_strval_or_str($elem); |
2492
|
|
|
|
|
|
|
|
2493
|
41
|
|
|
|
|
120
|
$k = $self->setscope($class, $elem); |
2494
|
|
|
|
|
|
|
} elsif ($op eq '\\') { |
2495
|
|
|
|
|
|
|
# ns/elem |
2496
|
|
|
|
|
|
|
# |
2497
|
5
|
|
|
|
|
28
|
my $op2 = $self->read_statement($tok, $op); |
2498
|
5
|
|
|
|
|
13
|
$op1 = $self->get_strval_or_str($op1); |
2499
|
|
|
|
|
|
|
|
2500
|
5
|
|
|
|
|
18
|
$k = $self->setns($op1, $op2); |
2501
|
|
|
|
|
|
|
} elsif (($op eq '++') || ($op eq '--')) { |
2502
|
|
|
|
|
|
|
# $var++ |
2503
|
|
|
|
|
|
|
# $var-- |
2504
|
|
|
|
|
|
|
# |
2505
|
35
|
|
|
|
|
226
|
$k = $self->setexpr($op, $op1, undef); |
2506
|
|
|
|
|
|
|
} else { |
2507
|
1049
|
|
|
|
|
1482
|
if (1) { |
2508
|
|
|
|
|
|
|
# optimize long concat chains to avoid memory exhaustion |
2509
|
|
|
|
|
|
|
# (sometimes hundreds of strings get concatted) |
2510
|
|
|
|
|
|
|
# |
2511
|
1049
|
50
|
100
|
|
|
2333
|
if (($op eq '.') && is_strval($op1) && (scalar @$tok > 2) && is_strval($tok->[0]) && ($tok->[1] eq '.')) { |
|
|
|
100
|
|
|
|
|
|
|
|
66
|
|
|
|
|
|
|
|
33
|
|
|
|
|
2512
|
0
|
|
|
|
|
0
|
my @list; |
2513
|
0
|
|
|
|
|
0
|
push(@list, $op1); |
2514
|
0
|
|
0
|
|
|
0
|
while ((scalar @$tok > 2) && is_strval($tok->[0]) && ($tok->[1] eq '.')) { |
|
|
|
0
|
|
|
|
|
2515
|
0
|
|
|
|
|
0
|
my $s = shift @$tok; |
2516
|
0
|
|
|
|
|
0
|
shift @$tok; |
2517
|
0
|
|
|
|
|
0
|
push(@list, $s); |
2518
|
|
|
|
|
|
|
} |
2519
|
0
|
|
|
|
|
0
|
$self->{warn}->('parse', "optimize concat chain here: %s", join(' ', @list)); |
2520
|
0
|
|
|
|
|
0
|
my $line = join('', map { $self->{strmap}->{$_} } @list); |
|
0
|
|
|
|
|
0
|
|
2521
|
0
|
|
|
|
|
0
|
$op1 = $self->setstr($line); |
2522
|
|
|
|
|
|
|
} |
2523
|
|
|
|
|
|
|
} |
2524
|
1049
|
|
|
|
|
2254
|
my $op2 = $self->read_statement($tok, $op); |
2525
|
1049
|
|
|
|
|
2542
|
$k = $self->setexpr($op, $op1, $op2); |
2526
|
|
|
|
|
|
|
} |
2527
|
|
|
|
|
|
|
# execute expr & might continue with lower prio operation |
2528
|
|
|
|
|
|
|
# |
2529
|
1197
|
|
|
|
|
2496
|
unshift(@$tok, $k); |
2530
|
1197
|
|
|
|
|
2903
|
return $self->read_statement($tok, $last_op); |
2531
|
|
|
|
|
|
|
} |
2532
|
|
|
|
|
|
|
|
2533
|
13
|
50
|
|
|
|
63
|
if (scalar @$tok > 0) { |
2534
|
13
|
|
|
|
|
37
|
my $sym = shift @$tok; |
2535
|
|
|
|
|
|
|
|
2536
|
|
|
|
|
|
|
# some symbols are pushed back into token-stream and might be passed through here |
2537
|
|
|
|
|
|
|
# |
2538
|
13
|
50
|
|
|
|
42
|
$self->{log}->('parse', "skip symbol %s", $sym) if $self->{log}; |
2539
|
13
|
|
|
|
|
45
|
return $sym; |
2540
|
|
|
|
|
|
|
} |
2541
|
0
|
|
|
|
|
0
|
return; |
2542
|
|
|
|
|
|
|
} |
2543
|
|
|
|
|
|
|
|
2544
|
|
|
|
|
|
|
# last_op & in_block are optional params |
2545
|
|
|
|
|
|
|
# |
2546
|
|
|
|
|
|
|
sub read_statement { |
2547
|
13401
|
|
|
13401
|
0
|
22311
|
my ($self, $tok, $last_op) = @_; |
2548
|
13401
|
|
|
|
|
17400
|
my $level = 0; |
2549
|
|
|
|
|
|
|
|
2550
|
13401
|
100
|
|
|
|
25490
|
if (exists $self->{strmap}->{_LEVEL}) { |
2551
|
12681
|
|
|
|
|
18869
|
$self->{strmap}->{_LEVEL} += 1; |
2552
|
|
|
|
|
|
|
} else { |
2553
|
720
|
|
|
|
|
1922
|
$self->{strmap}->{_LEVEL} = 1; |
2554
|
|
|
|
|
|
|
} |
2555
|
13401
|
|
|
|
|
20159
|
$level = $self->{strmap}->{_LEVEL}; |
2556
|
|
|
|
|
|
|
|
2557
|
|
|
|
|
|
|
# show next 10 tokens to process |
2558
|
|
|
|
|
|
|
# |
2559
|
13401
|
100
|
|
|
|
24263
|
my $tl = (scalar @$tok > 10) ? 10 : scalar @$tok; |
2560
|
|
|
|
|
|
|
#$self->{log}->('PARSE', "[%d:%d] %s %s", $level, scalar @$tok, join(' ', @$tok[0..$tl-1]), (scalar @$tok > 10) ? '...' : '') if $self->{log}; |
2561
|
13401
|
100
|
|
|
|
29775
|
my $tab = ($level <= 1) ? '' : ('....' x ($level-2)) . '... '; |
2562
|
13401
|
0
|
|
|
|
25114
|
$self->{log}->('PARSE', "$tab%s%s", join(' ', @$tok[0..$tl-1]), (scalar @$tok > 10) ? ' ..['.(scalar @$tok - 10).']' : '') if $self->{log}; |
|
|
50
|
|
|
|
|
|
2563
|
|
|
|
|
|
|
|
2564
|
13401
|
|
|
|
|
26724
|
my $ret = $self->_read_statement($tok, $last_op); |
2565
|
13401
|
|
|
|
|
21437
|
$self->{strmap}->{_LEVEL} -= 1; |
2566
|
13401
|
|
|
|
|
26350
|
return $ret; |
2567
|
|
|
|
|
|
|
} |
2568
|
|
|
|
|
|
|
|
2569
|
|
|
|
|
|
|
sub filter_bad_brace { |
2570
|
3544
|
|
|
3544
|
0
|
6032
|
my ($stmt) = @_; |
2571
|
|
|
|
|
|
|
|
2572
|
3544
|
50
|
|
|
|
8311
|
if ($stmt =~ /^[\)\]\}]$/) { |
2573
|
0
|
|
|
|
|
0
|
$stmt = ""; |
2574
|
|
|
|
|
|
|
} |
2575
|
3544
|
|
|
|
|
6460
|
return $stmt; |
2576
|
|
|
|
|
|
|
} |
2577
|
|
|
|
|
|
|
|
2578
|
|
|
|
|
|
|
sub read_index_block { |
2579
|
416
|
|
|
416
|
0
|
844
|
my ($self, $tok, $close, $separator) = @_; |
2580
|
416
|
|
|
|
|
655
|
my @out = (); |
2581
|
|
|
|
|
|
|
|
2582
|
416
|
50
|
|
|
|
968
|
$self->{debug}->('parse', "B+$close") if $self->{debug}; |
2583
|
|
|
|
|
|
|
|
2584
|
416
|
|
|
|
|
874
|
while (scalar @$tok > 0) { |
2585
|
|
|
|
|
|
|
# always resolve assignment in index to value |
2586
|
|
|
|
|
|
|
# |
2587
|
816
|
|
|
|
|
1777
|
my $stmt = $self->read_statement($tok, undef); |
2588
|
|
|
|
|
|
|
|
2589
|
816
|
50
|
|
|
|
1677
|
$self->{debug}->('parse', "B-$close $stmt") if $self->{debug}; |
2590
|
|
|
|
|
|
|
|
2591
|
816
|
100
|
33
|
|
|
1787
|
if ($stmt eq $close) { |
|
|
50
|
|
|
|
|
|
2592
|
|
|
|
|
|
|
# block end |
2593
|
|
|
|
|
|
|
# |
2594
|
416
|
|
|
|
|
1116
|
return \@out; |
2595
|
|
|
|
|
|
|
} elsif (defined $separator && ($stmt eq $separator)) { |
2596
|
|
|
|
|
|
|
#push(@out, $separator); |
2597
|
|
|
|
|
|
|
} else { |
2598
|
400
|
|
|
|
|
834
|
$stmt = filter_bad_brace($stmt); |
2599
|
400
|
|
|
|
|
1231
|
push(@out, $stmt); |
2600
|
|
|
|
|
|
|
} |
2601
|
|
|
|
|
|
|
} |
2602
|
0
|
|
|
|
|
0
|
return \@out; |
2603
|
|
|
|
|
|
|
} |
2604
|
|
|
|
|
|
|
|
2605
|
|
|
|
|
|
|
sub read_block { |
2606
|
1261
|
|
|
1261
|
0
|
2613
|
my ($self, $tok, $close, $separator) = @_; |
2607
|
1261
|
|
|
|
|
1808
|
my @out = (); |
2608
|
1261
|
|
|
|
|
1796
|
my $last; |
2609
|
|
|
|
|
|
|
|
2610
|
1261
|
50
|
|
|
|
2652
|
$self->{debug}->('parse', "B+$close") if $self->{debug}; |
2611
|
|
|
|
|
|
|
|
2612
|
1261
|
|
|
|
|
2581
|
while (scalar @$tok > 0) { |
2613
|
2526
|
|
|
|
|
5148
|
my $stmt = $self->read_statement($tok, undef); |
2614
|
|
|
|
|
|
|
|
2615
|
2526
|
50
|
|
|
|
4877
|
$self->{debug}->('parse', "B-$close $stmt") if $self->{debug}; |
2616
|
|
|
|
|
|
|
|
2617
|
2526
|
100
|
100
|
|
|
6056
|
if ($stmt eq $close) { |
|
|
100
|
|
|
|
|
|
2618
|
|
|
|
|
|
|
# block end |
2619
|
|
|
|
|
|
|
# |
2620
|
1261
|
|
|
|
|
3201
|
return \@out; |
2621
|
|
|
|
|
|
|
} elsif (defined $separator && ($stmt eq $separator)) { |
2622
|
147
|
50
|
33
|
|
|
612
|
if (defined $last && ($last eq $separator)) { |
2623
|
0
|
|
|
|
|
0
|
push(@out, undef); # allow empty field |
2624
|
|
|
|
|
|
|
} |
2625
|
|
|
|
|
|
|
#push(@out, $separator); |
2626
|
|
|
|
|
|
|
} else { |
2627
|
1118
|
|
|
|
|
2121
|
$stmt = filter_bad_brace($stmt); |
2628
|
1118
|
|
|
|
|
2169
|
push(@out, $stmt); |
2629
|
|
|
|
|
|
|
} |
2630
|
1265
|
|
|
|
|
2752
|
$last = $stmt; |
2631
|
|
|
|
|
|
|
} |
2632
|
0
|
|
|
|
|
0
|
return \@out; |
2633
|
|
|
|
|
|
|
} |
2634
|
|
|
|
|
|
|
|
2635
|
|
|
|
|
|
|
sub read_code_block { |
2636
|
1269
|
|
|
1269
|
0
|
2644
|
my ($self, $tok, $close, $separator) = @_; |
2637
|
1269
|
|
|
|
|
1830
|
my @out = (); |
2638
|
|
|
|
|
|
|
|
2639
|
1269
|
50
|
|
|
|
2913
|
$self->{debug}->('parse', "B+$close") if $self->{debug}; |
2640
|
|
|
|
|
|
|
|
2641
|
1269
|
|
|
|
|
2550
|
while (scalar @$tok > 0) { |
2642
|
3558
|
|
|
|
|
7364
|
my $stmt = $self->read_statement($tok, undef); |
2643
|
|
|
|
|
|
|
|
2644
|
3558
|
50
|
|
|
|
7543
|
$self->{debug}->('parse', "B-$close $stmt") if $self->{debug}; |
2645
|
|
|
|
|
|
|
|
2646
|
3558
|
100
|
66
|
|
|
11698
|
if ($stmt eq $close) { |
|
|
100
|
|
|
|
|
|
2647
|
|
|
|
|
|
|
# block end |
2648
|
|
|
|
|
|
|
# |
2649
|
476
|
|
|
|
|
1308
|
return \@out; |
2650
|
|
|
|
|
|
|
} elsif (defined $separator && ($stmt eq $separator)) { |
2651
|
|
|
|
|
|
|
#push(@out, $separator); |
2652
|
|
|
|
|
|
|
} else { |
2653
|
2026
|
|
|
|
|
3831
|
$stmt = filter_bad_brace($stmt); |
2654
|
2026
|
|
|
|
|
5645
|
push(@out, $stmt); |
2655
|
|
|
|
|
|
|
} |
2656
|
|
|
|
|
|
|
} |
2657
|
793
|
|
|
|
|
1811
|
return \@out; |
2658
|
|
|
|
|
|
|
} |
2659
|
|
|
|
|
|
|
|
2660
|
|
|
|
|
|
|
sub tokens { |
2661
|
1
|
|
|
1
|
0
|
394
|
my ($self) = @_; |
2662
|
1
|
|
|
|
|
3
|
return $self->{tok}; |
2663
|
|
|
|
|
|
|
} |
2664
|
|
|
|
|
|
|
|
2665
|
|
|
|
|
|
|
sub read_code { |
2666
|
785
|
|
|
785
|
1
|
2068
|
my ($self, $tok) = @_; |
2667
|
785
|
|
|
|
|
1119
|
my $in; |
2668
|
785
|
|
|
|
|
1152
|
my @out = (); |
2669
|
|
|
|
|
|
|
|
2670
|
785
|
|
|
|
|
1742
|
$in = unspace_list($tok); |
2671
|
|
|
|
|
|
|
|
2672
|
785
|
|
|
|
|
1941
|
my $stmts = $self->read_code_block($in, '?>', ';'); |
2673
|
785
|
100
|
|
|
|
1961
|
if (scalar @$stmts == 1) { |
2674
|
331
|
|
|
|
|
1384
|
return $stmts->[0]; |
2675
|
|
|
|
|
|
|
} |
2676
|
454
|
|
|
|
|
979
|
my $k = $self->setblk('flat', $stmts); |
2677
|
454
|
|
|
|
|
1616
|
return $k; |
2678
|
|
|
|
|
|
|
} |
2679
|
|
|
|
|
|
|
|
2680
|
|
|
|
|
|
|
sub map_stmt { |
2681
|
3116
|
|
|
3116
|
0
|
5819
|
my ($self, $s, $cb, @params) = @_; |
2682
|
|
|
|
|
|
|
|
2683
|
|
|
|
|
|
|
#$self->{log}->('MAP', "$s") if $self->{log}; |
2684
|
|
|
|
|
|
|
|
2685
|
3116
|
|
|
|
|
6131
|
my $k = $cb->($s, @params); |
2686
|
3116
|
100
|
|
|
|
5475
|
if (defined $k) { |
2687
|
286
|
|
|
|
|
629
|
return $k; |
2688
|
|
|
|
|
|
|
} |
2689
|
2830
|
|
|
|
|
4024
|
my $s0 = $s; |
2690
|
|
|
|
|
|
|
|
2691
|
2830
|
50
|
|
|
|
21993
|
if (!defined $s) { |
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
2692
|
0
|
|
|
|
|
0
|
$self->{warn}->('map', "undefined symbol"); |
2693
|
|
|
|
|
|
|
# keep |
2694
|
|
|
|
|
|
|
} elsif ($s =~ /^#null$/) { |
2695
|
|
|
|
|
|
|
# keep |
2696
|
|
|
|
|
|
|
} elsif ($s =~ /^#num\d+$/) { |
2697
|
|
|
|
|
|
|
# keep |
2698
|
|
|
|
|
|
|
} elsif ($s =~ /^#const\d+$/) { |
2699
|
|
|
|
|
|
|
# keep |
2700
|
|
|
|
|
|
|
} elsif ($s =~ /^#str\d+$/) { |
2701
|
|
|
|
|
|
|
# keep |
2702
|
|
|
|
|
|
|
} elsif ($s =~ /^#arr\d+$/) { |
2703
|
133
|
|
|
|
|
272
|
my $arr = $self->{strmap}{$s}; |
2704
|
133
|
|
|
|
|
442
|
my $keys = $arr->get_keys(); |
2705
|
133
|
|
|
|
|
210
|
my %newmap; |
2706
|
133
|
|
|
|
|
211
|
my @newkeys = (); |
2707
|
133
|
|
|
|
|
194
|
my $changed = 0; |
2708
|
|
|
|
|
|
|
|
2709
|
133
|
|
|
|
|
273
|
foreach my $k (@$keys) { |
2710
|
236
|
|
|
|
|
545
|
my $val = $arr->val($k); |
2711
|
236
|
50
|
33
|
|
|
531
|
if ((is_int_index($k) || is_strval($k)) && (!defined $val |
|
|
|
33
|
|
|
|
|
|
|
|
33
|
|
|
|
|
2712
|
|
|
|
|
|
|
|| (defined $val && is_strval($val)))) { |
2713
|
236
|
|
|
|
|
432
|
push(@newkeys, $k); |
2714
|
236
|
|
|
|
|
569
|
$newmap{$k} = $val; |
2715
|
|
|
|
|
|
|
} else { |
2716
|
0
|
|
|
|
|
0
|
my $k2 = $k; |
2717
|
0
|
0
|
|
|
|
0
|
unless (is_int_index($k)) { |
2718
|
0
|
|
|
|
|
0
|
$k2 = $self->map_stmt($k, $cb, @params); |
2719
|
|
|
|
|
|
|
} |
2720
|
0
|
|
|
|
|
0
|
push(@newkeys, $k2); |
2721
|
0
|
0
|
|
|
|
0
|
if (defined $val) { |
2722
|
0
|
|
|
|
|
0
|
my $v = $self->map_stmt($val, $cb, @params); |
2723
|
0
|
|
|
|
|
0
|
$newmap{$k2} = $v; |
2724
|
|
|
|
|
|
|
} else { |
2725
|
0
|
|
|
|
|
0
|
$newmap{$k2} = undef; |
2726
|
|
|
|
|
|
|
} |
2727
|
0
|
0
|
0
|
|
|
0
|
if (($k ne $k2) || ($val ne $newmap{$k2})) { |
2728
|
0
|
|
|
|
|
0
|
$changed = 1; |
2729
|
|
|
|
|
|
|
} |
2730
|
|
|
|
|
|
|
} |
2731
|
|
|
|
|
|
|
} |
2732
|
133
|
50
|
|
|
|
440
|
if ($changed) { |
2733
|
0
|
|
|
|
|
0
|
$arr = $self->newarr(); |
2734
|
0
|
|
|
|
|
0
|
foreach my $k (@newkeys) { |
2735
|
0
|
|
|
|
|
0
|
$arr->set($k, $newmap{$k}); |
2736
|
|
|
|
|
|
|
} |
2737
|
0
|
|
|
|
|
0
|
$s = $arr->{name}; |
2738
|
|
|
|
|
|
|
} |
2739
|
|
|
|
|
|
|
} elsif ($s =~ /^#fun\d+$/) { |
2740
|
14
|
|
|
|
|
22
|
my ($f, $a, $b, $p) = @{$self->{strmap}->{$s}}; |
|
14
|
|
|
|
|
38
|
|
2741
|
|
|
|
|
|
|
# no context change here |
2742
|
|
|
|
|
|
|
} elsif ($s =~ /^#call\d+$/) { |
2743
|
87
|
|
|
|
|
124
|
my ($f, $a) = @{$self->{strmap}->{$s}}; |
|
87
|
|
|
|
|
248
|
|
2744
|
87
|
|
|
|
|
154
|
my @args = (); |
2745
|
87
|
|
|
|
|
137
|
my $arg_changed = 0; |
2746
|
87
|
|
|
|
|
131
|
my $name = $f; |
2747
|
|
|
|
|
|
|
|
2748
|
87
|
50
|
|
|
|
161
|
if ($f =~ /^#fun\d+$/) { |
2749
|
|
|
|
|
|
|
# no context change here |
2750
|
|
|
|
|
|
|
#$name = $self->map_stmt($f, $cb, @params); |
2751
|
|
|
|
|
|
|
} else { |
2752
|
87
|
|
|
|
|
189
|
$name = $self->map_stmt($f, $cb, @params); |
2753
|
|
|
|
|
|
|
} |
2754
|
87
|
|
|
|
|
218
|
foreach my $k (@$a) { |
2755
|
65
|
|
|
|
|
120
|
my $v = $self->map_stmt($k, $cb, @params); |
2756
|
65
|
|
|
|
|
128
|
push(@args, $v); |
2757
|
65
|
50
|
|
|
|
152
|
if ($v ne $k) { |
2758
|
0
|
|
|
|
|
0
|
$arg_changed = 1; |
2759
|
|
|
|
|
|
|
} |
2760
|
|
|
|
|
|
|
} |
2761
|
87
|
50
|
33
|
|
|
353
|
if (($name ne $f) || $arg_changed) { |
2762
|
0
|
|
|
|
|
0
|
$s = $self->setcall($name, \@args); |
2763
|
|
|
|
|
|
|
} |
2764
|
|
|
|
|
|
|
} elsif ($s =~ /^#elem\d+$/) { |
2765
|
50
|
|
|
|
|
73
|
my ($v, $i) = @{$self->{strmap}->{$s}}; |
|
50
|
|
|
|
|
145
|
|
2766
|
50
|
|
|
|
|
209
|
my $vv = $self->map_stmt($v, $cb, @params); |
2767
|
50
|
|
|
|
|
93
|
my $ii = $i; |
2768
|
|
|
|
|
|
|
|
2769
|
50
|
50
|
|
|
|
124
|
if (defined $i) { |
2770
|
50
|
|
|
|
|
104
|
$ii = $self->map_stmt($i, $cb, @params); |
2771
|
|
|
|
|
|
|
} |
2772
|
50
|
50
|
33
|
|
|
273
|
if (($v ne $vv) || (defined $i && ($i ne $ii))) { |
|
|
|
33
|
|
|
|
|
2773
|
0
|
|
|
|
|
0
|
$s = $self->setelem($vv, $ii); |
2774
|
|
|
|
|
|
|
} |
2775
|
|
|
|
|
|
|
} elsif ($s =~ /^#expr\d+$/) { |
2776
|
|
|
|
|
|
|
# if v1 missing: prefix op |
2777
|
|
|
|
|
|
|
# if v2 missing: postfix op |
2778
|
282
|
|
|
|
|
560
|
my ($op, $v1, $v2) = @{$self->{strmap}->{$s}}; |
|
282
|
|
|
|
|
775
|
|
2779
|
282
|
|
|
|
|
490
|
my $vv1 = $v1; |
2780
|
282
|
|
|
|
|
387
|
my $vv2 = $v2; |
2781
|
|
|
|
|
|
|
|
2782
|
282
|
100
|
|
|
|
562
|
if (defined $v1) { |
2783
|
276
|
|
|
|
|
592
|
$vv1 = $self->map_stmt($v1, $cb, @params); |
2784
|
|
|
|
|
|
|
} |
2785
|
282
|
50
|
|
|
|
577
|
if (defined $v2) { |
2786
|
282
|
|
|
|
|
569
|
$vv2 = $self->map_stmt($v2, $cb, @params); |
2787
|
|
|
|
|
|
|
} |
2788
|
282
|
100
|
100
|
|
|
2021
|
if ((defined $v1 && ($v1 ne $vv1)) || (defined $v2 && ($v2 ne $vv2))) { |
|
|
|
33
|
|
|
|
|
|
|
|
66
|
|
|
|
|
2789
|
10
|
|
|
|
|
27
|
$s = $self->setexpr($op, $vv1, $vv2); |
2790
|
|
|
|
|
|
|
} |
2791
|
|
|
|
|
|
|
} elsif ($s =~ /^#pfx\d+$/) { |
2792
|
|
|
|
|
|
|
# keep |
2793
|
|
|
|
|
|
|
} elsif ($s =~ /^#obj\d+$/) { |
2794
|
12
|
|
|
|
|
31
|
my ($o, $m) = @{$self->{strmap}->{$s}}; |
|
12
|
|
|
|
|
33
|
|
2795
|
12
|
|
|
|
|
20
|
my $oo = $o; |
2796
|
12
|
|
|
|
|
22
|
my $mm = $m; |
2797
|
|
|
|
|
|
|
|
2798
|
12
|
50
|
|
|
|
32
|
unless ($o =~ /^#call\d+$/) { |
2799
|
|
|
|
|
|
|
# not 'new' |
2800
|
12
|
|
|
|
|
28
|
$oo = $self->map_stmt($o, $cb, @params); |
2801
|
|
|
|
|
|
|
} |
2802
|
12
|
50
|
33
|
|
|
44
|
unless (exists $self->{strmap}->{$m} && is_symbol($self->{strmap}->{$m})) { |
2803
|
|
|
|
|
|
|
# not 'sym' |
2804
|
12
|
|
|
|
|
30
|
$mm = $self->map_stmt($m, $cb, @params); |
2805
|
|
|
|
|
|
|
} |
2806
|
12
|
50
|
33
|
|
|
74
|
if (($o ne $oo) || ($m ne $mm)) { |
2807
|
0
|
|
|
|
|
0
|
$s = $self->setobj($oo, $mm); |
2808
|
|
|
|
|
|
|
} |
2809
|
|
|
|
|
|
|
} elsif ($s =~ /^#scope\d+$/) { |
2810
|
0
|
|
|
|
|
0
|
my ($c, $e) = @{$self->{strmap}->{$s}}; |
|
0
|
|
|
|
|
0
|
|
2811
|
0
|
|
|
|
|
0
|
my $cc = $c; |
2812
|
0
|
|
|
|
|
0
|
my $ee = $e; |
2813
|
|
|
|
|
|
|
|
2814
|
0
|
0
|
0
|
|
|
0
|
unless (exists $self->{strmap}->{$c} && is_symbol($self->{strmap}->{$c})) { |
2815
|
|
|
|
|
|
|
# not 'class' |
2816
|
0
|
|
|
|
|
0
|
$cc = $self->map_stmt($c, $cb, @params); |
2817
|
|
|
|
|
|
|
} |
2818
|
0
|
0
|
0
|
|
|
0
|
unless (exists $self->{strmap}->{$e} && is_symbol($self->{strmap}->{$e})) { |
2819
|
|
|
|
|
|
|
# not 'sym' |
2820
|
0
|
|
|
|
|
0
|
$ee = $self->map_stmt($e, $cb, @params); |
2821
|
|
|
|
|
|
|
} |
2822
|
0
|
0
|
0
|
|
|
0
|
if (($c ne $cc) || ($e ne $ee)) { |
2823
|
0
|
|
|
|
|
0
|
$s = $self->setscope($cc, $ee); |
2824
|
|
|
|
|
|
|
} |
2825
|
|
|
|
|
|
|
} elsif ($s =~ /^#ns\d+$/) { |
2826
|
0
|
|
|
|
|
0
|
my ($n, $e) = @{$self->{strmap}->{$s}}; |
|
0
|
|
|
|
|
0
|
|
2827
|
0
|
|
|
|
|
0
|
my $nn = $n; |
2828
|
0
|
|
|
|
|
0
|
my $ee = $self->map_stmt($e, $cb, @params); |
2829
|
|
|
|
|
|
|
|
2830
|
0
|
0
|
|
|
|
0
|
if (defined $n) { |
2831
|
|
|
|
|
|
|
# non-sym should be error |
2832
|
0
|
0
|
0
|
|
|
0
|
unless (exists $self->{strmap}->{$n} && is_symbol($self->{strmap}->{$n})) { |
2833
|
0
|
|
|
|
|
0
|
$nn = $self->map_stmt($n, $cb, @params); |
2834
|
|
|
|
|
|
|
} |
2835
|
|
|
|
|
|
|
} |
2836
|
0
|
0
|
0
|
|
|
0
|
if ((defined $n && ($n ne $nn)) || ($e ne $ee)) { |
|
|
|
0
|
|
|
|
|
2837
|
0
|
|
|
|
|
0
|
$s = $self->setobj($nn, $ee); |
2838
|
|
|
|
|
|
|
} |
2839
|
|
|
|
|
|
|
} elsif ($s =~ /^#inst\d+$/) { |
2840
|
0
|
|
|
|
|
0
|
my ($c, $f, $i) = @{$self->{strmap}->{$s}}; |
|
0
|
|
|
|
|
0
|
|
2841
|
|
|
|
|
|
|
} elsif ($s =~ /^#ref\d+$/) { |
2842
|
0
|
|
|
|
|
0
|
my ($v) = @{$self->{strmap}->{$s}}; |
|
0
|
|
|
|
|
0
|
|
2843
|
|
|
|
|
|
|
} elsif ($s =~ /^#class\d+$/) { |
2844
|
0
|
|
|
|
|
0
|
my ($c, $b, $p) = @{$self->{strmap}->{$s}}; |
|
0
|
|
|
|
|
0
|
|
2845
|
|
|
|
|
|
|
# no context change here |
2846
|
|
|
|
|
|
|
} elsif ($s =~ /^#trait\d+$/) { |
2847
|
0
|
|
|
|
|
0
|
my ($t, $b) = @{$self->{strmap}->{$s}}; |
|
0
|
|
|
|
|
0
|
|
2848
|
|
|
|
|
|
|
# no context change here |
2849
|
|
|
|
|
|
|
} elsif ($s =~ /^#fh\d+$/) { |
2850
|
0
|
|
|
|
|
0
|
my $f = $self->{strmap}->{$s}{name}; |
2851
|
0
|
|
|
|
|
0
|
my $m = $self->{strmap}->{$s}{mode}; |
2852
|
0
|
|
|
|
|
0
|
my $p = $self->{strmap}->{$s}{pos}; |
2853
|
|
|
|
|
|
|
} elsif ($s =~ /^#blk\d+$/) { |
2854
|
602
|
|
|
|
|
945
|
my ($type, $a) = @{$self->{strmap}->{$s}}; |
|
602
|
|
|
|
|
1612
|
|
2855
|
602
|
|
|
|
|
1185
|
my @args = (); |
2856
|
602
|
|
|
|
|
831
|
my $arg_changed = 0; |
2857
|
|
|
|
|
|
|
|
2858
|
602
|
|
|
|
|
1288
|
foreach my $k (@$a) { |
2859
|
698
|
|
|
|
|
1572
|
my $v = $self->map_stmt($k, $cb, @params); |
2860
|
698
|
100
|
|
|
|
1443
|
if ($v ne $k) { |
2861
|
93
|
100
|
|
|
|
258
|
unless ($self->is_empty_block($v)) { |
2862
|
18
|
|
|
|
|
35
|
push(@args, $v); |
2863
|
|
|
|
|
|
|
} |
2864
|
93
|
|
|
|
|
194
|
$arg_changed = 1; |
2865
|
|
|
|
|
|
|
} else { |
2866
|
605
|
|
|
|
|
1357
|
push(@args, $v); |
2867
|
|
|
|
|
|
|
} |
2868
|
|
|
|
|
|
|
} |
2869
|
602
|
100
|
|
|
|
1274
|
if ($arg_changed) { |
2870
|
85
|
|
|
|
|
204
|
$s = $self->setblk($type, \@args); |
2871
|
|
|
|
|
|
|
} |
2872
|
|
|
|
|
|
|
} elsif ($s =~ /^#stmt\d+$/) { |
2873
|
529
|
|
|
|
|
1200
|
my $cmd = $self->{strmap}->{$s}->[0]; |
2874
|
529
|
100
|
|
|
|
2813
|
if ($cmd eq 'echo') { |
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
2875
|
108
|
|
|
|
|
205
|
my $a = $self->{strmap}->{$s}->[1]; |
2876
|
108
|
|
|
|
|
181
|
my @args = (); |
2877
|
108
|
|
|
|
|
151
|
my $arg_changed = 0; |
2878
|
|
|
|
|
|
|
|
2879
|
108
|
|
|
|
|
254
|
foreach my $k (@$a) { |
2880
|
108
|
|
|
|
|
217
|
my $v = $self->map_stmt($k, $cb, @params); |
2881
|
108
|
|
|
|
|
220
|
push(@args, $v); |
2882
|
108
|
50
|
|
|
|
270
|
if ($v ne $k) { |
2883
|
0
|
|
|
|
|
0
|
$arg_changed = 1; |
2884
|
|
|
|
|
|
|
} |
2885
|
|
|
|
|
|
|
} |
2886
|
108
|
50
|
|
|
|
255
|
if ($arg_changed) { |
2887
|
0
|
|
|
|
|
0
|
$s = $self->setstmt(['echo', \@args]); |
2888
|
|
|
|
|
|
|
} |
2889
|
|
|
|
|
|
|
} elsif ($cmd eq 'print') { |
2890
|
0
|
|
|
|
|
0
|
my $arg = $self->{strmap}->{$s}->[1]; |
2891
|
0
|
|
|
|
|
0
|
my $v = $self->map_stmt($arg, $cb, @params); |
2892
|
|
|
|
|
|
|
|
2893
|
0
|
0
|
|
|
|
0
|
if ($v ne $arg) { |
2894
|
0
|
|
|
|
|
0
|
$s = $self->setstmt(['print', $v]); |
2895
|
|
|
|
|
|
|
} |
2896
|
|
|
|
|
|
|
} elsif ($cmd eq 'namespace') { |
2897
|
0
|
|
|
|
|
0
|
my ($arg, $block) = @{$self->{strmap}->{$s}}[1..2]; |
|
0
|
|
|
|
|
0
|
|
2898
|
0
|
|
|
|
|
0
|
my $v = $arg; |
2899
|
0
|
|
|
|
|
0
|
my $block1 = $block; |
2900
|
|
|
|
|
|
|
|
2901
|
0
|
0
|
|
|
|
0
|
if (defined $block) { |
2902
|
0
|
|
|
|
|
0
|
$block1 = $self->map_stmt($block, $cb, @params); |
2903
|
|
|
|
|
|
|
} |
2904
|
0
|
0
|
0
|
|
|
0
|
if (($v ne $arg) || ($block1 ne $block)) { |
2905
|
0
|
|
|
|
|
0
|
$s = $self->setstmt(['namespace', $v, $block1]); |
2906
|
|
|
|
|
|
|
} |
2907
|
|
|
|
|
|
|
} elsif ($cmd =~ /^(include|include_once|require|require_once)$/) { |
2908
|
0
|
|
|
|
|
0
|
my $arg = $self->{strmap}->{$s}->[1]; |
2909
|
0
|
|
|
|
|
0
|
my $v = $self->map_stmt($arg, $cb, @params); |
2910
|
|
|
|
|
|
|
|
2911
|
0
|
0
|
|
|
|
0
|
if ($v ne $arg) { |
2912
|
0
|
|
|
|
|
0
|
$s = $self->setstmt([$cmd, $v]); |
2913
|
|
|
|
|
|
|
} |
2914
|
|
|
|
|
|
|
} elsif ($cmd eq 'use') { |
2915
|
0
|
|
|
|
|
0
|
my $a = $self->{strmap}->{$s}->[1]; |
2916
|
0
|
|
|
|
|
0
|
my @args = (); |
2917
|
0
|
|
|
|
|
0
|
my $arg_changed = 0; |
2918
|
|
|
|
|
|
|
|
2919
|
0
|
|
|
|
|
0
|
foreach my $k (@$a) { |
2920
|
0
|
|
|
|
|
0
|
my $v = $self->map_stmt($k, $cb, @params); |
2921
|
0
|
|
|
|
|
0
|
push(@args, $v); |
2922
|
0
|
0
|
|
|
|
0
|
if ($v ne $k) { |
2923
|
0
|
|
|
|
|
0
|
$arg_changed = 1; |
2924
|
|
|
|
|
|
|
} |
2925
|
|
|
|
|
|
|
} |
2926
|
0
|
0
|
|
|
|
0
|
if ($arg_changed) { |
2927
|
0
|
|
|
|
|
0
|
$s = $self->setstmt(['use', \@args]); |
2928
|
|
|
|
|
|
|
} |
2929
|
|
|
|
|
|
|
} elsif ($cmd eq 'global') { |
2930
|
8
|
|
|
|
|
23
|
my $a = $self->{strmap}->{$s}->[1]; |
2931
|
8
|
|
|
|
|
14
|
my @args = (); |
2932
|
8
|
|
|
|
|
16
|
my $arg_changed = 0; |
2933
|
|
|
|
|
|
|
|
2934
|
8
|
|
|
|
|
18
|
foreach my $k (@$a) { |
2935
|
8
|
|
|
|
|
16
|
my $v = $self->map_stmt($k, $cb, @params); |
2936
|
8
|
|
|
|
|
21
|
push(@args, $v); |
2937
|
8
|
50
|
|
|
|
25
|
if ($v ne $k) { |
2938
|
0
|
|
|
|
|
0
|
$arg_changed = 1; |
2939
|
|
|
|
|
|
|
} |
2940
|
|
|
|
|
|
|
} |
2941
|
8
|
50
|
|
|
|
22
|
if ($arg_changed) { |
2942
|
0
|
|
|
|
|
0
|
$s = $self->setstmt(['global', \@args]); |
2943
|
|
|
|
|
|
|
} |
2944
|
|
|
|
|
|
|
} elsif ($cmd eq 'static') { |
2945
|
8
|
|
|
|
|
17
|
my ($a, $p) = @{$self->{strmap}->{$s}}[1..2]; |
|
8
|
|
|
|
|
21
|
|
2946
|
8
|
|
|
|
|
13
|
my @args = (); |
2947
|
8
|
|
|
|
|
12
|
my $arg_changed = 0; |
2948
|
|
|
|
|
|
|
|
2949
|
8
|
|
|
|
|
16
|
foreach my $k (@$a) { |
2950
|
8
|
|
|
|
|
25
|
my $v = $self->map_stmt($k, $cb, @params); |
2951
|
8
|
|
|
|
|
15
|
push(@args, $v); |
2952
|
8
|
50
|
|
|
|
20
|
if ($v ne $k) { |
2953
|
0
|
|
|
|
|
0
|
$arg_changed = 1; |
2954
|
|
|
|
|
|
|
} |
2955
|
|
|
|
|
|
|
} |
2956
|
8
|
50
|
|
|
|
19
|
if ($arg_changed) { |
2957
|
0
|
|
|
|
|
0
|
$s = $self->setstmt(['static', \@args, $p]); |
2958
|
|
|
|
|
|
|
} |
2959
|
|
|
|
|
|
|
} elsif ($cmd eq 'const') { |
2960
|
0
|
|
|
|
|
0
|
my ($a, $p) = @{$self->{strmap}->{$s}}[1..2]; |
|
0
|
|
|
|
|
0
|
|
2961
|
0
|
|
|
|
|
0
|
my @args = (); |
2962
|
0
|
|
|
|
|
0
|
my $arg_changed = 0; |
2963
|
|
|
|
|
|
|
|
2964
|
0
|
|
|
|
|
0
|
foreach my $k (@$a) { |
2965
|
0
|
|
|
|
|
0
|
my $v = $self->map_stmt($k, $cb, @params); |
2966
|
0
|
|
|
|
|
0
|
push(@args, $v); |
2967
|
0
|
0
|
|
|
|
0
|
if ($v ne $k) { |
2968
|
0
|
|
|
|
|
0
|
$arg_changed = 1; |
2969
|
|
|
|
|
|
|
} |
2970
|
|
|
|
|
|
|
} |
2971
|
0
|
0
|
|
|
|
0
|
if ($arg_changed) { |
2972
|
0
|
|
|
|
|
0
|
$s = $self->setstmt(['const', \@args, $p]); |
2973
|
|
|
|
|
|
|
} |
2974
|
|
|
|
|
|
|
} elsif ($cmd eq 'unset') { |
2975
|
0
|
|
|
|
|
0
|
my $a = $self->{strmap}->{$s}->[1]; |
2976
|
0
|
|
|
|
|
0
|
my @args = (); |
2977
|
0
|
|
|
|
|
0
|
my $arg_changed = 0; |
2978
|
|
|
|
|
|
|
|
2979
|
0
|
|
|
|
|
0
|
foreach my $k (@$a) { |
2980
|
0
|
|
|
|
|
0
|
my $v = $self->map_stmt($k, $cb, @params); |
2981
|
0
|
|
|
|
|
0
|
push(@args, $v); |
2982
|
0
|
0
|
|
|
|
0
|
if ($v ne $k) { |
2983
|
0
|
|
|
|
|
0
|
$arg_changed = 1; |
2984
|
|
|
|
|
|
|
} |
2985
|
|
|
|
|
|
|
} |
2986
|
0
|
0
|
|
|
|
0
|
if ($arg_changed) { |
2987
|
0
|
|
|
|
|
0
|
$s = $self->setstmt(['unset', \@args]); |
2988
|
|
|
|
|
|
|
} |
2989
|
|
|
|
|
|
|
} elsif ($cmd eq 'return') { |
2990
|
386
|
|
|
|
|
638
|
my $arg = $self->{strmap}->{$s}->[1]; |
2991
|
386
|
|
|
|
|
645
|
my $v = $arg; |
2992
|
|
|
|
|
|
|
|
2993
|
386
|
50
|
|
|
|
747
|
if (defined $v) { |
2994
|
386
|
|
|
|
|
792
|
$v = $self->map_stmt($arg, $cb, @params); |
2995
|
|
|
|
|
|
|
} |
2996
|
386
|
50
|
33
|
|
|
1531
|
if (defined $v && ($v ne $arg)) { |
2997
|
0
|
|
|
|
|
0
|
$s = $self->setstmt(['return', $v]); |
2998
|
|
|
|
|
|
|
} |
2999
|
|
|
|
|
|
|
} elsif ($cmd eq 'goto') { |
3000
|
0
|
|
|
|
|
0
|
my $arg = $self->{strmap}->{$s}->[1]; |
3001
|
0
|
|
|
|
|
0
|
my $v = $self->map_stmt($arg, $cb, @params); |
3002
|
|
|
|
|
|
|
|
3003
|
0
|
0
|
|
|
|
0
|
if ($v ne $arg) { |
3004
|
0
|
|
|
|
|
0
|
$s = $self->setstmt(['goto', $v]); |
3005
|
|
|
|
|
|
|
} |
3006
|
|
|
|
|
|
|
} elsif ($cmd eq 'label') { |
3007
|
0
|
|
|
|
|
0
|
my $arg = $self->{strmap}->{$s}->[1]; |
3008
|
0
|
|
|
|
|
0
|
my $v = $self->map_stmt($arg, $cb, @params); |
3009
|
|
|
|
|
|
|
|
3010
|
0
|
0
|
|
|
|
0
|
if ($v ne $arg) { |
3011
|
0
|
|
|
|
|
0
|
$s = $self->setstmt(['label', $v]); |
3012
|
|
|
|
|
|
|
} |
3013
|
|
|
|
|
|
|
} elsif ($cmd eq 'throw') { |
3014
|
0
|
|
|
|
|
0
|
my $arg = $self->{strmap}->{$s}->[1]; |
3015
|
0
|
|
|
|
|
0
|
my $v = $self->map_stmt($arg, $cb, @params); |
3016
|
|
|
|
|
|
|
|
3017
|
0
|
0
|
|
|
|
0
|
if ($v ne $arg) { |
3018
|
0
|
|
|
|
|
0
|
$s = $self->setstmt(['throw', $v]); |
3019
|
|
|
|
|
|
|
} |
3020
|
|
|
|
|
|
|
} elsif ($cmd eq 'if') { |
3021
|
15
|
|
|
|
|
32
|
my ($cond, $then, $else) = @{$self->{strmap}->{$s}}[1..3]; |
|
15
|
|
|
|
|
63
|
|
3022
|
15
|
|
|
|
|
47
|
my $cond1 = $self->map_stmt($cond, $cb, @params); |
3023
|
15
|
|
|
|
|
54
|
my $then1 = $self->map_stmt($then, $cb, @params); |
3024
|
15
|
|
|
|
|
38
|
my $else1 = $else; |
3025
|
|
|
|
|
|
|
|
3026
|
15
|
50
|
|
|
|
41
|
if (defined $else) { |
3027
|
0
|
|
|
|
|
0
|
$else1 = $self->map_stmt($else, $cb, @params); |
3028
|
|
|
|
|
|
|
} |
3029
|
15
|
100
|
66
|
|
|
96
|
if (($cond ne $cond1) || ($then ne $then1) || (defined $else && ($else ne $else1))) { |
|
|
|
33
|
|
|
|
|
|
|
|
66
|
|
|
|
|
3030
|
2
|
50
|
33
|
|
|
6
|
if ($self->is_empty_block($then1) && (!defined $else || $self->is_empty_block($else1))) { |
|
|
|
33
|
|
|
|
|
3031
|
2
|
|
|
|
|
6
|
$s = $cond1; |
3032
|
|
|
|
|
|
|
} else { |
3033
|
0
|
|
|
|
|
0
|
$s = $self->setstmt(['if', $cond1, $then1, $else1]); |
3034
|
|
|
|
|
|
|
} |
3035
|
|
|
|
|
|
|
} |
3036
|
|
|
|
|
|
|
} elsif ($cmd eq 'while') { |
3037
|
0
|
|
|
|
|
0
|
my ($cond, $block) = @{$self->{strmap}->{$s}}[1..2]; |
|
0
|
|
|
|
|
0
|
|
3038
|
0
|
|
|
|
|
0
|
my $cond1 = $self->map_stmt($cond, $cb, @params); |
3039
|
0
|
|
|
|
|
0
|
my $block1 = $self->map_stmt($block, $cb, @params); |
3040
|
|
|
|
|
|
|
|
3041
|
0
|
0
|
0
|
|
|
0
|
if (($cond ne $cond1) || ($block ne $block1)) { |
3042
|
0
|
|
|
|
|
0
|
$s = $self->setstmt(['while', $cond1, $block1]); |
3043
|
|
|
|
|
|
|
} |
3044
|
|
|
|
|
|
|
} elsif ($cmd eq 'do') { |
3045
|
0
|
|
|
|
|
0
|
my ($cond, $block) = @{$self->{strmap}->{$s}}[1..2]; |
|
0
|
|
|
|
|
0
|
|
3046
|
0
|
|
|
|
|
0
|
my $cond1 = $self->map_stmt($cond, $cb, @params); |
3047
|
0
|
|
|
|
|
0
|
my $block1 = $self->map_stmt($block, $cb, @params); |
3048
|
|
|
|
|
|
|
|
3049
|
0
|
0
|
0
|
|
|
0
|
if (($cond ne $cond1) || ($block ne $block1)) { |
3050
|
0
|
|
|
|
|
0
|
$s = $self->setstmt(['do', $cond1, $block1]); |
3051
|
|
|
|
|
|
|
} |
3052
|
|
|
|
|
|
|
} elsif ($cmd eq 'for') { |
3053
|
0
|
|
|
|
|
0
|
my ($pre, $cond, $post, $block) = @{$self->{strmap}->{$s}}[1..4]; |
|
0
|
|
|
|
|
0
|
|
3054
|
0
|
|
|
|
|
0
|
my $pre1 = $self->map_stmt($pre, $cb, @params); |
3055
|
0
|
|
|
|
|
0
|
my $cond1 = $self->map_stmt($cond, $cb, @params); |
3056
|
0
|
|
|
|
|
0
|
my $post1 = $self->map_stmt($post, $cb, @params); |
3057
|
0
|
|
|
|
|
0
|
my $block1 = $self->map_stmt($block, $cb, @params); |
3058
|
|
|
|
|
|
|
|
3059
|
0
|
0
|
0
|
|
|
0
|
if (($pre ne $pre1) || ($cond ne $cond1) || ($post ne $post1) || ($block ne $block1)) { |
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
3060
|
0
|
|
|
|
|
0
|
$s = $self->setstmt(['for', $pre1, $cond1, $post1, $block1]); |
3061
|
|
|
|
|
|
|
} |
3062
|
|
|
|
|
|
|
} elsif ($cmd eq 'foreach') { |
3063
|
4
|
|
|
|
|
8
|
my ($expr, $key, $value, $block) = @{$self->{strmap}->{$s}}[1..4]; |
|
4
|
|
|
|
|
15
|
|
3064
|
4
|
|
|
|
|
11
|
my $expr1 = $self->map_stmt($expr, $cb, @params); |
3065
|
4
|
|
|
|
|
7
|
my $key1 = $key; |
3066
|
|
|
|
|
|
|
|
3067
|
4
|
50
|
|
|
|
10
|
if (defined $key) { |
3068
|
4
|
|
|
|
|
10
|
$key1 = $self->map_stmt($key, $cb, @params); |
3069
|
|
|
|
|
|
|
} |
3070
|
4
|
|
|
|
|
13
|
my $value1 = $self->map_stmt($value, $cb, @params); |
3071
|
4
|
|
|
|
|
24
|
my $block1 = $self->map_stmt($block, $cb, @params); |
3072
|
|
|
|
|
|
|
|
3073
|
4
|
100
|
33
|
|
|
51
|
if (($expr ne $expr1) || (defined $key && ($key ne $key1)) || ($value ne $value1) || ($block ne $block1)) { |
|
|
|
33
|
|
|
|
|
|
|
|
33
|
|
|
|
|
|
|
|
66
|
|
|
|
|
3074
|
1
|
|
|
|
|
13
|
$s = $self->setstmt(['foreach', $expr1, $key1, $value1, $block1]); |
3075
|
|
|
|
|
|
|
} |
3076
|
|
|
|
|
|
|
} elsif ($cmd eq 'switch') { |
3077
|
0
|
|
|
|
|
0
|
my ($expr, $cases) = @{$self->{strmap}->{$s}}[1..2]; |
|
0
|
|
|
|
|
0
|
|
3078
|
0
|
|
|
|
|
0
|
my $expr1 = $self->map_stmt($expr, $cb, @params); |
3079
|
0
|
|
|
|
|
0
|
my @cnew = (); |
3080
|
0
|
|
|
|
|
0
|
my $changed = 0; |
3081
|
|
|
|
|
|
|
|
3082
|
0
|
|
|
|
|
0
|
foreach my $e (@$cases) { |
3083
|
0
|
|
|
|
|
0
|
my $c = $e->[0]; |
3084
|
0
|
|
|
|
|
0
|
my $b = $e->[1]; |
3085
|
0
|
|
|
|
|
0
|
my $c1 = $c; |
3086
|
|
|
|
|
|
|
|
3087
|
0
|
0
|
|
|
|
0
|
if (defined $c) { |
3088
|
0
|
|
|
|
|
0
|
$c1 = $self->map_stmt($c, $cb, @params); |
3089
|
|
|
|
|
|
|
} |
3090
|
0
|
|
|
|
|
0
|
my $b1 = $self->map_stmt($b, $cb, @params); |
3091
|
|
|
|
|
|
|
|
3092
|
0
|
0
|
0
|
|
|
0
|
if ((defined $c1 && ($c ne $c1)) || ($b ne $b1)) { |
|
|
|
0
|
|
|
|
|
3093
|
0
|
|
|
|
|
0
|
$changed = 1; |
3094
|
|
|
|
|
|
|
} |
3095
|
0
|
|
|
|
|
0
|
push (@cnew, [$c1, $b1]); |
3096
|
|
|
|
|
|
|
} |
3097
|
0
|
0
|
0
|
|
|
0
|
if (($expr ne $expr1) || $changed) { |
3098
|
0
|
|
|
|
|
0
|
$s = $self->setstmt(['switch', $expr1, \@cnew]); |
3099
|
|
|
|
|
|
|
} |
3100
|
|
|
|
|
|
|
} elsif ($cmd eq 'case') { |
3101
|
0
|
|
|
|
|
0
|
my $expr = $self->{strmap}->{$s}->[1]; |
3102
|
0
|
|
|
|
|
0
|
my $expr1 = $expr; |
3103
|
|
|
|
|
|
|
|
3104
|
0
|
0
|
|
|
|
0
|
if (!defined $expr) { |
3105
|
0
|
|
|
|
|
0
|
$expr1 = $self->map_stmt($expr, $cb, @params); |
3106
|
|
|
|
|
|
|
} |
3107
|
0
|
0
|
0
|
|
|
0
|
if (defined $expr && ($expr ne $expr1)) { |
3108
|
0
|
|
|
|
|
0
|
$s = $self->setstmt(['case', $expr1]); |
3109
|
|
|
|
|
|
|
} |
3110
|
|
|
|
|
|
|
} elsif ($cmd eq 'try') { |
3111
|
0
|
|
|
|
|
0
|
my ($try, $catches, $finally) = @{$self->{strmap}->{$s}}[1..3]; |
|
0
|
|
|
|
|
0
|
|
3112
|
0
|
|
|
|
|
0
|
my $try1 = $self->map_stmt($try, $cb, @params); |
3113
|
0
|
|
|
|
|
0
|
my $finally1 = $finally; |
3114
|
0
|
|
|
|
|
0
|
my @cnew = (); |
3115
|
0
|
|
|
|
|
0
|
my $changed = 0; |
3116
|
|
|
|
|
|
|
|
3117
|
0
|
|
|
|
|
0
|
foreach my $c (@$catches) { |
3118
|
0
|
|
|
|
|
0
|
my $e = $c->[0]; |
3119
|
0
|
|
|
|
|
0
|
my $b = $c->[1]; |
3120
|
|
|
|
|
|
|
|
3121
|
0
|
|
|
|
|
0
|
my $e1 = $self->map_stmt($e, $cb, @params); |
3122
|
0
|
|
|
|
|
0
|
my $b1 = $self->map_stmt($b, $cb, @params); |
3123
|
|
|
|
|
|
|
|
3124
|
0
|
0
|
0
|
|
|
0
|
if ((defined $e1 && ($e ne $e1)) || ($b ne $b1)) { |
|
|
|
0
|
|
|
|
|
3125
|
0
|
|
|
|
|
0
|
$changed = 1; |
3126
|
|
|
|
|
|
|
} |
3127
|
0
|
|
|
|
|
0
|
push (@cnew, [$e1, $b1]); |
3128
|
|
|
|
|
|
|
} |
3129
|
0
|
0
|
|
|
|
0
|
if (defined $finally) { |
3130
|
0
|
|
|
|
|
0
|
$finally1 = $self->map_stmt($finally, $cb, @params); |
3131
|
|
|
|
|
|
|
} |
3132
|
0
|
0
|
0
|
|
|
0
|
if (($try ne $try1) || $changed || (defined $finally && ($finally ne $finally1))) { |
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
3133
|
0
|
|
|
|
|
0
|
$s = $self->setstmt(['try', $try1, \@cnew, $finally1]); |
3134
|
|
|
|
|
|
|
} |
3135
|
|
|
|
|
|
|
} |
3136
|
|
|
|
|
|
|
} elsif (is_variable($s)) { |
3137
|
|
|
|
|
|
|
# keep |
3138
|
|
|
|
|
|
|
} |
3139
|
2830
|
100
|
|
|
|
5175
|
if ($s ne $s0) { |
3140
|
98
|
50
|
|
|
|
247
|
$self->{debug}->('map', "map %s -> %s", $s0, $s) if $self->{debug}; |
3141
|
|
|
|
|
|
|
} |
3142
|
2830
|
|
|
|
|
5755
|
return $s; |
3143
|
|
|
|
|
|
|
} |
3144
|
|
|
|
|
|
|
|
3145
|
|
|
|
|
|
|
sub escape_str { |
3146
|
1173
|
|
|
1173
|
0
|
1953
|
my ($s, $fmt) = @_; |
3147
|
|
|
|
|
|
|
|
3148
|
|
|
|
|
|
|
# escape string (keep newlines as newline like php does) |
3149
|
|
|
|
|
|
|
# http://php.net/manual/de/language.types.string.php |
3150
|
|
|
|
|
|
|
# - php single quoted strings suppport backslash escapes |
3151
|
|
|
|
|
|
|
# for literal backslash & single quote. |
3152
|
|
|
|
|
|
|
# - use single quotes to avoid string interpolation on |
3153
|
|
|
|
|
|
|
# re-evaluation. |
3154
|
|
|
|
|
|
|
# |
3155
|
1173
|
|
|
|
|
2545
|
$s =~ s/\\/\\\\/sg; |
3156
|
1173
|
|
|
|
|
1739
|
$s =~ s/'/\\'/sg; |
3157
|
|
|
|
|
|
|
|
3158
|
1173
|
50
|
|
|
|
2069
|
if (exists $fmt->{escape_ctrl}) { |
3159
|
|
|
|
|
|
|
# convert controls other than \t\r\n to "\xNN" |
3160
|
0
|
|
|
|
|
0
|
$s = escape_ctrl($s, "\x00-\x08\x0b\x0c\x0e-\x1f\x7f"); |
3161
|
|
|
|
|
|
|
} else { |
3162
|
1173
|
|
|
|
|
2439
|
$s = "'" . $s . "'"; |
3163
|
|
|
|
|
|
|
} |
3164
|
1173
|
|
|
|
|
2561
|
return $s; |
3165
|
|
|
|
|
|
|
} |
3166
|
|
|
|
|
|
|
|
3167
|
|
|
|
|
|
|
sub expand_stmt { |
3168
|
8423
|
|
|
8423
|
0
|
14156
|
my ($self, $out, $s, $fmt) = @_; |
3169
|
|
|
|
|
|
|
|
3170
|
|
|
|
|
|
|
#$self->{log}->('EXPAND', "$s") if $self->{log}; |
3171
|
|
|
|
|
|
|
|
3172
|
8423
|
50
|
|
|
|
58887
|
if (!defined $s) { |
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
3173
|
0
|
|
|
|
|
0
|
$self->{warn}->('expand', "undefined symbol"); |
3174
|
0
|
|
|
|
|
0
|
push(@$out, ''); |
3175
|
|
|
|
|
|
|
} elsif ($s =~ /^#null$/) { |
3176
|
30
|
|
|
|
|
120
|
push(@$out, 'null'); |
3177
|
|
|
|
|
|
|
} elsif ($s =~ /^#num\d+$/) { |
3178
|
570
|
50
|
|
|
|
1503
|
if (exists $self->{strmap}->{$s}) { |
3179
|
570
|
50
|
|
|
|
1233
|
unless (exists $fmt->{unified}) { |
3180
|
570
|
|
|
|
|
1108
|
$s = $self->{strmap}->{$s}; |
3181
|
|
|
|
|
|
|
} |
3182
|
|
|
|
|
|
|
} |
3183
|
570
|
|
|
|
|
1106
|
push(@$out, $s); |
3184
|
|
|
|
|
|
|
} elsif ($s =~ /^#const\d+$/) { |
3185
|
23
|
50
|
|
|
|
91
|
if (exists $self->{strmap}->{$s}) { |
3186
|
23
|
50
|
|
|
|
60
|
unless (exists $fmt->{unified}) { |
3187
|
23
|
|
|
|
|
54
|
$s = $self->{strmap}->{$s}; |
3188
|
|
|
|
|
|
|
} |
3189
|
|
|
|
|
|
|
} |
3190
|
23
|
|
|
|
|
55
|
push(@$out, $s); |
3191
|
|
|
|
|
|
|
} elsif ($s =~ /^#str\d+$/) { |
3192
|
1172
|
50
|
|
|
|
2613
|
if (exists $self->{strmap}->{$s}) { |
3193
|
1172
|
50
|
|
|
|
2141
|
unless (exists $fmt->{unified}) { |
3194
|
1172
|
|
|
|
|
2261
|
$s = $self->{strmap}->{$s}; |
3195
|
1172
|
50
|
|
|
|
2042
|
if (exists $fmt->{mask_eval}) { |
3196
|
|
|
|
|
|
|
# substitute 'eval' in strings on output |
3197
|
0
|
|
|
|
|
0
|
$s =~ s/(^|\W)eval(\s*\()/$1$fmt->{mask_eval}$2/g; |
3198
|
|
|
|
|
|
|
} |
3199
|
1172
|
50
|
33
|
|
|
2500
|
if (exists $fmt->{max_strlen} && (length($s) > $fmt->{max_strlen})) { |
3200
|
0
|
|
|
|
|
0
|
$s = substr($s, 0, $fmt->{max_strlen}-2).'..'; |
3201
|
|
|
|
|
|
|
} |
3202
|
1172
|
|
|
|
|
2336
|
$s = escape_str($s, $fmt); |
3203
|
|
|
|
|
|
|
} |
3204
|
|
|
|
|
|
|
} |
3205
|
1172
|
|
|
|
|
2240
|
push(@$out, $s); |
3206
|
|
|
|
|
|
|
} elsif ($s =~ /^#arr\d+$/) { |
3207
|
186
|
|
|
|
|
469
|
my $arr = $self->{strmap}{$s}; |
3208
|
186
|
|
|
|
|
584
|
my $keys = $arr->get_keys(); |
3209
|
186
|
|
|
|
|
425
|
push(@$out, 'array'); |
3210
|
186
|
|
|
|
|
305
|
push(@$out, '('); |
3211
|
|
|
|
|
|
|
|
3212
|
186
|
|
|
|
|
395
|
foreach my $k (@$keys) { |
3213
|
278
|
|
|
|
|
644
|
my $val = $arr->val($k); |
3214
|
278
|
|
|
|
|
1240
|
$self->expand_stmt($out, $k, $fmt); |
3215
|
278
|
|
|
|
|
493
|
push(@$out, '=>'); |
3216
|
278
|
50
|
|
|
|
561
|
if (defined $val) { |
3217
|
278
|
|
|
|
|
515
|
$self->expand_stmt($out, $val, $fmt); |
3218
|
|
|
|
|
|
|
} |
3219
|
278
|
|
|
|
|
630
|
push(@$out, ','); |
3220
|
|
|
|
|
|
|
} |
3221
|
186
|
100
|
|
|
|
464
|
if (scalar @$keys > 0) { |
3222
|
162
|
|
|
|
|
249
|
pop(@$out); |
3223
|
|
|
|
|
|
|
} |
3224
|
186
|
|
|
|
|
376
|
push(@$out, ')'); |
3225
|
|
|
|
|
|
|
} elsif ($s =~ /^#fun\d+$/) { |
3226
|
239
|
|
|
|
|
416
|
my ($f, $a, $b, $p) = @{$self->{strmap}->{$s}}; |
|
239
|
|
|
|
|
776
|
|
3227
|
|
|
|
|
|
|
|
3228
|
239
|
|
|
|
|
754
|
foreach my $k (sort grep { exists $php_modifiers{$_} } keys %$p) { |
|
25
|
|
|
|
|
101
|
|
3229
|
25
|
|
|
|
|
53
|
push(@$out, $k); |
3230
|
|
|
|
|
|
|
} |
3231
|
239
|
|
|
|
|
473
|
push(@$out, 'function'); |
3232
|
239
|
100
|
|
|
|
518
|
if (defined $f) { |
3233
|
213
|
|
|
|
|
412
|
push(@$out, $f); |
3234
|
|
|
|
|
|
|
} |
3235
|
239
|
|
|
|
|
383
|
push(@$out, '('); |
3236
|
239
|
|
|
|
|
543
|
foreach my $k (@$a) { |
3237
|
|
|
|
|
|
|
#push(@$out, $k); |
3238
|
104
|
|
|
|
|
328
|
$self->expand_stmt($out, $k, $fmt); |
3239
|
104
|
|
|
|
|
226
|
push(@$out, ','); |
3240
|
|
|
|
|
|
|
} |
3241
|
239
|
100
|
|
|
|
628
|
if (scalar @$a > 0) { |
3242
|
100
|
|
|
|
|
167
|
pop(@$out); |
3243
|
|
|
|
|
|
|
} |
3244
|
239
|
|
|
|
|
405
|
push(@$out, ')'); |
3245
|
239
|
|
|
|
|
649
|
$self->expand_stmt($out, $b, $fmt); |
3246
|
|
|
|
|
|
|
#push(@$out, '{'); |
3247
|
|
|
|
|
|
|
#foreach my $k (@$b) { |
3248
|
|
|
|
|
|
|
# $self->expand_stmt($out, $k, $fmt); |
3249
|
|
|
|
|
|
|
# push(@$out, ';'); |
3250
|
|
|
|
|
|
|
#} |
3251
|
|
|
|
|
|
|
#if (scalar @$b > 0) { |
3252
|
|
|
|
|
|
|
# pop(@$out); |
3253
|
|
|
|
|
|
|
#} |
3254
|
|
|
|
|
|
|
#push(@$out, '}'); |
3255
|
|
|
|
|
|
|
} elsif ($s =~ /^#call\d+$/) { |
3256
|
370
|
|
|
|
|
656
|
my ($f, $a) = @{$self->{strmap}->{$s}}; |
|
370
|
|
|
|
|
1043
|
|
3257
|
|
|
|
|
|
|
|
3258
|
370
|
100
|
|
|
|
811
|
if ($f =~ /^#fun\d+$/) { |
3259
|
|
|
|
|
|
|
# anonymous function call requires braces around func |
3260
|
4
|
|
|
|
|
15
|
push(@$out, '('); |
3261
|
4
|
|
|
|
|
12
|
$self->expand_stmt($out, $f, $fmt); |
3262
|
4
|
|
|
|
|
15
|
push(@$out, ')'); |
3263
|
|
|
|
|
|
|
} else { |
3264
|
366
|
|
|
|
|
800
|
$self->expand_stmt($out, $f, $fmt); |
3265
|
|
|
|
|
|
|
} |
3266
|
370
|
|
|
|
|
621
|
push(@$out, '('); |
3267
|
370
|
|
|
|
|
809
|
foreach my $k (@$a) { |
3268
|
198
|
|
|
|
|
537
|
$self->expand_stmt($out, $k, $fmt); |
3269
|
198
|
|
|
|
|
442
|
push(@$out, ','); |
3270
|
|
|
|
|
|
|
} |
3271
|
370
|
100
|
|
|
|
885
|
if (scalar @$a > 0) { |
3272
|
169
|
|
|
|
|
273
|
pop(@$out); |
3273
|
|
|
|
|
|
|
} |
3274
|
370
|
|
|
|
|
645
|
push(@$out, ')'); |
3275
|
|
|
|
|
|
|
} elsif ($s =~ /^#elem\d+$/) { |
3276
|
275
|
|
|
|
|
523
|
my ($v, $i) = @{$self->{strmap}->{$s}}; |
|
275
|
|
|
|
|
782
|
|
3277
|
|
|
|
|
|
|
|
3278
|
275
|
|
|
|
|
982
|
$self->expand_stmt($out, $v, $fmt); |
3279
|
275
|
|
|
|
|
467
|
push(@$out, '['); |
3280
|
275
|
100
|
|
|
|
582
|
if (defined $i) { |
3281
|
254
|
|
|
|
|
530
|
$self->expand_stmt($out, $i, $fmt); |
3282
|
|
|
|
|
|
|
} |
3283
|
275
|
|
|
|
|
510
|
push(@$out, ']'); |
3284
|
|
|
|
|
|
|
} elsif ($s =~ /^#expr\d+$/) { |
3285
|
|
|
|
|
|
|
# if v1 missing: prefix op |
3286
|
|
|
|
|
|
|
# if v2 missing: postfix op |
3287
|
1323
|
|
|
|
|
1983
|
my ($op, $v1, $v2) = @{$self->{strmap}->{$s}}; |
|
1323
|
|
|
|
|
3646
|
|
3288
|
|
|
|
|
|
|
|
3289
|
1323
|
100
|
|
|
|
2600
|
if (defined $v1) { |
3290
|
1272
|
100
|
100
|
|
|
4826
|
if ($v1 =~ /^#expr\d+$/) { |
|
|
100
|
|
|
|
|
|
3291
|
30
|
|
|
|
|
88
|
my ($vop, $vv1, $vv2) = @{$self->{strmap}->{$v1}}; |
|
30
|
|
|
|
|
122
|
|
3292
|
30
|
|
|
|
|
56
|
my $add_brace = 0; |
3293
|
30
|
100
|
100
|
|
|
130
|
if (($op ne '=') && ($op ne $vop)) { |
3294
|
6
|
|
|
|
|
15
|
$add_brace = 1; |
3295
|
|
|
|
|
|
|
} |
3296
|
30
|
0
|
33
|
|
|
91
|
if (exists $op_unary{$vop} && ($vop ne 'new') && (is_variable($vv2) || ($vv2 =~ /^#elem\d+$/) || ($vv2 =~ /^#call\d+$/))) { |
|
|
|
0
|
|
|
|
|
|
|
|
33
|
|
|
|
|
3297
|
0
|
|
|
|
|
0
|
$add_brace = 0; |
3298
|
|
|
|
|
|
|
} |
3299
|
30
|
100
|
|
|
|
68
|
if ($add_brace) { |
3300
|
6
|
|
|
|
|
14
|
push(@$out, '('); |
3301
|
|
|
|
|
|
|
} |
3302
|
30
|
|
|
|
|
86
|
$self->expand_stmt($out, $v1, $fmt); |
3303
|
30
|
100
|
|
|
|
66
|
if ($add_brace) { |
3304
|
6
|
|
|
|
|
15
|
push(@$out, ')'); |
3305
|
|
|
|
|
|
|
} |
3306
|
|
|
|
|
|
|
} elsif (($op eq '=') && ($v1 =~ /^#arr\d+$/)) { |
3307
|
|
|
|
|
|
|
# output lhs array() as list() and allow empty elems |
3308
|
|
|
|
|
|
|
# |
3309
|
6
|
|
|
|
|
24
|
my $arr = $self->{strmap}{$v1}; |
3310
|
6
|
|
|
|
|
29
|
my $keys = $arr->get_keys(); |
3311
|
6
|
|
|
|
|
46
|
my $numerical = $arr->is_numerical(); |
3312
|
6
|
|
|
|
|
14
|
push(@$out, 'list'); |
3313
|
6
|
|
|
|
|
14
|
push(@$out, '('); |
3314
|
|
|
|
|
|
|
|
3315
|
6
|
|
|
|
|
11
|
foreach my $k (@$keys) { |
3316
|
13
|
|
|
|
|
32
|
my $val = $arr->val($k); |
3317
|
13
|
100
|
|
|
|
30
|
if (defined $val) { |
3318
|
12
|
50
|
|
|
|
24
|
unless ($numerical) { |
3319
|
0
|
|
|
|
|
0
|
$self->expand_stmt($out, $k, $fmt); |
3320
|
0
|
|
|
|
|
0
|
push(@$out, '=>'); |
3321
|
|
|
|
|
|
|
} |
3322
|
12
|
|
|
|
|
46
|
$self->expand_stmt($out, $val, $fmt); |
3323
|
|
|
|
|
|
|
} |
3324
|
13
|
|
|
|
|
34
|
push(@$out, ','); |
3325
|
|
|
|
|
|
|
} |
3326
|
6
|
50
|
|
|
|
20
|
if (scalar @$keys > 0) { |
3327
|
6
|
|
|
|
|
10
|
pop(@$out); |
3328
|
|
|
|
|
|
|
} |
3329
|
6
|
|
|
|
|
15
|
push(@$out, ')'); |
3330
|
|
|
|
|
|
|
} else { |
3331
|
1236
|
|
|
|
|
2676
|
$self->expand_stmt($out, $v1, $fmt); |
3332
|
|
|
|
|
|
|
} |
3333
|
|
|
|
|
|
|
} |
3334
|
1323
|
|
|
|
|
2494
|
push(@$out, $op); |
3335
|
1323
|
100
|
|
|
|
2361
|
if (defined $v2) { |
3336
|
1288
|
100
|
|
|
|
2415
|
if ($op eq '$') { |
3337
|
24
|
|
|
|
|
48
|
push(@$out, '{'); |
3338
|
|
|
|
|
|
|
} |
3339
|
1288
|
100
|
|
|
|
2530
|
if ($v2 =~ /^#expr\d+$/) { |
3340
|
96
|
|
|
|
|
194
|
my ($vop, $vv1, $vv2) = @{$self->{strmap}->{$v2}}; |
|
96
|
|
|
|
|
356
|
|
3341
|
96
|
|
|
|
|
178
|
my $add_brace = 0; |
3342
|
96
|
100
|
100
|
|
|
449
|
if (($op ne '?') && ($op ne '=') && ($op ne $vop)) { |
|
|
|
100
|
|
|
|
|
3343
|
8
|
|
|
|
|
14
|
$add_brace = 1; |
3344
|
|
|
|
|
|
|
} |
3345
|
96
|
100
|
66
|
|
|
328
|
if (exists $op_unary{$vop} && (is_variable($vv2) || ($vv2 =~ /^#elem\d+$/) || ($vv2 =~ /^#call\d+$/))) { |
|
|
|
100
|
|
|
|
|
3346
|
8
|
|
|
|
|
21
|
$add_brace = 0; |
3347
|
|
|
|
|
|
|
} |
3348
|
96
|
100
|
|
|
|
193
|
if ($add_brace) { |
3349
|
7
|
|
|
|
|
17
|
push(@$out, '('); |
3350
|
|
|
|
|
|
|
} |
3351
|
96
|
|
|
|
|
252
|
$self->expand_stmt($out, $v2, $fmt); |
3352
|
96
|
100
|
|
|
|
259
|
if ($add_brace) { |
3353
|
7
|
|
|
|
|
25
|
push(@$out, ')'); |
3354
|
|
|
|
|
|
|
} |
3355
|
|
|
|
|
|
|
} else { |
3356
|
1192
|
|
|
|
|
2571
|
$self->expand_stmt($out, $v2, $fmt); |
3357
|
|
|
|
|
|
|
} |
3358
|
1288
|
100
|
|
|
|
2681
|
if ($op eq '$') { |
3359
|
24
|
|
|
|
|
62
|
push(@$out, '}'); |
3360
|
|
|
|
|
|
|
} |
3361
|
|
|
|
|
|
|
} |
3362
|
|
|
|
|
|
|
} elsif ($s =~ /^#pfx\d+$/) { |
3363
|
16
|
|
|
|
|
42
|
my $pfx = $self->{strmap}->{$s}; |
3364
|
16
|
|
|
|
|
61
|
foreach my $k (sort keys %$pfx) { |
3365
|
16
|
|
|
|
|
37
|
push(@$out, $k); |
3366
|
|
|
|
|
|
|
} |
3367
|
|
|
|
|
|
|
} elsif ($s =~ /^#obj\d+$/) { |
3368
|
34
|
|
|
|
|
53
|
my ($o, $m) = @{$self->{strmap}->{$s}}; |
|
34
|
|
|
|
|
158
|
|
3369
|
|
|
|
|
|
|
|
3370
|
34
|
50
|
|
|
|
79
|
if ($o =~ /^#call\d+$/) { |
3371
|
0
|
|
|
|
|
0
|
push(@$out, '('); |
3372
|
0
|
|
|
|
|
0
|
$self->expand_stmt($out, $o, $fmt); |
3373
|
0
|
|
|
|
|
0
|
push(@$out, ')'); |
3374
|
|
|
|
|
|
|
} else { |
3375
|
34
|
|
|
|
|
83
|
$self->expand_stmt($out, $o, $fmt); |
3376
|
|
|
|
|
|
|
} |
3377
|
34
|
|
|
|
|
66
|
push(@$out, '->'); |
3378
|
34
|
50
|
33
|
|
|
131
|
if (exists $self->{strmap}->{$m} && is_strval($m)) { |
3379
|
0
|
|
|
|
|
0
|
my $sym = $self->{strmap}->{$m}; |
3380
|
0
|
0
|
|
|
|
0
|
if (is_symbol($sym)) { |
3381
|
0
|
|
|
|
|
0
|
push(@$out, $sym); |
3382
|
|
|
|
|
|
|
} else { |
3383
|
0
|
|
|
|
|
0
|
$sym = escape_str($sym, $fmt); |
3384
|
|
|
|
|
|
|
|
3385
|
0
|
|
|
|
|
0
|
push(@$out, '{'); |
3386
|
0
|
|
|
|
|
0
|
push(@$out, $sym); |
3387
|
0
|
|
|
|
|
0
|
push(@$out, '}'); |
3388
|
|
|
|
|
|
|
} |
3389
|
|
|
|
|
|
|
} else { |
3390
|
34
|
|
|
|
|
95
|
$self->expand_stmt($out, $m, $fmt); |
3391
|
|
|
|
|
|
|
} |
3392
|
|
|
|
|
|
|
} elsif ($s =~ /^#scope\d+$/) { |
3393
|
4
|
|
|
|
|
17
|
my ($c, $e) = @{$self->{strmap}->{$s}}; |
|
4
|
|
|
|
|
19
|
|
3394
|
|
|
|
|
|
|
|
3395
|
4
|
50
|
33
|
|
|
23
|
if (exists $self->{strmap}->{$c} && is_symbol($self->{strmap}->{$c})) { |
3396
|
0
|
|
|
|
|
0
|
push(@$out, $self->{strmap}->{$c}); |
3397
|
|
|
|
|
|
|
} else { |
3398
|
4
|
|
|
|
|
26
|
$self->expand_stmt($out, $c, $fmt); |
3399
|
|
|
|
|
|
|
} |
3400
|
4
|
|
|
|
|
30
|
push(@$out, '::'); |
3401
|
4
|
50
|
33
|
|
|
32
|
if (exists $self->{strmap}->{$e} && is_symbol($self->{strmap}->{$e})) { |
3402
|
0
|
|
|
|
|
0
|
push(@$out, $self->{strmap}->{$e}); |
3403
|
|
|
|
|
|
|
} else { |
3404
|
4
|
|
|
|
|
17
|
$self->expand_stmt($out, $e, $fmt); |
3405
|
|
|
|
|
|
|
} |
3406
|
|
|
|
|
|
|
} elsif ($s =~ /^#ns\d+$/) { |
3407
|
0
|
|
|
|
|
0
|
my ($n, $e) = @{$self->{strmap}->{$s}}; |
|
0
|
|
|
|
|
0
|
|
3408
|
|
|
|
|
|
|
|
3409
|
0
|
0
|
|
|
|
0
|
if (defined $n) { |
3410
|
0
|
0
|
0
|
|
|
0
|
if (exists $self->{strmap}->{$n} && is_symbol($self->{strmap}->{$n})) { |
3411
|
0
|
|
|
|
|
0
|
push(@$out, $self->{strmap}->{$n}); |
3412
|
|
|
|
|
|
|
} else { |
3413
|
0
|
|
|
|
|
0
|
$self->expand_stmt($out, $n, $fmt); |
3414
|
|
|
|
|
|
|
} |
3415
|
|
|
|
|
|
|
} |
3416
|
0
|
|
|
|
|
0
|
push(@$out, '\\'); |
3417
|
0
|
|
|
|
|
0
|
$self->expand_stmt($out, $e, $fmt); |
3418
|
|
|
|
|
|
|
} elsif ($s =~ /^#inst\d+$/) { |
3419
|
21
|
|
|
|
|
40
|
my ($c, $f, $i) = @{$self->{strmap}->{$s}}; |
|
21
|
|
|
|
|
64
|
|
3420
|
|
|
|
|
|
|
|
3421
|
21
|
|
|
|
|
45
|
push(@$out, 'new'); |
3422
|
21
|
|
|
|
|
50
|
$self->expand_stmt($out, $f, $fmt); |
3423
|
|
|
|
|
|
|
} elsif ($s =~ /^#ref\d+$/) { |
3424
|
8
|
|
|
|
|
19
|
my ($v) = @{$self->{strmap}->{$s}}; |
|
8
|
|
|
|
|
35
|
|
3425
|
|
|
|
|
|
|
|
3426
|
8
|
|
|
|
|
20
|
push(@$out, '&'); |
3427
|
8
|
|
|
|
|
32
|
$self->expand_stmt($out, $v, $fmt); |
3428
|
|
|
|
|
|
|
} elsif ($s =~ /^#class\d+$/) { |
3429
|
56
|
|
|
|
|
119
|
my ($c, $b, $p) = @{$self->{strmap}->{$s}}; |
|
56
|
|
|
|
|
185
|
|
3430
|
|
|
|
|
|
|
|
3431
|
56
|
|
|
|
|
188
|
foreach my $k (sort grep { exists $php_modifiers{$_} } keys %$p) { |
|
0
|
|
|
|
|
0
|
|
3432
|
0
|
|
|
|
|
0
|
push(@$out, $k); |
3433
|
|
|
|
|
|
|
} |
3434
|
56
|
|
|
|
|
122
|
push(@$out, 'class'); |
3435
|
56
|
|
|
|
|
101
|
push(@$out, $c); |
3436
|
|
|
|
|
|
|
|
3437
|
56
|
50
|
|
|
|
120
|
if (exists $p->{parent}) { |
3438
|
0
|
|
|
|
|
0
|
push(@$out, 'extends'); |
3439
|
0
|
|
|
|
|
0
|
push(@$out, $p->{parent}); |
3440
|
|
|
|
|
|
|
} |
3441
|
56
|
|
|
|
|
129
|
$self->expand_stmt($out, $b, $fmt); |
3442
|
|
|
|
|
|
|
} elsif ($s =~ /^#trait\d+$/) { |
3443
|
1
|
|
|
|
|
3
|
my ($t, $b) = @{$self->{strmap}->{$s}}; |
|
1
|
|
|
|
|
4
|
|
3444
|
|
|
|
|
|
|
|
3445
|
1
|
|
|
|
|
13
|
push(@$out, 'trait'); |
3446
|
1
|
|
|
|
|
7
|
push(@$out, $t); |
3447
|
1
|
|
|
|
|
6
|
$self->expand_stmt($out, $b, $fmt); |
3448
|
|
|
|
|
|
|
} elsif ($s =~ /^#fh\d+$/) { |
3449
|
0
|
|
|
|
|
0
|
my $f = $self->{strmap}->{$s}{name}; |
3450
|
0
|
|
|
|
|
0
|
my $m = $self->{strmap}->{$s}{mode}; |
3451
|
0
|
|
|
|
|
0
|
my $p = $self->{strmap}->{$s}{pos}; |
3452
|
0
|
|
|
|
|
0
|
push(@$out, 'FH'); |
3453
|
0
|
|
|
|
|
0
|
push(@$out, '('); |
3454
|
0
|
|
|
|
|
0
|
push(@$out, $f); |
3455
|
0
|
|
|
|
|
0
|
push(@$out, ','); |
3456
|
0
|
|
|
|
|
0
|
push(@$out, $m); |
3457
|
0
|
|
|
|
|
0
|
push(@$out, ')'); |
3458
|
|
|
|
|
|
|
} elsif ($s =~ /^#blk\d+$/) { |
3459
|
1099
|
|
|
|
|
1737
|
my ($type, $a) = @{$self->{strmap}->{$s}}; |
|
1099
|
|
|
|
|
2675
|
|
3460
|
1099
|
100
|
|
|
|
3110
|
if ($type eq 'expr') { |
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
3461
|
93
|
|
|
|
|
169
|
foreach my $k (@$a) { |
3462
|
86
|
|
|
|
|
213
|
$self->expand_stmt($out, $k, $fmt); |
3463
|
86
|
|
|
|
|
166
|
push(@$out, ','); |
3464
|
|
|
|
|
|
|
} |
3465
|
93
|
100
|
|
|
|
175
|
if (scalar @$a > 0) { |
3466
|
82
|
|
|
|
|
135
|
pop(@$out); |
3467
|
|
|
|
|
|
|
} |
3468
|
|
|
|
|
|
|
} elsif ($type eq 'flat') { |
3469
|
500
|
|
|
|
|
1035
|
foreach my $k (@$a) { |
3470
|
1295
|
|
|
|
|
3257
|
$self->expand_stmt($out, $k, $fmt); |
3471
|
1295
|
50
|
|
|
|
2535
|
if ($k =~ /^#pfx\d+$/) { |
3472
|
0
|
|
|
|
|
0
|
next; # avoid ; |
3473
|
|
|
|
|
|
|
} |
3474
|
1295
|
100
|
100
|
|
|
4167
|
if (($out->[-1] ne '}') && ($out->[-1] ne ':')) { |
3475
|
1040
|
|
|
|
|
2042
|
push(@$out, ';'); |
3476
|
|
|
|
|
|
|
} |
3477
|
|
|
|
|
|
|
} |
3478
|
500
|
100
|
100
|
|
|
2040
|
if ((scalar @$a > 0) && ($out->[-1] eq ';')) { |
3479
|
433
|
50
|
|
|
|
1047
|
pop(@$out) if $fmt->{avoid_semicolon}; |
3480
|
|
|
|
|
|
|
} |
3481
|
|
|
|
|
|
|
} elsif ($type eq 'case') { |
3482
|
8
|
|
|
|
|
31
|
foreach my $k (@$a) { |
3483
|
8
|
|
|
|
|
83
|
$self->expand_stmt($out, $k, $fmt); |
3484
|
8
|
|
|
|
|
30
|
push(@$out, ';'); |
3485
|
|
|
|
|
|
|
} |
3486
|
8
|
50
|
|
|
|
31
|
if (scalar @$a > 0) { |
3487
|
8
|
|
|
|
|
14
|
pop(@$out); |
3488
|
|
|
|
|
|
|
} |
3489
|
|
|
|
|
|
|
} elsif ($type eq 'brace') { |
3490
|
1
|
50
|
|
|
|
6
|
if (scalar @$a == 1) { |
3491
|
1
|
|
|
|
|
5
|
$self->expand_stmt($out, $a->[0], $fmt); |
3492
|
|
|
|
|
|
|
} else { |
3493
|
0
|
|
|
|
|
0
|
push(@$out, '('); |
3494
|
0
|
|
|
|
|
0
|
foreach my $k (@$a) { |
3495
|
0
|
|
|
|
|
0
|
$self->expand_stmt($out, $k, $fmt); |
3496
|
0
|
0
|
|
|
|
0
|
if ($out->[-1] ne ')') { |
3497
|
0
|
|
|
|
|
0
|
push(@$out, ';'); |
3498
|
|
|
|
|
|
|
} |
3499
|
|
|
|
|
|
|
} |
3500
|
0
|
0
|
0
|
|
|
0
|
if ((scalar @$a > 0) && ($out->[-1] eq ';')) { |
3501
|
0
|
|
|
|
|
0
|
pop(@$out); |
3502
|
|
|
|
|
|
|
} |
3503
|
0
|
|
|
|
|
0
|
push(@$out, ')'); |
3504
|
|
|
|
|
|
|
} |
3505
|
|
|
|
|
|
|
} else { |
3506
|
497
|
|
|
|
|
1037
|
push(@$out, '{'); |
3507
|
497
|
|
|
|
|
943
|
foreach my $k (@$a) { |
3508
|
665
|
|
|
|
|
1731
|
$self->expand_stmt($out, $k, $fmt); |
3509
|
665
|
100
|
|
|
|
1444
|
if ($k =~ /^#pfx\d+$/) { |
3510
|
16
|
|
|
|
|
30
|
next; # avoid ; |
3511
|
|
|
|
|
|
|
} |
3512
|
649
|
100
|
66
|
|
|
2348
|
if (($out->[-1] ne '}') && ($out->[-1] ne ':')) { |
3513
|
533
|
|
|
|
|
1027
|
push(@$out, ';'); |
3514
|
|
|
|
|
|
|
} |
3515
|
|
|
|
|
|
|
} |
3516
|
497
|
100
|
100
|
|
|
1535
|
if ((scalar @$a > 0) && ($out->[-1] eq ';')) { |
3517
|
382
|
50
|
|
|
|
742
|
pop(@$out) if $fmt->{avoid_semicolon}; |
3518
|
|
|
|
|
|
|
} |
3519
|
497
|
|
|
|
|
1028
|
push(@$out, '}'); |
3520
|
|
|
|
|
|
|
} |
3521
|
|
|
|
|
|
|
} elsif ($s =~ /^#stmt\d+$/) { |
3522
|
537
|
|
|
|
|
1338
|
my $cmd = $self->{strmap}->{$s}->[0]; |
3523
|
537
|
100
|
|
|
|
3507
|
if ($cmd eq 'echo') { |
|
|
50
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
3524
|
183
|
|
|
|
|
351
|
my $a = $self->{strmap}->{$s}->[1]; |
3525
|
183
|
|
|
|
|
348
|
push(@$out, $cmd); |
3526
|
183
|
|
|
|
|
380
|
foreach my $k (@$a) { |
3527
|
186
|
|
|
|
|
620
|
$self->expand_stmt($out, $k, $fmt); |
3528
|
186
|
|
|
|
|
369
|
push(@$out, ','); |
3529
|
|
|
|
|
|
|
} |
3530
|
183
|
50
|
|
|
|
451
|
if (scalar @$a > 0) { |
3531
|
183
|
|
|
|
|
348
|
pop(@$out); |
3532
|
|
|
|
|
|
|
} |
3533
|
|
|
|
|
|
|
#push(@$out, ';'); |
3534
|
|
|
|
|
|
|
} elsif ($cmd eq 'print') { |
3535
|
0
|
|
|
|
|
0
|
my $arg = $self->{strmap}->{$s}->[1]; |
3536
|
0
|
|
|
|
|
0
|
push(@$out, $cmd); |
3537
|
0
|
|
|
|
|
0
|
$self->expand_stmt($out, $arg, $fmt); |
3538
|
|
|
|
|
|
|
} elsif ($cmd eq 'namespace') { |
3539
|
10
|
|
|
|
|
30
|
my ($arg, $block) = @{$self->{strmap}->{$s}}[1..2]; |
|
10
|
|
|
|
|
28
|
|
3540
|
10
|
|
|
|
|
21
|
push(@$out, $cmd); |
3541
|
10
|
100
|
|
|
|
45
|
if ($arg ne '') { |
3542
|
9
|
|
|
|
|
18
|
push(@$out, $arg); |
3543
|
|
|
|
|
|
|
} |
3544
|
10
|
100
|
|
|
|
36
|
if (defined $block) { |
3545
|
2
|
|
|
|
|
8
|
$self->expand_stmt($out, $block, $fmt); |
3546
|
|
|
|
|
|
|
} |
3547
|
|
|
|
|
|
|
} elsif ($cmd =~ /^(include|include_once|require|require_once)$/) { |
3548
|
0
|
|
|
|
|
0
|
my $arg = $self->{strmap}->{$s}->[1]; |
3549
|
0
|
|
|
|
|
0
|
push(@$out, $cmd); |
3550
|
0
|
|
|
|
|
0
|
$self->expand_stmt($out, $arg, $fmt); |
3551
|
|
|
|
|
|
|
} elsif ($cmd eq 'use') { |
3552
|
0
|
|
|
|
|
0
|
my $a = $self->{strmap}->{$s}->[1]; |
3553
|
0
|
|
|
|
|
0
|
push(@$out, $cmd); |
3554
|
0
|
|
|
|
|
0
|
foreach my $k (@$a) { |
3555
|
0
|
|
|
|
|
0
|
$self->expand_stmt($out, $k, $fmt); |
3556
|
0
|
|
|
|
|
0
|
push(@$out, ','); |
3557
|
|
|
|
|
|
|
} |
3558
|
0
|
0
|
|
|
|
0
|
if (scalar @$a > 0) { |
3559
|
0
|
|
|
|
|
0
|
pop(@$out); |
3560
|
|
|
|
|
|
|
} |
3561
|
|
|
|
|
|
|
} elsif ($cmd eq 'global') { |
3562
|
6
|
|
|
|
|
23
|
my $a = $self->{strmap}->{$s}->[1]; |
3563
|
6
|
|
|
|
|
13
|
push(@$out, $cmd); |
3564
|
6
|
|
|
|
|
14
|
foreach my $k (@$a) { |
3565
|
6
|
|
|
|
|
19
|
$self->expand_stmt($out, $k, $fmt); |
3566
|
6
|
|
|
|
|
14
|
push(@$out, ','); |
3567
|
|
|
|
|
|
|
} |
3568
|
6
|
50
|
|
|
|
28
|
if (scalar @$a > 0) { |
3569
|
6
|
|
|
|
|
26
|
pop(@$out); |
3570
|
|
|
|
|
|
|
} |
3571
|
|
|
|
|
|
|
} elsif ($cmd eq 'static') { |
3572
|
11
|
|
|
|
|
29
|
my ($a, $p) = @{$self->{strmap}->{$s}}[1..2]; |
|
11
|
|
|
|
|
31
|
|
3573
|
|
|
|
|
|
|
|
3574
|
|
|
|
|
|
|
#push(@$out, join(' ', sort keys %$p)); |
3575
|
11
|
|
|
|
|
50
|
push(@$out, join(' ', (grep { $_ ne $cmd } sort keys %$p), $cmd)); |
|
11
|
|
|
|
|
46
|
|
3576
|
|
|
|
|
|
|
#push(@$out, $cmd); |
3577
|
11
|
|
|
|
|
33
|
foreach my $k (@$a) { |
3578
|
11
|
|
|
|
|
42
|
$self->expand_stmt($out, $k, $fmt); |
3579
|
11
|
|
|
|
|
33
|
push(@$out, ','); |
3580
|
|
|
|
|
|
|
} |
3581
|
11
|
50
|
|
|
|
35
|
if (scalar @$a > 0) { |
3582
|
11
|
|
|
|
|
22
|
pop(@$out); |
3583
|
|
|
|
|
|
|
} |
3584
|
|
|
|
|
|
|
} elsif ($cmd eq 'const') { |
3585
|
9
|
|
|
|
|
34
|
my ($a, $p) = @{$self->{strmap}->{$s}}[1..2]; |
|
9
|
|
|
|
|
33
|
|
3586
|
|
|
|
|
|
|
|
3587
|
|
|
|
|
|
|
#push(@$out, join(' ', sort keys %$p)); |
3588
|
9
|
|
|
|
|
46
|
push(@$out, join(' ', (grep { $_ ne $cmd } sort keys %$p), $cmd)); |
|
10
|
|
|
|
|
41
|
|
3589
|
|
|
|
|
|
|
#push(@$out, $cmd); |
3590
|
9
|
|
|
|
|
25
|
foreach my $k (@$a) { |
3591
|
9
|
|
|
|
|
30
|
$self->expand_stmt($out, $k, $fmt); |
3592
|
9
|
|
|
|
|
46
|
push(@$out, ','); |
3593
|
|
|
|
|
|
|
} |
3594
|
9
|
50
|
|
|
|
53
|
if (scalar @$a > 0) { |
3595
|
9
|
|
|
|
|
18
|
pop(@$out); |
3596
|
|
|
|
|
|
|
} |
3597
|
|
|
|
|
|
|
} elsif ($cmd eq 'unset') { |
3598
|
5
|
|
|
|
|
12
|
my $a = $self->{strmap}->{$s}->[1]; |
3599
|
5
|
|
|
|
|
10
|
push(@$out, $cmd); |
3600
|
5
|
|
|
|
|
11
|
push(@$out, '('); |
3601
|
5
|
|
|
|
|
12
|
foreach my $k (@$a) { |
3602
|
5
|
|
|
|
|
17
|
$self->expand_stmt($out, $k, $fmt); |
3603
|
5
|
|
|
|
|
12
|
push(@$out, ','); |
3604
|
|
|
|
|
|
|
} |
3605
|
5
|
50
|
|
|
|
31
|
if (scalar @$a > 0) { |
3606
|
5
|
|
|
|
|
8
|
pop(@$out); |
3607
|
|
|
|
|
|
|
} |
3608
|
5
|
|
|
|
|
12
|
push(@$out, ')'); |
3609
|
|
|
|
|
|
|
} elsif ($cmd eq 'return') { |
3610
|
116
|
|
|
|
|
256
|
my $a = $self->{strmap}->{$s}->[1]; |
3611
|
116
|
|
|
|
|
194
|
push(@$out, $cmd); |
3612
|
116
|
|
|
|
|
268
|
$self->expand_stmt($out, $a, $fmt); |
3613
|
|
|
|
|
|
|
} elsif ($cmd eq 'goto') { |
3614
|
1
|
|
|
|
|
14
|
my $a = $self->{strmap}->{$s}->[1]; |
3615
|
1
|
|
|
|
|
7
|
push(@$out, $cmd); |
3616
|
1
|
|
|
|
|
6
|
$self->expand_stmt($out, $a, $fmt); |
3617
|
|
|
|
|
|
|
} elsif ($cmd eq 'label') { |
3618
|
1
|
|
|
|
|
3
|
my $a = $self->{strmap}->{$s}->[1]; |
3619
|
1
|
|
|
|
|
4
|
$self->expand_stmt($out, $a, $fmt); |
3620
|
1
|
|
|
|
|
8
|
push(@$out, ':'); |
3621
|
|
|
|
|
|
|
} elsif ($cmd eq 'throw') { |
3622
|
0
|
|
|
|
|
0
|
my $arg = $self->{strmap}->{$s}->[1]; |
3623
|
0
|
|
|
|
|
0
|
push(@$out, $cmd); |
3624
|
0
|
|
|
|
|
0
|
$self->expand_stmt($out, $arg, $fmt); |
3625
|
|
|
|
|
|
|
} elsif ($cmd eq 'if') { |
3626
|
103
|
|
|
|
|
227
|
my ($cond, $then, $else) = @{$self->{strmap}->{$s}}[1..3]; |
|
103
|
|
|
|
|
357
|
|
3627
|
|
|
|
|
|
|
|
3628
|
103
|
|
|
|
|
192
|
push(@$out, $cmd); |
3629
|
103
|
|
|
|
|
170
|
push(@$out, '('); |
3630
|
103
|
|
|
|
|
270
|
$self->expand_stmt($out, $cond, $fmt); |
3631
|
103
|
|
|
|
|
182
|
push(@$out, ')'); |
3632
|
103
|
|
|
|
|
296
|
$self->expand_stmt($out, $then, $fmt); |
3633
|
103
|
100
|
|
|
|
268
|
if (defined $else) { |
3634
|
14
|
|
|
|
|
37
|
push(@$out, 'else'); |
3635
|
|
|
|
|
|
|
|
3636
|
|
|
|
|
|
|
# remove block around 'if else' |
3637
|
|
|
|
|
|
|
# |
3638
|
14
|
50
|
|
|
|
45
|
my $stmts = is_block($else) ? $self->{strmap}->{$else}->[1] : []; |
3639
|
14
|
100
|
100
|
|
|
145
|
if ((@$stmts == 1) && ($stmts->[0] =~ /#stmt\d+$/) && ($self->{strmap}->{$stmts->[0]}->[0] eq 'if')) { |
|
|
|
100
|
|
|
|
|
3640
|
5
|
|
|
|
|
18
|
$self->expand_stmt($out, $stmts->[0], $fmt); |
3641
|
|
|
|
|
|
|
} else { |
3642
|
9
|
|
|
|
|
31
|
$self->expand_stmt($out, $else, $fmt); |
3643
|
|
|
|
|
|
|
} |
3644
|
|
|
|
|
|
|
} |
3645
|
|
|
|
|
|
|
} elsif ($cmd eq 'while') { |
3646
|
16
|
|
|
|
|
24
|
my ($cond, $block) = @{$self->{strmap}->{$s}}[1..2]; |
|
16
|
|
|
|
|
42
|
|
3647
|
|
|
|
|
|
|
|
3648
|
16
|
|
|
|
|
31
|
push(@$out, $cmd); |
3649
|
16
|
|
|
|
|
26
|
push(@$out, '('); |
3650
|
16
|
|
|
|
|
39
|
$self->expand_stmt($out, $cond, $fmt); |
3651
|
16
|
|
|
|
|
30
|
push(@$out, ')'); |
3652
|
16
|
|
|
|
|
35
|
$self->expand_stmt($out, $block, $fmt); |
3653
|
|
|
|
|
|
|
} elsif ($cmd eq 'do') { |
3654
|
8
|
|
|
|
|
30
|
my ($cond, $block) = @{$self->{strmap}->{$s}}[1..2]; |
|
8
|
|
|
|
|
32
|
|
3655
|
|
|
|
|
|
|
|
3656
|
8
|
|
|
|
|
19
|
push(@$out, $cmd); |
3657
|
8
|
|
|
|
|
28
|
$self->expand_stmt($out, $block, $fmt); |
3658
|
8
|
|
|
|
|
32
|
push(@$out, 'while'); |
3659
|
8
|
|
|
|
|
15
|
push(@$out, '('); |
3660
|
8
|
|
|
|
|
26
|
$self->expand_stmt($out, $cond, $fmt); |
3661
|
8
|
|
|
|
|
19
|
push(@$out, ')'); |
3662
|
|
|
|
|
|
|
} elsif ($cmd eq 'for') { |
3663
|
31
|
|
|
|
|
54
|
my ($pre, $cond, $post, $block) = @{$self->{strmap}->{$s}}[1..4]; |
|
31
|
|
|
|
|
99
|
|
3664
|
|
|
|
|
|
|
|
3665
|
31
|
|
|
|
|
68
|
push(@$out, $cmd); |
3666
|
31
|
|
|
|
|
48
|
push(@$out, '('); |
3667
|
31
|
|
|
|
|
87
|
$self->expand_stmt($out, $pre, $fmt); |
3668
|
31
|
|
|
|
|
55
|
push(@$out, ';'); |
3669
|
31
|
|
|
|
|
78
|
$self->expand_stmt($out, $cond, $fmt); |
3670
|
31
|
|
|
|
|
56
|
push(@$out, ';'); |
3671
|
31
|
|
|
|
|
89
|
$self->expand_stmt($out, $post, $fmt); |
3672
|
31
|
|
|
|
|
84
|
push(@$out, ')'); |
3673
|
31
|
|
|
|
|
72
|
$self->expand_stmt($out, $block, $fmt); |
3674
|
|
|
|
|
|
|
} elsif ($cmd eq 'foreach') { |
3675
|
29
|
|
|
|
|
53
|
my ($expr, $key, $value, $block) = @{$self->{strmap}->{$s}}[1..4]; |
|
29
|
|
|
|
|
132
|
|
3676
|
|
|
|
|
|
|
|
3677
|
29
|
|
|
|
|
55
|
push(@$out, $cmd); |
3678
|
29
|
|
|
|
|
52
|
push(@$out, '('); |
3679
|
29
|
|
|
|
|
109
|
$self->expand_stmt($out, $expr, $fmt); |
3680
|
29
|
|
|
|
|
61
|
push(@$out, 'as'); |
3681
|
29
|
100
|
|
|
|
71
|
if (defined $key) { |
3682
|
19
|
|
|
|
|
82
|
$self->expand_stmt($out, $key, $fmt); |
3683
|
19
|
|
|
|
|
42
|
push(@$out, '=>'); |
3684
|
|
|
|
|
|
|
} |
3685
|
29
|
|
|
|
|
91
|
$self->expand_stmt($out, $value, $fmt); |
3686
|
29
|
|
|
|
|
55
|
push(@$out, ')'); |
3687
|
29
|
|
|
|
|
73
|
$self->expand_stmt($out, $block, $fmt); |
3688
|
|
|
|
|
|
|
} elsif ($cmd eq 'switch') { |
3689
|
6
|
|
|
|
|
14
|
my ($expr, $cases) = @{$self->{strmap}->{$s}}[1..2]; |
|
6
|
|
|
|
|
27
|
|
3690
|
|
|
|
|
|
|
|
3691
|
6
|
|
|
|
|
12
|
push(@$out, $cmd); |
3692
|
6
|
|
|
|
|
13
|
push(@$out, '('); |
3693
|
6
|
|
|
|
|
17
|
$self->expand_stmt($out, $expr, $fmt); |
3694
|
6
|
|
|
|
|
15
|
push(@$out, ')'); |
3695
|
6
|
|
|
|
|
13
|
push(@$out, '{'); |
3696
|
6
|
|
|
|
|
22
|
foreach my $e (@$cases) { |
3697
|
8
|
|
|
|
|
19
|
my $c = $e->[0]; |
3698
|
8
|
|
|
|
|
16
|
my $b = $e->[1]; |
3699
|
8
|
50
|
|
|
|
18
|
if (defined $c) { |
3700
|
8
|
|
|
|
|
14
|
push(@$out, 'case'); |
3701
|
8
|
|
|
|
|
25
|
$self->expand_stmt($out, $c, $fmt); |
3702
|
8
|
|
|
|
|
37
|
push(@$out, ':'); |
3703
|
|
|
|
|
|
|
} else { |
3704
|
0
|
|
|
|
|
0
|
push(@$out, 'default'); |
3705
|
0
|
|
|
|
|
0
|
push(@$out, ':'); |
3706
|
|
|
|
|
|
|
} |
3707
|
8
|
|
|
|
|
23
|
$self->expand_stmt($out, $b, $fmt); |
3708
|
8
|
|
|
|
|
37
|
push(@$out, ';'); |
3709
|
|
|
|
|
|
|
} |
3710
|
6
|
|
|
|
|
14
|
push(@$out, '}'); |
3711
|
|
|
|
|
|
|
} elsif ($cmd eq 'case') { |
3712
|
0
|
|
|
|
|
0
|
my $expr = $self->{strmap}->{$s}->[1]; |
3713
|
0
|
0
|
|
|
|
0
|
if (!defined $expr) { |
3714
|
0
|
|
|
|
|
0
|
push(@$out, 'default'); |
3715
|
0
|
|
|
|
|
0
|
push(@$out, ':'); |
3716
|
|
|
|
|
|
|
} else { |
3717
|
0
|
|
|
|
|
0
|
push(@$out, 'case'); |
3718
|
0
|
|
|
|
|
0
|
$self->expand_stmt($out, $expr, $fmt); |
3719
|
0
|
|
|
|
|
0
|
push(@$out, ':'); |
3720
|
|
|
|
|
|
|
} |
3721
|
|
|
|
|
|
|
} elsif ($cmd eq 'try') { |
3722
|
1
|
|
|
|
|
3
|
my ($try, $catches, $finally) = @{$self->{strmap}->{$s}}[1..3]; |
|
1
|
|
|
|
|
5
|
|
3723
|
|
|
|
|
|
|
|
3724
|
1
|
|
|
|
|
3
|
push(@$out, $cmd); |
3725
|
1
|
|
|
|
|
4
|
$self->expand_stmt($out, $try, $fmt); |
3726
|
1
|
|
|
|
|
7
|
foreach my $c (@$catches) { |
3727
|
1
|
|
|
|
|
3
|
my $e = $c->[0]; |
3728
|
1
|
|
|
|
|
5
|
my $b = $c->[1]; |
3729
|
1
|
|
|
|
|
5
|
push(@$out, 'catch'); |
3730
|
1
|
|
|
|
|
3
|
push(@$out, '('); |
3731
|
1
|
|
|
|
|
18
|
$self->expand_stmt($out, $e, $fmt); |
3732
|
1
|
|
|
|
|
3
|
push(@$out, ')'); |
3733
|
1
|
|
|
|
|
12
|
$self->expand_stmt($out, $b, $fmt); |
3734
|
|
|
|
|
|
|
} |
3735
|
1
|
50
|
|
|
|
7
|
if (defined $finally) { |
3736
|
1
|
|
|
|
|
3
|
push(@$out, 'finally'); |
3737
|
1
|
|
|
|
|
5
|
$self->expand_stmt($out, $finally, $fmt); |
3738
|
|
|
|
|
|
|
} |
3739
|
|
|
|
|
|
|
} else { |
3740
|
1
|
|
|
|
|
3
|
push(@$out, $cmd); |
3741
|
|
|
|
|
|
|
} |
3742
|
|
|
|
|
|
|
} elsif (is_variable($s)) { |
3743
|
1827
|
|
|
|
|
3297
|
my ($global) = global_split($s); |
3744
|
1827
|
100
|
|
|
|
3339
|
if (defined $global) { |
3745
|
35
|
|
|
|
|
182
|
my ($sym) = $global =~ /^\$(.*)$/; |
3746
|
35
|
|
|
|
|
94
|
push(@$out, '$GLOBALS'); |
3747
|
35
|
|
|
|
|
88
|
push(@$out, '['); |
3748
|
35
|
|
|
|
|
107
|
push(@$out, '\'' . $sym . '\''); |
3749
|
35
|
|
|
|
|
64
|
push(@$out, ']'); |
3750
|
|
|
|
|
|
|
} else { |
3751
|
1792
|
|
|
|
|
3154
|
my ($class, $sym) = inst_split($s); |
3752
|
1792
|
100
|
|
|
|
4577
|
if (defined $class) { |
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
3753
|
14
|
|
|
|
|
31
|
push(@$out, $class); |
3754
|
14
|
|
|
|
|
30
|
push(@$out, '::'); |
3755
|
14
|
|
|
|
|
33
|
push(@$out, $sym); |
3756
|
|
|
|
|
|
|
} elsif ($s eq '$') { |
3757
|
4
|
|
|
|
|
10
|
push(@$out, '$'); |
3758
|
4
|
|
|
|
|
10
|
push(@$out, '{'); |
3759
|
4
|
|
|
|
|
8
|
push(@$out, 'null'); |
3760
|
4
|
|
|
|
|
11
|
push(@$out, '}'); |
3761
|
|
|
|
|
|
|
} elsif (!is_strict_variable($s)) { |
3762
|
1
|
|
|
|
|
5
|
($sym) = $s =~ /^\$(.*)$/; |
3763
|
1
|
|
|
|
|
5
|
$sym = escape_str($sym, $fmt); |
3764
|
|
|
|
|
|
|
|
3765
|
1
|
|
|
|
|
4
|
push(@$out, '$'); |
3766
|
1
|
|
|
|
|
2
|
push(@$out, '{'); |
3767
|
1
|
|
|
|
|
4
|
push(@$out, $sym); |
3768
|
1
|
|
|
|
|
2
|
push(@$out, '}'); |
3769
|
|
|
|
|
|
|
} else { |
3770
|
1773
|
|
|
|
|
3772
|
push(@$out, $s); |
3771
|
|
|
|
|
|
|
} |
3772
|
|
|
|
|
|
|
} |
3773
|
|
|
|
|
|
|
} else { |
3774
|
632
|
|
|
|
|
1344
|
my ($class, $sym) = method_split($s); |
3775
|
632
|
100
|
|
|
|
1215
|
if (defined $class) { |
3776
|
12
|
50
|
|
|
|
23
|
if ($class =~ /^(#inst\d+)$/) { |
3777
|
0
|
|
|
|
|
0
|
$self->expand_stmt($out, $class, $fmt); |
3778
|
0
|
|
|
|
|
0
|
push(@$out, '->'); |
3779
|
0
|
|
|
|
|
0
|
push(@$out, $sym); |
3780
|
|
|
|
|
|
|
} else { |
3781
|
12
|
|
|
|
|
28
|
push(@$out, $class); |
3782
|
12
|
|
|
|
|
21
|
push(@$out, '::'); |
3783
|
12
|
|
|
|
|
22
|
push(@$out, $sym); |
3784
|
|
|
|
|
|
|
} |
3785
|
|
|
|
|
|
|
} else { |
3786
|
620
|
|
|
|
|
1233
|
push(@$out, $s); |
3787
|
|
|
|
|
|
|
} |
3788
|
|
|
|
|
|
|
} |
3789
|
8423
|
|
|
|
|
13010
|
return; |
3790
|
|
|
|
|
|
|
} |
3791
|
|
|
|
|
|
|
|
3792
|
|
|
|
|
|
|
sub expand_formatted { |
3793
|
0
|
|
|
0
|
0
|
0
|
my ($out, $in, $tabs) = @_; |
3794
|
0
|
|
|
|
|
0
|
my $orgtabs = $tabs; |
3795
|
0
|
|
|
|
|
0
|
my $spc = "\t" x $tabs; |
3796
|
0
|
|
|
|
|
0
|
my $val; |
3797
|
|
|
|
|
|
|
my $lastval; |
3798
|
0
|
|
|
|
|
0
|
my $varblk = 0; |
3799
|
|
|
|
|
|
|
|
3800
|
|
|
|
|
|
|
# insert newlines and indent {}-blocks |
3801
|
|
|
|
|
|
|
# |
3802
|
0
|
|
|
|
|
0
|
while (1) { |
3803
|
0
|
|
|
|
|
0
|
my $val = shift @$in; |
3804
|
0
|
|
|
|
|
0
|
my $isfor = 0; |
3805
|
0
|
|
|
|
|
0
|
my $isswitch = 0; |
3806
|
0
|
|
|
|
|
0
|
my $iscase = 0; |
3807
|
0
|
|
|
|
|
0
|
my $isfunc = 0; |
3808
|
0
|
|
|
|
|
0
|
my $exprblk = 0; |
3809
|
|
|
|
|
|
|
|
3810
|
0
|
0
|
|
|
|
0
|
if (!defined $val) { |
3811
|
0
|
|
|
|
|
0
|
return; |
3812
|
|
|
|
|
|
|
} |
3813
|
0
|
0
|
|
|
|
0
|
if ($val eq '}') { |
3814
|
0
|
|
|
|
|
0
|
return; |
3815
|
|
|
|
|
|
|
} |
3816
|
0
|
|
|
|
|
0
|
push(@$out, $spc); |
3817
|
0
|
|
|
|
|
0
|
STMT: while(defined $val) { |
3818
|
0
|
0
|
|
|
|
0
|
if ($val =~ /^(case|default)$/) { |
|
|
0
|
|
|
|
|
|
3819
|
0
|
|
|
|
|
0
|
$iscase = 1; |
3820
|
|
|
|
|
|
|
} elsif ($val =~ /^(function|class)$/) { |
3821
|
0
|
|
|
|
|
0
|
$isfunc = 1; |
3822
|
|
|
|
|
|
|
} |
3823
|
0
|
0
|
0
|
|
|
0
|
if ((scalar @$in > 0) && ($in->[0] =~ /^(case|default)$/)) { |
3824
|
0
|
|
|
|
|
0
|
$tabs = $orgtabs; |
3825
|
0
|
|
|
|
|
0
|
$spc = "\t" x $tabs; |
3826
|
|
|
|
|
|
|
} |
3827
|
0
|
|
|
|
|
0
|
push(@$out, $val); |
3828
|
0
|
0
|
0
|
|
|
0
|
if (($val eq '{') && defined $lastval && ($lastval eq '$')) { |
|
|
0
|
0
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
3829
|
0
|
|
|
|
|
0
|
$varblk++; |
3830
|
|
|
|
|
|
|
} elsif ($val eq '(') { |
3831
|
0
|
0
|
0
|
|
|
0
|
if (defined $lastval && ($lastval eq 'for')) { |
|
|
0
|
0
|
|
|
|
|
3832
|
0
|
|
|
|
|
0
|
$isfor = 1; |
3833
|
|
|
|
|
|
|
} elsif (defined $lastval && ($lastval eq 'switch')) { |
3834
|
0
|
|
|
|
|
0
|
$isswitch = 1; |
3835
|
|
|
|
|
|
|
} |
3836
|
0
|
|
|
|
|
0
|
$exprblk++; |
3837
|
|
|
|
|
|
|
} elsif ($val eq '{') { |
3838
|
0
|
|
|
|
|
0
|
push(@$out, "\n"); |
3839
|
0
|
0
|
|
|
|
0
|
if ($isswitch) { |
3840
|
0
|
|
|
|
|
0
|
&expand_formatted($out, $in, $tabs); |
3841
|
|
|
|
|
|
|
} else { |
3842
|
0
|
|
|
|
|
0
|
&expand_formatted($out, $in, $tabs+1); |
3843
|
|
|
|
|
|
|
} |
3844
|
0
|
|
|
|
|
0
|
push(@$out, $spc); |
3845
|
0
|
|
|
|
|
0
|
push(@$out, "}"); |
3846
|
0
|
0
|
0
|
|
|
0
|
if ((scalar @$in > 0) && !($in->[0] =~ /^(else|catch|finally|\))$/)) { |
3847
|
0
|
|
|
|
|
0
|
push(@$out, "\n"); |
3848
|
|
|
|
|
|
|
#push(@$out, "\n") if $isfunc; # blank line after function? |
3849
|
0
|
|
|
|
|
0
|
last STMT; |
3850
|
|
|
|
|
|
|
} |
3851
|
|
|
|
|
|
|
} elsif ($val eq ';') { |
3852
|
0
|
0
|
|
|
|
0
|
if (!$isfor) { |
3853
|
0
|
|
|
|
|
0
|
push(@$out, "\n"); |
3854
|
0
|
|
|
|
|
0
|
last STMT; |
3855
|
|
|
|
|
|
|
} |
3856
|
|
|
|
|
|
|
} elsif ($val eq ':') { |
3857
|
0
|
0
|
|
|
|
0
|
if ($iscase) { |
3858
|
0
|
|
|
|
|
0
|
push(@$out, "\n"); |
3859
|
0
|
|
|
|
|
0
|
$iscase = 0; |
3860
|
0
|
|
|
|
|
0
|
$tabs++; |
3861
|
0
|
|
|
|
|
0
|
$spc .= "\t"; |
3862
|
0
|
|
|
|
|
0
|
last STMT; |
3863
|
|
|
|
|
|
|
} |
3864
|
|
|
|
|
|
|
} |
3865
|
0
|
|
|
|
|
0
|
$lastval = $val; |
3866
|
0
|
|
|
|
|
0
|
$val = shift @$in; |
3867
|
|
|
|
|
|
|
|
3868
|
0
|
0
|
0
|
|
|
0
|
if (defined $val && ($val eq '}')) { |
3869
|
0
|
0
|
|
|
|
0
|
if ($varblk == 0) { |
3870
|
0
|
|
|
|
|
0
|
return; |
3871
|
|
|
|
|
|
|
} |
3872
|
0
|
|
|
|
|
0
|
$varblk--; |
3873
|
|
|
|
|
|
|
} |
3874
|
0
|
0
|
0
|
|
|
0
|
if (defined $val && ($val eq ')')) { |
3875
|
0
|
|
|
|
|
0
|
$exprblk--; |
3876
|
|
|
|
|
|
|
} |
3877
|
|
|
|
|
|
|
} |
3878
|
|
|
|
|
|
|
} |
3879
|
0
|
|
|
|
|
0
|
return; |
3880
|
|
|
|
|
|
|
} |
3881
|
|
|
|
|
|
|
|
3882
|
|
|
|
|
|
|
sub insert_blanks { |
3883
|
0
|
|
|
0
|
0
|
0
|
my ($in) = @_; |
3884
|
0
|
|
|
|
|
0
|
my @out = (); |
3885
|
0
|
|
|
|
|
0
|
my $lastval; |
3886
|
|
|
|
|
|
|
|
3887
|
0
|
|
|
|
|
0
|
while (1) { |
3888
|
0
|
|
|
|
|
0
|
my $val = shift @$in; |
3889
|
0
|
0
|
|
|
|
0
|
if (!defined $val) { |
3890
|
0
|
|
|
|
|
0
|
last; |
3891
|
|
|
|
|
|
|
} |
3892
|
|
|
|
|
|
|
# - no blanks in parenthesis or square brackets |
3893
|
|
|
|
|
|
|
# - blank after semicolon or comma |
3894
|
|
|
|
|
|
|
# - blank after most php keywords |
3895
|
|
|
|
|
|
|
# - no blank after function calls |
3896
|
|
|
|
|
|
|
# - no blank after unary ops |
3897
|
|
|
|
|
|
|
# - no blank in pre/post inc/decrement |
3898
|
|
|
|
|
|
|
# - no blank in object/scope reference |
3899
|
|
|
|
|
|
|
# |
3900
|
0
|
0
|
0
|
|
|
0
|
if (defined $lastval && ($lastval ne "\n") && ($lastval !~ /^\t*$/)) { # zero or more tabs |
|
|
|
0
|
|
|
|
|
3901
|
0
|
0
|
0
|
|
|
0
|
if ($val !~ /^(\[|\]|\(|\)|\;|\,|\\n|->|::)$/) { |
|
|
0
|
0
|
|
|
|
|
|
|
0
|
0
|
|
|
|
|
3902
|
0
|
0
|
|
|
|
0
|
if ($lastval !~ /^(\[|\(|\!|\~|->|::)$/) { |
3903
|
0
|
0
|
0
|
|
|
0
|
unless ((($val eq '++') || ($val eq '--')) && is_strict_variable($lastval)) { |
|
|
|
0
|
|
|
|
|
3904
|
0
|
|
|
|
|
0
|
push(@out, ' '); |
3905
|
|
|
|
|
|
|
} |
3906
|
|
|
|
|
|
|
} |
3907
|
|
|
|
|
|
|
} elsif (($val eq '(') && exists $php_keywords{lc($lastval)}) { |
3908
|
0
|
0
|
|
|
|
0
|
unless ($lastval =~ /^(array|empty|isset|unset|list)$/) { |
3909
|
0
|
|
|
|
|
0
|
push(@out, ' '); |
3910
|
|
|
|
|
|
|
} |
3911
|
|
|
|
|
|
|
} elsif (($val eq '(') && !is_symbol($lastval) && ($lastval !~ /^(\[|\]|\(|\))$/)) { |
3912
|
0
|
|
|
|
|
0
|
push(@out, ' '); |
3913
|
|
|
|
|
|
|
} |
3914
|
|
|
|
|
|
|
} |
3915
|
0
|
|
|
|
|
0
|
push(@out, $val); |
3916
|
0
|
|
|
|
|
0
|
$lastval = $val; |
3917
|
|
|
|
|
|
|
} |
3918
|
0
|
|
|
|
|
0
|
return @out; |
3919
|
|
|
|
|
|
|
} |
3920
|
|
|
|
|
|
|
|
3921
|
|
|
|
|
|
|
# convert statements to code (flags are optional) |
3922
|
|
|
|
|
|
|
# {indent} - output indented multiline code |
3923
|
|
|
|
|
|
|
# {unified} - unified #str/#num output |
3924
|
|
|
|
|
|
|
# {mask_eval} - mask eval in strings with pattern |
3925
|
|
|
|
|
|
|
# {escape_ctrl} - escape control characters in output strings |
3926
|
|
|
|
|
|
|
# {avoid_semicolon} - avoid semicolons after braces |
3927
|
|
|
|
|
|
|
# {max_strlen} - max length for strings in output |
3928
|
|
|
|
|
|
|
# |
3929
|
|
|
|
|
|
|
sub format_stmt { |
3930
|
783
|
|
|
783
|
1
|
3066
|
my ($self, $line, $fmt) = @_; |
3931
|
783
|
|
|
|
|
1255
|
my @out = (); |
3932
|
783
|
100
|
|
|
|
2236
|
$fmt = {} unless defined $fmt; |
3933
|
|
|
|
|
|
|
|
3934
|
783
|
|
|
|
|
2309
|
$self->expand_stmt(\@out, $line, $fmt); |
3935
|
|
|
|
|
|
|
|
3936
|
783
|
100
|
100
|
|
|
4820
|
if (!$fmt->{avoid_semicolon} && (scalar @out > 0) && ($out[-1] ne '}') && ($out[-1] ne ';')) { |
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
3937
|
175
|
|
|
|
|
339
|
push(@out, ';'); |
3938
|
|
|
|
|
|
|
} |
3939
|
783
|
50
|
|
|
|
1640
|
if (exists $fmt->{indent}) { |
3940
|
0
|
|
|
|
|
0
|
my @tmp = (); |
3941
|
0
|
|
|
|
|
0
|
expand_formatted(\@tmp, \@out, 0); |
3942
|
0
|
|
|
|
|
0
|
return join('', insert_blanks(\@tmp)); |
3943
|
|
|
|
|
|
|
} |
3944
|
783
|
|
|
|
|
5110
|
return join(' ', @out); |
3945
|
|
|
|
|
|
|
} |
3946
|
|
|
|
|
|
|
|
3947
|
6
|
|
|
6
|
|
85
|
use constant HINT_ASSIGN => 0x10000; # variable is assigned to |
|
6
|
|
|
|
|
15
|
|
|
6
|
|
|
|
|
466
|
|
3948
|
6
|
|
|
6
|
|
46
|
use constant HINT_UNSET => 0x20000; # variable is unset |
|
6
|
|
|
|
|
17
|
|
|
6
|
|
|
|
|
57957
|
|
3949
|
|
|
|
|
|
|
|
3950
|
|
|
|
|
|
|
# if expression in block contains an unresolvable variable, then return it |
3951
|
|
|
|
|
|
|
# |
3952
|
|
|
|
|
|
|
sub stmt_info { |
3953
|
5471
|
|
|
5471
|
0
|
10070
|
my ($self, $s, $info, $hint) = @_; |
3954
|
|
|
|
|
|
|
|
3955
|
5471
|
100
|
|
|
|
38892
|
if ($s =~ /^#blk\d+$/) { |
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
3956
|
681
|
|
|
|
|
1000
|
my ($type, $a) = @{$self->{strmap}->{$s}}; |
|
681
|
|
|
|
|
1540
|
|
3957
|
681
|
|
|
|
|
1303
|
foreach my $stmt (@$a) { |
3958
|
894
|
|
|
|
|
2028
|
$self->stmt_info($stmt, $info); |
3959
|
|
|
|
|
|
|
} |
3960
|
|
|
|
|
|
|
#} elsif ($s =~ /^#num\d+$/) { |
3961
|
|
|
|
|
|
|
# my $v = $self->{strmap}->{$s}; |
3962
|
|
|
|
|
|
|
# $info->{nums}{$s} = $v; |
3963
|
|
|
|
|
|
|
#} elsif ($s =~ /^#str\d+$/) { |
3964
|
|
|
|
|
|
|
# my $v = $self->{strmap}->{$s}; |
3965
|
|
|
|
|
|
|
# $info->{strs}{$s} = $v; |
3966
|
|
|
|
|
|
|
} elsif ($s =~ /^#const\d+$/) { |
3967
|
12
|
|
|
|
|
55
|
$s = $self->{strmap}->{$s}; |
3968
|
12
|
|
|
|
|
44
|
$info->{consts}{$s} = 1; |
3969
|
|
|
|
|
|
|
} elsif ($s =~ /^#arr\d+$/) { |
3970
|
286
|
|
|
|
|
617
|
my $arr = $self->{strmap}{$s}; |
3971
|
286
|
|
|
|
|
799
|
my $keys = $arr->get_keys(); |
3972
|
286
|
|
|
|
|
502
|
my $haskey = 0; |
3973
|
|
|
|
|
|
|
|
3974
|
286
|
|
|
|
|
609
|
foreach my $k (@$keys) { |
3975
|
457
|
|
|
|
|
1039
|
my $val = $arr->val($k); |
3976
|
457
|
100
|
|
|
|
1365
|
unless (is_int_index($k)) { |
3977
|
21
|
|
|
|
|
74
|
$self->stmt_info($k, $info); |
3978
|
|
|
|
|
|
|
} |
3979
|
457
|
50
|
|
|
|
1116
|
if (defined $val) { |
3980
|
457
|
|
|
|
|
1093
|
$self->stmt_info($val, $info); |
3981
|
457
|
|
|
|
|
856
|
$haskey = 1; |
3982
|
|
|
|
|
|
|
} |
3983
|
|
|
|
|
|
|
} |
3984
|
286
|
100
|
|
|
|
771
|
if ($haskey) { |
3985
|
264
|
|
|
|
|
1000
|
$info->{arrays}{$s} = 'map'; |
3986
|
|
|
|
|
|
|
} else { |
3987
|
22
|
|
|
|
|
84
|
$info->{arrays}{$s} = 'array'; |
3988
|
|
|
|
|
|
|
} |
3989
|
|
|
|
|
|
|
} elsif ($s =~ /^#fun\d+$/) { |
3990
|
23
|
|
|
|
|
56
|
my ($f, $a, $b, $p) = @{$self->{strmap}->{$s}}; |
|
23
|
|
|
|
|
65
|
|
3991
|
23
|
100
|
|
|
|
54
|
if (defined $f) { |
3992
|
8
|
|
|
|
|
29
|
$info->{funcs}{$f} = 1; |
3993
|
|
|
|
|
|
|
} else { |
3994
|
15
|
|
|
|
|
44
|
$info->{funcs}{$s} = 1; # anon func |
3995
|
|
|
|
|
|
|
} |
3996
|
|
|
|
|
|
|
} elsif ($s =~ /^#expr\d+$/) { |
3997
|
482
|
|
|
|
|
725
|
my ($op, $v1, $v2) = @{$self->{strmap}->{$s}}; |
|
482
|
|
|
|
|
1382
|
|
3998
|
482
|
100
|
|
|
|
1117
|
if (defined $v1) { |
3999
|
450
|
100
|
100
|
|
|
3671
|
if (($op eq '=') && ($v1 =~ /^#elem\d+$/) && defined $v2) { |
|
|
100
|
66
|
|
|
|
|
|
|
100
|
66
|
|
|
|
|
|
|
100
|
100
|
|
|
|
|
|
|
100
|
66
|
|
|
|
|
|
|
|
66
|
|
|
|
|
4000
|
51
|
|
|
|
|
78
|
my ($v, $i) = @{$self->{strmap}->{$v1}}; |
|
51
|
|
|
|
|
151
|
|
4001
|
|
|
|
|
|
|
|
4002
|
51
|
100
|
|
|
|
115
|
unless (defined $i) { |
4003
|
17
|
|
|
|
|
49
|
$self->stmt_info($v1, $info, T_ARRAY|HINT_ASSIGN); |
4004
|
|
|
|
|
|
|
} else { |
4005
|
34
|
|
|
|
|
77
|
$self->stmt_info($v1, $info, HINT_ASSIGN); |
4006
|
|
|
|
|
|
|
} |
4007
|
|
|
|
|
|
|
} elsif (($op eq '=') && defined $v2 && ($v2 =~ /^#call\d+$/)) { |
4008
|
14
|
|
|
|
|
54
|
my ($f, $a) = @{$self->{strmap}->{$v2}}; |
|
14
|
|
|
|
|
70
|
|
4009
|
|
|
|
|
|
|
|
4010
|
14
|
50
|
|
|
|
43
|
if ($f eq 'range') { |
4011
|
0
|
|
|
|
|
0
|
$self->stmt_info($v1, $info, T_ARRAY|HINT_ASSIGN); |
4012
|
|
|
|
|
|
|
} else { |
4013
|
14
|
|
|
|
|
39
|
$self->stmt_info($v1, $info, HINT_ASSIGN); |
4014
|
|
|
|
|
|
|
} |
4015
|
|
|
|
|
|
|
} elsif (($op eq '=') && defined $v2) { |
4016
|
283
|
|
|
|
|
591
|
$self->stmt_info($v1, $info, HINT_ASSIGN); |
4017
|
|
|
|
|
|
|
} elsif ($op eq '.') { |
4018
|
30
|
|
|
|
|
69
|
$self->stmt_info($v1, $info, T_STR); |
4019
|
|
|
|
|
|
|
} elsif (($op eq '++') || ($op eq '--')) { |
4020
|
14
|
|
|
|
|
45
|
$self->stmt_info($v1, $info, HINT_ASSIGN); |
4021
|
|
|
|
|
|
|
} else { |
4022
|
58
|
|
|
|
|
137
|
$self->stmt_info($v1, $info); |
4023
|
|
|
|
|
|
|
} |
4024
|
450
|
100
|
|
|
|
986
|
if ($op eq '=') { |
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
4025
|
348
|
|
|
|
|
935
|
my $vb = $self->elem_base($v1); |
4026
|
348
|
|
|
|
|
875
|
$info->{assigns}{$vb} = 1; |
4027
|
|
|
|
|
|
|
} elsif ($op eq '++') { |
4028
|
14
|
|
|
|
|
43
|
my $vb = $self->elem_base($v1); |
4029
|
14
|
|
|
|
|
44
|
$info->{assigns}{$vb} = 1; |
4030
|
|
|
|
|
|
|
} elsif ($op eq '--') { |
4031
|
0
|
|
|
|
|
0
|
my $vb = $self->elem_base($v1); |
4032
|
0
|
|
|
|
|
0
|
$info->{assigns}{$vb} = 1; |
4033
|
|
|
|
|
|
|
} |
4034
|
|
|
|
|
|
|
} |
4035
|
482
|
100
|
|
|
|
951
|
if (defined $v2) { |
4036
|
468
|
100
|
66
|
|
|
1558
|
if ($op eq '.') { |
|
|
100
|
|
|
|
|
|
4037
|
30
|
|
|
|
|
85
|
$self->stmt_info($v2, $info, T_STR); |
4038
|
|
|
|
|
|
|
} elsif (($op eq '++') || ($op eq '--')) { |
4039
|
1
|
|
|
|
|
4
|
$self->stmt_info($v2, $info, HINT_ASSIGN); |
4040
|
|
|
|
|
|
|
} else { |
4041
|
437
|
|
|
|
|
846
|
$self->stmt_info($v2, $info); |
4042
|
|
|
|
|
|
|
} |
4043
|
468
|
50
|
|
|
|
1312
|
if ($op eq '++') { |
|
|
100
|
|
|
|
|
|
4044
|
0
|
|
|
|
|
0
|
my $vb = $self->elem_base($v2); |
4045
|
0
|
|
|
|
|
0
|
$info->{assigns}{$vb} = 1; |
4046
|
|
|
|
|
|
|
} elsif ($op eq '--') { |
4047
|
1
|
|
|
|
|
4
|
my $vb = $self->elem_base($v2); |
4048
|
1
|
|
|
|
|
3
|
$info->{assigns}{$vb} = 1; |
4049
|
|
|
|
|
|
|
} |
4050
|
|
|
|
|
|
|
} |
4051
|
|
|
|
|
|
|
} elsif ($s =~ /^#elem\d+$/) { |
4052
|
174
|
|
|
|
|
279
|
my ($v, $i) = @{$self->{strmap}->{$s}}; |
|
174
|
|
|
|
|
471
|
|
4053
|
174
|
50
|
|
|
|
360
|
if (defined $v) { |
4054
|
174
|
|
|
|
|
277
|
my $hint_assign = 0; |
4055
|
174
|
100
|
100
|
|
|
517
|
$hint_assign = HINT_ASSIGN if (defined $hint && ($hint & HINT_ASSIGN)); |
4056
|
174
|
100
|
|
|
|
313
|
if (defined $i) { |
4057
|
157
|
|
|
|
|
457
|
$self->stmt_info($v, $info, $hint_assign); |
4058
|
|
|
|
|
|
|
} else { |
4059
|
17
|
|
|
|
|
55
|
$self->stmt_info($v, $info, T_STR|T_ARRAY|$hint_assign); |
4060
|
|
|
|
|
|
|
} |
4061
|
|
|
|
|
|
|
} |
4062
|
174
|
100
|
|
|
|
363
|
if (defined $i) { |
4063
|
157
|
|
|
|
|
409
|
$self->stmt_info($i, $info); |
4064
|
|
|
|
|
|
|
|
4065
|
|
|
|
|
|
|
# add resolvable globals |
4066
|
|
|
|
|
|
|
# |
4067
|
157
|
|
|
|
|
495
|
my $g = $self->globalvar_to_var($v, $i); |
4068
|
157
|
100
|
|
|
|
397
|
if (defined $g) { |
4069
|
22
|
|
|
|
|
81
|
$info->{globals}{$g} = 1; |
4070
|
|
|
|
|
|
|
} |
4071
|
|
|
|
|
|
|
} |
4072
|
|
|
|
|
|
|
} elsif ($s =~ /^#obj\d+$/) { |
4073
|
9
|
|
|
|
|
22
|
my ($o, $m) = @{$self->{strmap}->{$s}}; |
|
9
|
|
|
|
|
34
|
|
4074
|
9
|
100
|
|
|
|
33
|
if (lc($o) ne '$this') { |
4075
|
4
|
|
|
|
|
9
|
$self->stmt_info($o, $info); |
4076
|
|
|
|
|
|
|
} |
4077
|
9
|
50
|
|
|
|
26
|
if (defined $m) { |
4078
|
9
|
|
|
|
|
25
|
$self->stmt_info($m, $info); |
4079
|
|
|
|
|
|
|
} |
4080
|
|
|
|
|
|
|
} elsif ($s =~ /^#inst\d+$/) { |
4081
|
19
|
|
|
|
|
41
|
my ($c, $f, $i) = @{$self->{strmap}->{$s}}; |
|
19
|
|
|
|
|
61
|
|
4082
|
19
|
50
|
|
|
|
53
|
if (defined $c) { |
4083
|
19
|
|
|
|
|
50
|
$self->stmt_info($c, $info); |
4084
|
|
|
|
|
|
|
} |
4085
|
|
|
|
|
|
|
} elsif ($s =~ /^#scope\d+$/) { |
4086
|
0
|
|
|
|
|
0
|
my ($c, $e) = @{$self->{strmap}->{$s}}; |
|
0
|
|
|
|
|
0
|
|
4087
|
0
|
0
|
|
|
|
0
|
if (defined $e) { |
4088
|
0
|
|
|
|
|
0
|
$self->stmt_info($e, $info); |
4089
|
|
|
|
|
|
|
} |
4090
|
|
|
|
|
|
|
} elsif ($s =~ /^#ns\d+$/) { |
4091
|
0
|
|
|
|
|
0
|
my ($n, $e) = @{$self->{strmap}->{$s}}; |
|
0
|
|
|
|
|
0
|
|
4092
|
0
|
0
|
|
|
|
0
|
if (defined $e) { |
4093
|
0
|
|
|
|
|
0
|
$self->stmt_info($e, $info); |
4094
|
|
|
|
|
|
|
} |
4095
|
|
|
|
|
|
|
} elsif ($s =~ /^#ref\d+$/) { |
4096
|
0
|
|
|
|
|
0
|
my $v = $self->{strmap}->{$s}->[0]; |
4097
|
0
|
0
|
|
|
|
0
|
if (defined $v) { |
4098
|
0
|
|
|
|
|
0
|
$self->stmt_info($v, $info); |
4099
|
|
|
|
|
|
|
} |
4100
|
|
|
|
|
|
|
} elsif ($s =~ /^#call\d+$/) { |
4101
|
295
|
|
|
|
|
508
|
my ($f, $a) = @{$self->{strmap}->{$s}}; |
|
295
|
|
|
|
|
833
|
|
4102
|
295
|
|
|
|
|
583
|
my $narg = scalar @$a; |
4103
|
295
|
100
|
66
|
|
|
911
|
if (exists $info->{state} && $info->{state}) { |
4104
|
14
|
|
|
|
|
39
|
$info->{calls}{$f} = $info->{state}; |
4105
|
|
|
|
|
|
|
} else { |
4106
|
281
|
|
|
|
|
647
|
$info->{calls}{$f} = 1; |
4107
|
|
|
|
|
|
|
} |
4108
|
295
|
|
|
|
|
902
|
$info->{callargs}{$f}{$narg} = 1; # track args count |
4109
|
|
|
|
|
|
|
|
4110
|
295
|
|
|
|
|
735
|
foreach my $k (@$a) { |
4111
|
183
|
100
|
|
|
|
586
|
if ($f eq 'strlen') { |
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
4112
|
3
|
|
|
|
|
9
|
$self->stmt_info($k, $info, T_STR); |
4113
|
|
|
|
|
|
|
} elsif ($f eq 'base64_decode') { |
4114
|
2
|
|
|
|
|
6
|
$self->stmt_info($k, $info, T_STR); |
4115
|
|
|
|
|
|
|
} elsif ($f eq 'gzinflate') { |
4116
|
0
|
|
|
|
|
0
|
$self->stmt_info($k, $info, T_STR); |
4117
|
|
|
|
|
|
|
} else { |
4118
|
178
|
|
|
|
|
439
|
$self->stmt_info($k, $info); |
4119
|
|
|
|
|
|
|
} |
4120
|
|
|
|
|
|
|
} |
4121
|
|
|
|
|
|
|
} elsif ($s =~ /^#pfx\d+$/) { |
4122
|
0
|
|
|
|
|
0
|
my $pfx = $self->{strmap}->{$s}; |
4123
|
|
|
|
|
|
|
} elsif ($s =~ /^#class\d+$/) { |
4124
|
19
|
|
|
|
|
38
|
my ($c, $b, $p) = @{$self->{strmap}->{$s}}; |
|
19
|
|
|
|
|
50
|
|
4125
|
19
|
|
|
|
|
58
|
$info->{classes}{$c} = 1; |
4126
|
|
|
|
|
|
|
} elsif ($s =~ /^#trait\d+$/) { |
4127
|
0
|
|
|
|
|
0
|
my ($t, $b) = @{$self->{strmap}->{$s}}; |
|
0
|
|
|
|
|
0
|
|
4128
|
0
|
|
|
|
|
0
|
$info->{traits}{$t} = 1; |
4129
|
|
|
|
|
|
|
} elsif ($s =~ /^#fh\d+$/) { |
4130
|
0
|
|
|
|
|
0
|
my $f = $self->{strmap}->{$s}{name}; |
4131
|
0
|
|
|
|
|
0
|
my $m = $self->{strmap}->{$s}{mode}; |
4132
|
0
|
|
|
|
|
0
|
my $p = $self->{strmap}->{$s}{pos}; |
4133
|
0
|
|
|
|
|
0
|
$info->{fhs}{$f} = 1; |
4134
|
|
|
|
|
|
|
} elsif ($s =~ /^#stmt\d+$/) { |
4135
|
582
|
|
|
|
|
1435
|
my $cmd = $self->{strmap}->{$s}->[0]; |
4136
|
582
|
100
|
|
|
|
3465
|
if ($cmd eq 'echo') { |
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
4137
|
128
|
|
|
|
|
257
|
my $a = $self->{strmap}->{$s}->[1]; |
4138
|
128
|
|
|
|
|
320
|
foreach my $k (@$a) { |
4139
|
128
|
|
|
|
|
277
|
$self->stmt_info($k, $info); |
4140
|
|
|
|
|
|
|
} |
4141
|
128
|
|
|
|
|
328
|
$info->{stmts}{$s} = 1; |
4142
|
|
|
|
|
|
|
} elsif ($cmd eq 'print') { |
4143
|
0
|
|
|
|
|
0
|
my $arg = $self->{strmap}->{$s}->[1]; |
4144
|
0
|
|
|
|
|
0
|
$self->stmt_info($arg, $info); |
4145
|
0
|
|
|
|
|
0
|
$info->{stmts}{$s} = 1; |
4146
|
|
|
|
|
|
|
} elsif ($cmd eq 'namespace') { |
4147
|
0
|
|
|
|
|
0
|
my ($arg, $block) = @{$self->{strmap}->{$s}}[1..2]; |
|
0
|
|
|
|
|
0
|
|
4148
|
0
|
0
|
|
|
|
0
|
if (defined $block) { |
4149
|
0
|
|
|
|
|
0
|
$self->stmt_info($block, $info); |
4150
|
|
|
|
|
|
|
} |
4151
|
0
|
|
|
|
|
0
|
$info->{stmts}{$s} = 1; |
4152
|
|
|
|
|
|
|
} elsif ($cmd =~ /^(include|include_once|require|require_once)$/) { |
4153
|
0
|
|
|
|
|
0
|
my $arg = $self->{strmap}->{$s}->[1]; |
4154
|
0
|
|
|
|
|
0
|
$info->{includes}{$arg} = 1; |
4155
|
0
|
|
|
|
|
0
|
$self->stmt_info($arg, $info); |
4156
|
|
|
|
|
|
|
} elsif ($cmd eq 'use') { |
4157
|
0
|
|
|
|
|
0
|
my $a = $self->{strmap}->{$s}->[1]; |
4158
|
0
|
|
|
|
|
0
|
foreach my $v (@$a) { |
4159
|
0
|
|
|
|
|
0
|
$self->stmt_info($v, $info); |
4160
|
|
|
|
|
|
|
} |
4161
|
0
|
|
|
|
|
0
|
$info->{stmts}{$s} = 1; |
4162
|
|
|
|
|
|
|
} elsif ($cmd eq 'global') { |
4163
|
9
|
|
|
|
|
25
|
my $a = $self->{strmap}->{$s}->[1]; |
4164
|
9
|
|
|
|
|
22
|
foreach my $v (@$a) { |
4165
|
9
|
|
|
|
|
44
|
$info->{globals}{$v} = 1; |
4166
|
9
|
|
|
|
|
27
|
$self->stmt_info($v, $info); |
4167
|
|
|
|
|
|
|
} |
4168
|
|
|
|
|
|
|
} elsif ($cmd eq 'static') { |
4169
|
6
|
|
|
|
|
13
|
my $a = $self->{strmap}->{$s}->[1]; |
4170
|
6
|
|
|
|
|
12
|
foreach my $v (@$a) { |
4171
|
6
|
|
|
|
|
17
|
$info->{statics}{$v} = 1; |
4172
|
6
|
|
|
|
|
13
|
$self->stmt_info($v, $info); |
4173
|
|
|
|
|
|
|
} |
4174
|
|
|
|
|
|
|
} elsif ($cmd eq 'const') { |
4175
|
0
|
|
|
|
|
0
|
my $a = $self->{strmap}->{$s}->[1]; |
4176
|
0
|
|
|
|
|
0
|
foreach my $v (@$a) { |
4177
|
0
|
|
|
|
|
0
|
$info->{const}{$v} = 1; |
4178
|
0
|
|
|
|
|
0
|
$self->stmt_info($v, $info); |
4179
|
|
|
|
|
|
|
} |
4180
|
|
|
|
|
|
|
} elsif ($cmd eq 'unset') { |
4181
|
0
|
|
|
|
|
0
|
my $a = $self->{strmap}->{$s}->[1]; |
4182
|
0
|
|
|
|
|
0
|
foreach my $v (@$a) { |
4183
|
0
|
|
|
|
|
0
|
$info->{assigns}{$v} = 1; |
4184
|
0
|
|
|
|
|
0
|
$self->stmt_info($v, $info, HINT_ASSIGN|HINT_UNSET); |
4185
|
|
|
|
|
|
|
} |
4186
|
|
|
|
|
|
|
} elsif ($cmd eq 'return') { |
4187
|
276
|
|
|
|
|
547
|
my $a = $self->{strmap}->{$s}->[1]; |
4188
|
276
|
|
|
|
|
410
|
my $old; |
4189
|
276
|
100
|
|
|
|
584
|
$old = $info->{state} if exists $info->{state}; |
4190
|
276
|
|
|
|
|
529
|
$info->{state} = 'return'; |
4191
|
276
|
|
|
|
|
648
|
$self->stmt_info($a, $info); |
4192
|
276
|
|
|
|
|
475
|
$info->{state} = $old; |
4193
|
276
|
|
|
|
|
846
|
$info->{returns}{$a} = 1; |
4194
|
|
|
|
|
|
|
} elsif ($cmd eq 'goto') { |
4195
|
0
|
|
|
|
|
0
|
my $arg = $self->{strmap}->{$s}->[1]; |
4196
|
0
|
|
|
|
|
0
|
$self->stmt_info($arg, $info); |
4197
|
0
|
|
|
|
|
0
|
$info->{stmts}{$s} = 1; |
4198
|
|
|
|
|
|
|
} elsif ($cmd eq 'label') { |
4199
|
0
|
|
|
|
|
0
|
my $arg = $self->{strmap}->{$s}->[1]; |
4200
|
0
|
|
|
|
|
0
|
$self->stmt_info($arg, $info); |
4201
|
0
|
|
|
|
|
0
|
$info->{stmts}{$s} = 1; |
4202
|
|
|
|
|
|
|
} elsif ($cmd eq 'throw') { |
4203
|
0
|
|
|
|
|
0
|
my $arg = $self->{strmap}->{$s}->[1]; |
4204
|
0
|
|
|
|
|
0
|
$self->stmt_info($arg, $info); |
4205
|
0
|
|
|
|
|
0
|
$info->{stmts}{$s} = 1; |
4206
|
|
|
|
|
|
|
} elsif ($cmd eq 'if') { |
4207
|
129
|
|
|
|
|
219
|
my ($cond, $then, $else) = @{$self->{strmap}->{$s}}[1..3]; |
|
129
|
|
|
|
|
384
|
|
4208
|
|
|
|
|
|
|
|
4209
|
129
|
|
|
|
|
399
|
$self->stmt_info($cond, $info); |
4210
|
129
|
|
|
|
|
349
|
$self->stmt_info($then, $info); |
4211
|
129
|
100
|
|
|
|
320
|
if (defined $else) { |
4212
|
15
|
|
|
|
|
44
|
$self->stmt_info($else, $info); |
4213
|
|
|
|
|
|
|
} |
4214
|
129
|
|
|
|
|
343
|
$info->{stmts}{$s} = 1; |
4215
|
|
|
|
|
|
|
} elsif ($cmd eq 'while') { |
4216
|
6
|
|
|
|
|
12
|
my ($cond, $block) = @{$self->{strmap}->{$s}}[1..2]; |
|
6
|
|
|
|
|
19
|
|
4217
|
|
|
|
|
|
|
|
4218
|
6
|
|
|
|
|
20
|
$self->stmt_info($cond, $info); |
4219
|
6
|
|
|
|
|
15
|
$self->stmt_info($block, $info); |
4220
|
6
|
|
|
|
|
29
|
$info->{stmts}{$s} = 1; |
4221
|
|
|
|
|
|
|
} elsif ($cmd eq 'do') { |
4222
|
1
|
|
|
|
|
3
|
my ($cond, $block) = @{$self->{strmap}->{$s}}[1..2]; |
|
1
|
|
|
|
|
4
|
|
4223
|
|
|
|
|
|
|
|
4224
|
1
|
|
|
|
|
6
|
$self->stmt_info($block, $info); |
4225
|
1
|
|
|
|
|
3
|
$self->stmt_info($cond, $info); |
4226
|
1
|
|
|
|
|
2
|
$info->{stmts}{$s} = 1; |
4227
|
|
|
|
|
|
|
} elsif ($cmd eq 'for') { |
4228
|
8
|
|
|
|
|
21
|
my ($pre, $cond, $post, $block) = @{$self->{strmap}->{$s}}[1..4]; |
|
8
|
|
|
|
|
31
|
|
4229
|
|
|
|
|
|
|
|
4230
|
8
|
|
|
|
|
23
|
$self->stmt_info($pre, $info); |
4231
|
8
|
|
|
|
|
63
|
$self->stmt_info($cond, $info); |
4232
|
8
|
|
|
|
|
56
|
$self->stmt_info($post, $info); |
4233
|
8
|
|
|
|
|
35
|
$self->stmt_info($block, $info); |
4234
|
8
|
|
|
|
|
28
|
$info->{stmts}{$s} = 1; |
4235
|
|
|
|
|
|
|
} elsif ($cmd eq 'foreach') { |
4236
|
11
|
|
|
|
|
23
|
my ($expr, $key, $value, $block) = @{$self->{strmap}->{$s}}[1..4]; |
|
11
|
|
|
|
|
40
|
|
4237
|
|
|
|
|
|
|
|
4238
|
11
|
|
|
|
|
39
|
$self->stmt_info($expr, $info); |
4239
|
11
|
100
|
|
|
|
30
|
if (defined $key) { |
4240
|
7
|
|
|
|
|
19
|
$self->stmt_info($key, $info); |
4241
|
7
|
|
|
|
|
20
|
$info->{assigns}{$key} = 1; |
4242
|
|
|
|
|
|
|
} |
4243
|
11
|
|
|
|
|
32
|
$self->stmt_info($value, $info); |
4244
|
11
|
|
|
|
|
32
|
$info->{assigns}{$value} = 1; |
4245
|
11
|
|
|
|
|
38
|
$self->stmt_info($block, $info); |
4246
|
11
|
|
|
|
|
48
|
$info->{stmts}{$s} = 1; |
4247
|
|
|
|
|
|
|
} elsif ($cmd eq 'switch') { |
4248
|
7
|
|
|
|
|
15
|
my ($expr, $cases) = @{$self->{strmap}->{$s}}[1..2]; |
|
7
|
|
|
|
|
22
|
|
4249
|
|
|
|
|
|
|
|
4250
|
7
|
|
|
|
|
37
|
$self->stmt_info($expr, $info); |
4251
|
7
|
|
|
|
|
17
|
foreach my $e (@$cases) { |
4252
|
9
|
|
|
|
|
17
|
my $c = $e->[0]; |
4253
|
9
|
|
|
|
|
16
|
my $b = $e->[1]; |
4254
|
9
|
50
|
|
|
|
28
|
if (defined $c) { |
4255
|
9
|
|
|
|
|
21
|
$self->stmt_info($c, $info); |
4256
|
|
|
|
|
|
|
} |
4257
|
9
|
|
|
|
|
27
|
$self->stmt_info($b, $info); |
4258
|
|
|
|
|
|
|
} |
4259
|
7
|
|
|
|
|
31
|
$info->{stmts}{$s} = 1; |
4260
|
|
|
|
|
|
|
} elsif ($cmd eq 'case') { |
4261
|
0
|
|
|
|
|
0
|
my $expr = $self->{strmap}->{$s}->[1]; |
4262
|
0
|
0
|
|
|
|
0
|
if (defined $expr) { |
4263
|
0
|
|
|
|
|
0
|
$self->stmt_info($expr, $info); |
4264
|
|
|
|
|
|
|
} |
4265
|
|
|
|
|
|
|
} elsif ($cmd eq 'try') { |
4266
|
0
|
|
|
|
|
0
|
my ($try, $catches, $finally) = @{$self->{strmap}->{$s}}[1..3]; |
|
0
|
|
|
|
|
0
|
|
4267
|
|
|
|
|
|
|
|
4268
|
0
|
|
|
|
|
0
|
$self->stmt_info($try, $info); |
4269
|
0
|
|
|
|
|
0
|
foreach my $c (@$catches) { |
4270
|
0
|
|
|
|
|
0
|
my $e = $c->[0]; |
4271
|
0
|
|
|
|
|
0
|
my $b = $c->[1]; |
4272
|
0
|
|
|
|
|
0
|
$self->stmt_info($e, $info); |
4273
|
0
|
|
|
|
|
0
|
$self->stmt_info($b, $info); |
4274
|
|
|
|
|
|
|
} |
4275
|
0
|
0
|
|
|
|
0
|
if (defined $finally) { |
4276
|
0
|
|
|
|
|
0
|
$self->stmt_info($finally, $info); |
4277
|
|
|
|
|
|
|
} |
4278
|
0
|
|
|
|
|
0
|
$info->{stmts}{$s} = 1; |
4279
|
|
|
|
|
|
|
} elsif ($cmd eq 'break') { |
4280
|
1
|
|
|
|
|
7
|
$info->{breaks}{$s} = 1; |
4281
|
|
|
|
|
|
|
} elsif ($cmd eq 'continue') { |
4282
|
0
|
|
|
|
|
0
|
$info->{continues}{$s} = 1; |
4283
|
|
|
|
|
|
|
} |
4284
|
|
|
|
|
|
|
} elsif (is_variable($s)) { |
4285
|
750
|
|
|
|
|
1486
|
my ($global) = global_split($s); |
4286
|
750
|
100
|
|
|
|
1465
|
if (defined $global) { |
4287
|
48
|
|
|
|
|
161
|
$info->{globals}{$global} = 1; |
4288
|
|
|
|
|
|
|
} else { |
4289
|
702
|
100
|
|
|
|
1221
|
if (defined $hint) { |
4290
|
469
|
|
|
|
|
1427
|
$info->{vars}{$s} |= ($hint & T_MASK); |
4291
|
469
|
100
|
|
|
|
1187
|
$info->{noassigns}{$s} |= ($hint & T_MASK) unless ($hint & HINT_ASSIGN); |
4292
|
|
|
|
|
|
|
} else { |
4293
|
233
|
|
|
|
|
611
|
$info->{vars}{$s} |= 0; |
4294
|
233
|
|
|
|
|
463
|
$info->{noassigns}{$s} |= 0; |
4295
|
|
|
|
|
|
|
} |
4296
|
|
|
|
|
|
|
} |
4297
|
|
|
|
|
|
|
} |
4298
|
5471
|
|
|
|
|
10157
|
return; |
4299
|
|
|
|
|
|
|
} |
4300
|
|
|
|
|
|
|
|
4301
|
|
|
|
|
|
|
sub translate_stmt { |
4302
|
0
|
|
|
0
|
0
|
|
my ($self, $out, $s, $info) = @_; |
4303
|
|
|
|
|
|
|
|
4304
|
|
|
|
|
|
|
#$self->{log}->('TRANSLATE', "$s") if $self->{log}; |
4305
|
|
|
|
|
|
|
|
4306
|
0
|
0
|
|
|
|
|
if (!defined $s) { |
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
4307
|
0
|
|
|
|
|
|
$self->{warn}->('translate', "undefined symbol"); |
4308
|
0
|
|
|
|
|
|
return; |
4309
|
|
|
|
|
|
|
} elsif ($s =~ /^#null$/) { |
4310
|
0
|
|
|
|
|
|
push(@$out, 'undef'); |
4311
|
|
|
|
|
|
|
} elsif ($s =~ /^#num\d+$/) { |
4312
|
0
|
0
|
|
|
|
|
unless (exists $self->{strmap}->{$s}) { |
4313
|
0
|
|
|
|
|
|
$self->{warn}->('translate', "num $s not found"); |
4314
|
0
|
|
|
|
|
|
return; |
4315
|
|
|
|
|
|
|
} |
4316
|
0
|
|
|
|
|
|
$s = $self->{strmap}->{$s}; |
4317
|
0
|
|
|
|
|
|
push(@$out, $s); |
4318
|
|
|
|
|
|
|
} elsif ($s =~ /^#const\d+$/) { |
4319
|
0
|
0
|
|
|
|
|
unless (exists $self->{strmap}->{$s}) { |
4320
|
0
|
|
|
|
|
|
$self->{warn}->('translate', "bad const $s"); |
4321
|
0
|
|
|
|
|
|
return; |
4322
|
|
|
|
|
|
|
} |
4323
|
0
|
|
|
|
|
|
$s = $self->{strmap}->{$s}; |
4324
|
0
|
0
|
|
|
|
|
unless (is_symbol($s)) { |
4325
|
0
|
|
|
|
|
|
$self->{warn}->('translate', "bad const name $s"); |
4326
|
0
|
|
|
|
|
|
return; |
4327
|
|
|
|
|
|
|
} |
4328
|
0
|
|
|
|
|
|
push(@$out, '$'.$s); # convert to var |
4329
|
|
|
|
|
|
|
} elsif ($s =~ /^#str\d+$/) { |
4330
|
0
|
0
|
|
|
|
|
unless (exists $self->{strmap}->{$s}) { |
4331
|
0
|
|
|
|
|
|
$self->{warn}->('translate', "bad str $s"); |
4332
|
0
|
|
|
|
|
|
return; |
4333
|
|
|
|
|
|
|
} |
4334
|
0
|
|
|
|
|
|
$s = $self->{strmap}->{$s}; |
4335
|
|
|
|
|
|
|
# escape string (keep newlines as newline like php does) |
4336
|
|
|
|
|
|
|
# |
4337
|
0
|
|
|
|
|
|
$s =~ s/\\/\\\\/sg; |
4338
|
0
|
|
|
|
|
|
$s =~ s/'/\\'/sg; |
4339
|
0
|
|
|
|
|
|
$s = '\'' . $s . '\''; |
4340
|
0
|
|
|
|
|
|
push(@$out, $s); |
4341
|
|
|
|
|
|
|
} elsif ($s =~ /^#arr\d+$/) { |
4342
|
0
|
|
|
|
|
|
my $arr = $self->{strmap}{$s}; |
4343
|
0
|
|
|
|
|
|
my $keys = $arr->get_keys(); |
4344
|
0
|
|
|
|
|
|
push(@$out, '{'); |
4345
|
|
|
|
|
|
|
|
4346
|
0
|
|
|
|
|
|
foreach my $k (@$keys) { |
4347
|
0
|
|
|
|
|
|
my $val = $arr->val($k); |
4348
|
0
|
0
|
|
|
|
|
if (is_int_index($k)) { |
4349
|
0
|
|
|
|
|
|
push(@$out, $k); |
4350
|
|
|
|
|
|
|
} else { |
4351
|
0
|
0
|
|
|
|
|
return unless $self->translate_stmt($out, $k, $info); |
4352
|
|
|
|
|
|
|
} |
4353
|
0
|
|
|
|
|
|
push(@$out, '=>'); |
4354
|
0
|
0
|
|
|
|
|
if (defined $val) { |
4355
|
0
|
0
|
|
|
|
|
return unless $self->translate_stmt($out, $val, $info); |
4356
|
|
|
|
|
|
|
} else { |
4357
|
0
|
|
|
|
|
|
push(@$out, 'undef'); |
4358
|
|
|
|
|
|
|
} |
4359
|
0
|
|
|
|
|
|
push(@$out, ','); |
4360
|
|
|
|
|
|
|
} |
4361
|
0
|
0
|
|
|
|
|
if (scalar @$keys > 0) { |
4362
|
0
|
|
|
|
|
|
pop(@$out); |
4363
|
|
|
|
|
|
|
} |
4364
|
0
|
|
|
|
|
|
push(@$out, '}'); |
4365
|
|
|
|
|
|
|
} elsif ($s =~ /^#fun\d+$/) { |
4366
|
0
|
|
|
|
|
|
my ($f, $a, $b, $p) = @{$self->{strmap}->{$s}}; |
|
0
|
|
|
|
|
|
|
4367
|
|
|
|
|
|
|
|
4368
|
0
|
|
|
|
|
|
push(@$out, 'sub'); |
4369
|
0
|
0
|
|
|
|
|
if (defined $f) { |
4370
|
0
|
0
|
|
|
|
|
unless (is_symbol($f)) { |
4371
|
0
|
|
|
|
|
|
$self->{warn}->('translate', "bad func name $s $f not supported"); |
4372
|
0
|
|
|
|
|
|
return; |
4373
|
|
|
|
|
|
|
} |
4374
|
0
|
|
|
|
|
|
$self->{warn}->('translate', "func in func $s $f not supported"); |
4375
|
0
|
|
|
|
|
|
return; |
4376
|
|
|
|
|
|
|
#push(@$out, $f); |
4377
|
|
|
|
|
|
|
} |
4378
|
0
|
|
|
|
|
|
push(@$out, '{'); |
4379
|
0
|
0
|
|
|
|
|
if (scalar @$a > 0) { |
4380
|
0
|
|
|
|
|
|
push(@$out, 'my'); |
4381
|
0
|
|
|
|
|
|
push(@$out, '('); |
4382
|
0
|
|
|
|
|
|
foreach my $k (@$a) { |
4383
|
0
|
0
|
|
|
|
|
return unless $self->translate_stmt($out, $k, $info); |
4384
|
0
|
|
|
|
|
|
push(@$out, ','); |
4385
|
|
|
|
|
|
|
} |
4386
|
0
|
|
|
|
|
|
pop(@$out); |
4387
|
0
|
|
|
|
|
|
push(@$out, ')'); |
4388
|
0
|
|
|
|
|
|
push(@$out, '='); |
4389
|
0
|
|
|
|
|
|
push(@$out, '@_'); |
4390
|
0
|
|
|
|
|
|
push(@$out, ';'); |
4391
|
|
|
|
|
|
|
} |
4392
|
|
|
|
|
|
|
# TODO: don't pass local func info from outside |
4393
|
|
|
|
|
|
|
# |
4394
|
0
|
0
|
|
|
|
|
if (keys %{$info->{locals}} > 0) { |
|
0
|
|
|
|
|
|
|
4395
|
0
|
|
|
|
|
|
push(@$out, 'my'); |
4396
|
0
|
|
|
|
|
|
push(@$out, '('); |
4397
|
0
|
|
|
|
|
|
foreach my $k (keys %{$info->{locals}}) { |
|
0
|
|
|
|
|
|
|
4398
|
0
|
0
|
|
|
|
|
return unless $self->translate_stmt($out, $k, $info); |
4399
|
0
|
|
|
|
|
|
push(@$out, ','); |
4400
|
|
|
|
|
|
|
} |
4401
|
0
|
|
|
|
|
|
pop(@$out); |
4402
|
0
|
|
|
|
|
|
push(@$out, ')'); |
4403
|
0
|
|
|
|
|
|
push(@$out, ';'); |
4404
|
|
|
|
|
|
|
} |
4405
|
|
|
|
|
|
|
#$self->translate_stmt($out, $b, $info); |
4406
|
|
|
|
|
|
|
|
4407
|
0
|
|
|
|
|
|
my ($type, $c) = @{$self->{strmap}->{$b}}; |
|
0
|
|
|
|
|
|
|
4408
|
0
|
|
|
|
|
|
foreach my $k (@$c) { |
4409
|
0
|
0
|
|
|
|
|
return unless $self->translate_stmt($out, $k, $info); |
4410
|
|
|
|
|
|
|
#if ($out->[-1] ne '}') { |
4411
|
0
|
|
|
|
|
|
push(@$out, ';'); |
4412
|
|
|
|
|
|
|
#} |
4413
|
|
|
|
|
|
|
} |
4414
|
0
|
|
|
|
|
|
push(@$out, '}'); |
4415
|
|
|
|
|
|
|
} elsif ($s =~ /^#call\d+$/) { |
4416
|
0
|
|
|
|
|
|
my ($f, $a) = @{$self->{strmap}->{$s}}; |
|
0
|
|
|
|
|
|
|
4417
|
|
|
|
|
|
|
|
4418
|
0
|
0
|
|
|
|
|
unless (is_symbol($f)) { |
4419
|
0
|
|
|
|
|
|
$self->{warn}->('translate', "call name $s $f not supported"); |
4420
|
0
|
|
|
|
|
|
return; |
4421
|
|
|
|
|
|
|
} |
4422
|
0
|
0
|
0
|
|
|
|
if (($f eq 'strlen') && (scalar @$a == 1)) { |
|
|
0
|
0
|
|
|
|
|
|
|
0
|
0
|
|
|
|
|
|
|
0
|
0
|
|
|
|
|
|
|
0
|
0
|
|
|
|
|
|
|
0
|
0
|
|
|
|
|
|
|
0
|
0
|
|
|
|
|
4423
|
0
|
|
|
|
|
|
push(@$out, 'length'); |
4424
|
|
|
|
|
|
|
} elsif (($f eq 'isset') && (scalar @$a == 1)) { |
4425
|
0
|
|
|
|
|
|
push(@$out, 'defined'); |
4426
|
|
|
|
|
|
|
} elsif (($f eq 'range') && (scalar @$a == 2)) { |
4427
|
0
|
|
|
|
|
|
push(@$out, '['); |
4428
|
0
|
0
|
|
|
|
|
return unless $self->translate_stmt($out, $a->[0], $info); |
4429
|
0
|
|
|
|
|
|
push(@$out, '..'); |
4430
|
0
|
0
|
|
|
|
|
return unless $self->translate_stmt($out, $a->[1], $info); |
4431
|
0
|
|
|
|
|
|
push(@$out, ']'); |
4432
|
0
|
|
|
|
|
|
return 1; |
4433
|
|
|
|
|
|
|
} elsif (($f eq 'base64_encode') && (scalar @$a == 1)) { |
4434
|
|
|
|
|
|
|
# encode_base64($s,'') |
4435
|
0
|
|
|
|
|
|
push(@$out, 'encode_base64'); |
4436
|
0
|
|
|
|
|
|
push(@$out, '('); |
4437
|
0
|
0
|
|
|
|
|
return unless $self->translate_stmt($out, $a->[0], $info); |
4438
|
0
|
|
|
|
|
|
push(@$out, ','); |
4439
|
0
|
|
|
|
|
|
push(@$out, '\'\''); |
4440
|
0
|
|
|
|
|
|
push(@$out, ')'); |
4441
|
0
|
|
|
|
|
|
return 1; |
4442
|
|
|
|
|
|
|
} elsif (($f eq 'base64_decode') && (scalar @$a == 1)) { |
4443
|
|
|
|
|
|
|
# decode_base64($s) |
4444
|
0
|
|
|
|
|
|
push(@$out, 'decode_base64'); |
4445
|
0
|
|
|
|
|
|
push(@$out, '('); |
4446
|
0
|
0
|
|
|
|
|
return unless $self->translate_stmt($out, $a->[0], $info); |
4447
|
0
|
|
|
|
|
|
push(@$out, ')'); |
4448
|
0
|
|
|
|
|
|
return 1; |
4449
|
|
|
|
|
|
|
} elsif (($f eq 'gzinflate') && (scalar @$a == 1)) { |
4450
|
|
|
|
|
|
|
# (Compress::Zlib::inflateInit(-WindowBits => -(MAX_WBITS))->inflate($s))[0]) |
4451
|
0
|
|
|
|
|
|
push(@$out, '('); |
4452
|
0
|
|
|
|
|
|
push(@$out, 'Compress::Zlib::inflateInit(-WindowBits => -(MAX_WBITS))->inflate'); |
4453
|
0
|
|
|
|
|
|
push(@$out, '('); |
4454
|
0
|
0
|
|
|
|
|
return unless $self->translate_stmt($out, $a->[0], $info); |
4455
|
0
|
|
|
|
|
|
push(@$out, ')'); |
4456
|
0
|
|
|
|
|
|
push(@$out, ')'); |
4457
|
0
|
|
|
|
|
|
push(@$out, '['); |
4458
|
0
|
|
|
|
|
|
push(@$out, '0'); |
4459
|
0
|
|
|
|
|
|
push(@$out, ']'); |
4460
|
0
|
|
|
|
|
|
return 1; |
4461
|
|
|
|
|
|
|
} elsif (($f =~ /^(chr|ord)$/) && (scalar @$a == 1)) { |
4462
|
0
|
|
|
|
|
|
push(@$out, $f); |
4463
|
|
|
|
|
|
|
} else { |
4464
|
0
|
|
|
|
|
|
$self->{warn}->('translate', "call $s $f not supported"); |
4465
|
0
|
|
|
|
|
|
return; |
4466
|
|
|
|
|
|
|
} |
4467
|
0
|
|
|
|
|
|
push(@$out, '('); |
4468
|
0
|
|
|
|
|
|
foreach my $k (@$a) { |
4469
|
0
|
0
|
|
|
|
|
return unless $self->translate_stmt($out, $k, $info); |
4470
|
0
|
|
|
|
|
|
push(@$out, ','); |
4471
|
|
|
|
|
|
|
} |
4472
|
0
|
0
|
|
|
|
|
if (scalar @$a > 0) { |
4473
|
0
|
|
|
|
|
|
pop(@$out); |
4474
|
|
|
|
|
|
|
} |
4475
|
0
|
|
|
|
|
|
push(@$out, ')'); |
4476
|
|
|
|
|
|
|
} elsif ($s =~ /^#elem\d+$/) { |
4477
|
0
|
|
|
|
|
|
my ($v, $i) = @{$self->{strmap}->{$s}}; |
|
0
|
|
|
|
|
|
|
4478
|
|
|
|
|
|
|
|
4479
|
0
|
0
|
0
|
|
|
|
if (exists $info->{vars}{$v} && (($info->{vars}{$v} & T_MASK) == T_STR)) { |
4480
|
0
|
|
|
|
|
|
push(@$out, 'substr'); |
4481
|
0
|
|
|
|
|
|
push(@$out, '('); |
4482
|
0
|
0
|
|
|
|
|
return unless $self->translate_stmt($out, $v, $info); |
4483
|
0
|
|
|
|
|
|
push(@$out, ','); |
4484
|
0
|
0
|
|
|
|
|
if (defined $i) { |
4485
|
0
|
0
|
|
|
|
|
return unless $self->translate_stmt($out, $i, $info); |
4486
|
0
|
|
|
|
|
|
push(@$out, ','); |
4487
|
0
|
|
|
|
|
|
push(@$out, '1'); |
4488
|
|
|
|
|
|
|
} else { |
4489
|
0
|
|
|
|
|
|
push(@$out, '-1'); |
4490
|
|
|
|
|
|
|
} |
4491
|
0
|
|
|
|
|
|
push(@$out, ')'); |
4492
|
0
|
|
|
|
|
|
return 1; |
4493
|
|
|
|
|
|
|
} |
4494
|
0
|
0
|
|
|
|
|
return unless $self->translate_stmt($out, $v, $info); |
4495
|
0
|
|
|
|
|
|
push(@$out, '->'); |
4496
|
0
|
0
|
0
|
|
|
|
if (exists $info->{vars}{$v} && (($info->{vars}{$v} & T_MASK) == T_ARRAY)) { |
4497
|
0
|
|
|
|
|
|
push(@$out, '['); |
4498
|
0
|
0
|
|
|
|
|
if (defined $i) { |
4499
|
0
|
0
|
|
|
|
|
return unless $self->translate_stmt($out, $i, $info); |
4500
|
|
|
|
|
|
|
} |
4501
|
0
|
|
|
|
|
|
push(@$out, ']'); |
4502
|
|
|
|
|
|
|
} else { |
4503
|
0
|
|
|
|
|
|
push(@$out, '{'); |
4504
|
0
|
0
|
|
|
|
|
if (defined $i) { |
4505
|
0
|
0
|
|
|
|
|
return unless $self->translate_stmt($out, $i, $info); |
4506
|
|
|
|
|
|
|
} |
4507
|
0
|
|
|
|
|
|
push(@$out, '}'); |
4508
|
|
|
|
|
|
|
} |
4509
|
|
|
|
|
|
|
} elsif ($s =~ /^#expr\d+$/) { |
4510
|
0
|
|
|
|
|
|
my ($op, $v1, $v2) = @{$self->{strmap}->{$s}}; |
|
0
|
|
|
|
|
|
|
4511
|
|
|
|
|
|
|
|
4512
|
0
|
0
|
|
|
|
|
if (defined $v1) { |
4513
|
0
|
0
|
0
|
|
|
|
if ($v1 =~ /^#expr\d+$/) { |
|
|
0
|
0
|
|
|
|
|
4514
|
0
|
|
|
|
|
|
my $vop = $self->{strmap}->{$v1}->[0]; |
4515
|
0
|
0
|
0
|
|
|
|
if (($op ne '=') && ($op ne $vop)) { |
4516
|
0
|
|
|
|
|
|
push(@$out, '('); |
4517
|
|
|
|
|
|
|
} |
4518
|
0
|
0
|
|
|
|
|
return unless $self->translate_stmt($out, $v1, $info); |
4519
|
0
|
0
|
0
|
|
|
|
if (($op ne '=') && ($op ne $vop)) { |
4520
|
0
|
|
|
|
|
|
push(@$out, ')'); |
4521
|
|
|
|
|
|
|
} |
4522
|
|
|
|
|
|
|
} elsif (($v1 =~ /^#elem\d+$/) && defined $v2 && ($op eq '=')) { |
4523
|
0
|
|
|
|
|
|
my $v = $self->{strmap}->{$v1}->[0]; |
4524
|
0
|
|
|
|
|
|
my $i = $self->{strmap}->{$v1}->[1]; |
4525
|
0
|
0
|
0
|
|
|
|
unless (defined $i && is_strict_variable($v)) { |
4526
|
|
|
|
|
|
|
# try to emulate php-arrays with perl-maps |
4527
|
|
|
|
|
|
|
# see: https://www.php.net/manual/en/language.types.array.php |
4528
|
|
|
|
|
|
|
# - if no key is specified, the maximum of the existing int |
4529
|
|
|
|
|
|
|
# indices is taken, and the new key will be that maximum |
4530
|
|
|
|
|
|
|
# value plus 1 (but at least 0). |
4531
|
|
|
|
|
|
|
# - If no int indices exist yet, the key will be 0 (zero). |
4532
|
|
|
|
|
|
|
# |
4533
|
|
|
|
|
|
|
# TODO: Note that the maximum integer key used for this |
4534
|
|
|
|
|
|
|
# need not currently exist in the array. It need only |
4535
|
|
|
|
|
|
|
# have existed in the array at some time since the |
4536
|
|
|
|
|
|
|
# last time the array was re-indexed. |
4537
|
|
|
|
|
|
|
# |
4538
|
0
|
0
|
0
|
|
|
|
if (exists $info->{vars}{$v} && (($info->{vars}{$v} && T_MASK) == T_ARRAY)) { |
|
|
|
0
|
|
|
|
|
4539
|
|
|
|
|
|
|
# for 'array' convert '$x[] = $v' to: |
4540
|
|
|
|
|
|
|
# push(@{$x}, $v) |
4541
|
|
|
|
|
|
|
# |
4542
|
0
|
|
|
|
|
|
push(@$out, 'push'); |
4543
|
0
|
|
|
|
|
|
push(@$out, '('); |
4544
|
0
|
|
|
|
|
|
push(@$out, '@'); |
4545
|
0
|
|
|
|
|
|
push(@$out, '{'); |
4546
|
0
|
0
|
|
|
|
|
return unless $self->translate_stmt($out, $v, $info); |
4547
|
0
|
|
|
|
|
|
push(@$out, '}'); |
4548
|
0
|
|
|
|
|
|
push(@$out, ','); |
4549
|
0
|
0
|
|
|
|
|
return unless $self->translate_stmt($out, $v2, $info); |
4550
|
0
|
|
|
|
|
|
push(@$out, ')'); |
4551
|
0
|
|
|
|
|
|
return 1; |
4552
|
|
|
|
|
|
|
} else { |
4553
|
|
|
|
|
|
|
# for 'map' convert '$x[] = $v' to: |
4554
|
|
|
|
|
|
|
# $x->{(max keys %$x)[-1] + 1} = $v |
4555
|
|
|
|
|
|
|
# (or: $x->{keys %$x ? (sort keys %$x)[-1] + 1 : 0} = $v) |
4556
|
|
|
|
|
|
|
# |
4557
|
0
|
0
|
|
|
|
|
return unless $self->translate_stmt($out, $v, $info); |
4558
|
0
|
|
|
|
|
|
my $vx = $out->[-1]; |
4559
|
0
|
|
|
|
|
|
push(@$out, '->'); |
4560
|
0
|
|
|
|
|
|
push(@$out, '{'); |
4561
|
0
|
|
|
|
|
|
push(@$out, '('); |
4562
|
0
|
|
|
|
|
|
push(@$out, 'max'); |
4563
|
0
|
|
|
|
|
|
push(@$out, 'keys'); |
4564
|
0
|
|
|
|
|
|
push(@$out, '%'.$vx); |
4565
|
0
|
|
|
|
|
|
push(@$out, ')'); |
4566
|
0
|
|
|
|
|
|
push(@$out, '['); |
4567
|
0
|
|
|
|
|
|
push(@$out, '-1'); |
4568
|
0
|
|
|
|
|
|
push(@$out, ']'); |
4569
|
0
|
|
|
|
|
|
push(@$out, '+'); |
4570
|
0
|
|
|
|
|
|
push(@$out, '1'); |
4571
|
0
|
|
|
|
|
|
push(@$out, '}'); |
4572
|
|
|
|
|
|
|
} |
4573
|
|
|
|
|
|
|
} else { |
4574
|
0
|
0
|
|
|
|
|
return unless $self->translate_stmt($out, $v1, $info); |
4575
|
|
|
|
|
|
|
} |
4576
|
|
|
|
|
|
|
} else { |
4577
|
0
|
0
|
|
|
|
|
return unless $self->translate_stmt($out, $v1, $info); |
4578
|
|
|
|
|
|
|
} |
4579
|
|
|
|
|
|
|
} |
4580
|
0
|
0
|
|
|
|
|
if ($op eq '==') { |
|
|
0
|
|
|
|
|
|
4581
|
0
|
|
|
|
|
|
push(@$out, 'eq'); |
4582
|
|
|
|
|
|
|
} elsif ($op eq '!=') { |
4583
|
0
|
|
|
|
|
|
push(@$out, 'ne'); |
4584
|
|
|
|
|
|
|
} else { |
4585
|
0
|
|
|
|
|
|
push(@$out, $op); |
4586
|
|
|
|
|
|
|
} |
4587
|
0
|
0
|
|
|
|
|
if (defined $v2) { |
4588
|
0
|
0
|
|
|
|
|
if ($op eq '$') { |
4589
|
0
|
|
|
|
|
|
push(@$out, '{'); |
4590
|
|
|
|
|
|
|
} |
4591
|
0
|
0
|
|
|
|
|
if ($v2 =~ /^#expr\d+$/) { |
4592
|
0
|
|
|
|
|
|
my $vop = $self->{strmap}->{$v2}->[0]; |
4593
|
0
|
0
|
0
|
|
|
|
if (($op ne '?') && ($op ne '=') && ($op ne $vop)) { |
|
|
|
0
|
|
|
|
|
4594
|
0
|
|
|
|
|
|
push(@$out, '('); |
4595
|
|
|
|
|
|
|
} |
4596
|
0
|
0
|
|
|
|
|
return unless $self->translate_stmt($out, $v2, $info); |
4597
|
0
|
0
|
0
|
|
|
|
if (($op ne '?') && ($op ne '=') && ($op ne $vop)) { |
|
|
|
0
|
|
|
|
|
4598
|
0
|
|
|
|
|
|
push(@$out, ')'); |
4599
|
|
|
|
|
|
|
} |
4600
|
|
|
|
|
|
|
} else { |
4601
|
0
|
0
|
|
|
|
|
return unless $self->translate_stmt($out, $v2, $info); |
4602
|
|
|
|
|
|
|
} |
4603
|
0
|
0
|
|
|
|
|
if ($op eq '$') { |
4604
|
0
|
|
|
|
|
|
push(@$out, '}'); |
4605
|
|
|
|
|
|
|
} |
4606
|
|
|
|
|
|
|
} |
4607
|
|
|
|
|
|
|
} elsif ($s =~ /^#pfx\d+$/) { |
4608
|
0
|
0
|
|
|
|
|
unless (exists $self->{strmap}->{$s}) { |
4609
|
0
|
|
|
|
|
|
$self->{warn}->('translate', "pfx $s not found"); |
4610
|
0
|
|
|
|
|
|
return; |
4611
|
|
|
|
|
|
|
} |
4612
|
0
|
|
|
|
|
|
my $pfx = $self->{strmap}->{$s}; |
4613
|
0
|
0
|
|
|
|
|
if (exists $pfx->{global}) { |
4614
|
0
|
|
|
|
|
|
my $s = join(' ', sort keys %$pfx); |
4615
|
0
|
|
|
|
|
|
$self->{warn}->('translate', "global pfx $s"); |
4616
|
0
|
|
|
|
|
|
return; |
4617
|
|
|
|
|
|
|
} |
4618
|
0
|
|
|
|
|
|
push(@$out, 'my'); |
4619
|
|
|
|
|
|
|
} elsif ($s =~ /^#obj\d+$/) { |
4620
|
0
|
|
|
|
|
|
my ($o, $m) = @{$self->{strmap}->{$s}}; |
|
0
|
|
|
|
|
|
|
4621
|
|
|
|
|
|
|
|
4622
|
0
|
|
|
|
|
|
$self->{warn}->('translate', "obj $s $o->$m not supported"); |
4623
|
0
|
|
|
|
|
|
return; |
4624
|
|
|
|
|
|
|
} elsif ($s =~ /^#scope\d+$/) { |
4625
|
0
|
|
|
|
|
|
my ($c, $e) = @{$self->{strmap}->{$s}}; |
|
0
|
|
|
|
|
|
|
4626
|
|
|
|
|
|
|
|
4627
|
0
|
|
|
|
|
|
$self->{warn}->('translate', "scope $s $c::$e not supported"); |
4628
|
0
|
|
|
|
|
|
return; |
4629
|
|
|
|
|
|
|
} elsif ($s =~ /^#ns\d+$/) { |
4630
|
0
|
|
|
|
|
|
my ($n, $e) = @{$self->{strmap}->{$s}}; |
|
0
|
|
|
|
|
|
|
4631
|
|
|
|
|
|
|
|
4632
|
0
|
|
|
|
|
|
$self->{warn}->('translate', "namespace $s $n::$e not supported"); |
4633
|
0
|
|
|
|
|
|
return; |
4634
|
|
|
|
|
|
|
} elsif ($s =~ /^#inst\d+$/) { |
4635
|
0
|
|
|
|
|
|
my ($c, $f, $i) = @{$self->{strmap}->{$s}}; |
|
0
|
|
|
|
|
|
|
4636
|
|
|
|
|
|
|
|
4637
|
0
|
|
|
|
|
|
$self->{warn}->('translate', "new inst $s $f not supported"); |
4638
|
0
|
|
|
|
|
|
return; |
4639
|
|
|
|
|
|
|
} elsif ($s =~ /^#ref\d+$/) { |
4640
|
0
|
|
|
|
|
|
my $v = $self->{strmap}->{$s}->[0]; |
4641
|
0
|
|
|
|
|
|
push(@$out, '\\'); |
4642
|
0
|
0
|
|
|
|
|
return unless $self->translate_stmt($out, $v, $info); |
4643
|
|
|
|
|
|
|
} elsif ($s =~ /^#class\d+$/) { |
4644
|
0
|
|
|
|
|
|
my ($c, $b, $p) = @{$self->{strmap}->{$s}}; |
|
0
|
|
|
|
|
|
|
4645
|
|
|
|
|
|
|
|
4646
|
0
|
|
|
|
|
|
$self->{warn}->('translate', "class $s $c not supported"); |
4647
|
0
|
|
|
|
|
|
return; |
4648
|
|
|
|
|
|
|
} elsif ($s =~ /^#trait\d+$/) { |
4649
|
0
|
|
|
|
|
|
my ($t, $b) = @{$self->{strmap}->{$s}}; |
|
0
|
|
|
|
|
|
|
4650
|
|
|
|
|
|
|
|
4651
|
0
|
|
|
|
|
|
$self->{warn}->('translate', "trait $s $t not supported"); |
4652
|
0
|
|
|
|
|
|
return; |
4653
|
|
|
|
|
|
|
} elsif ($s =~ /^#fh\d+$/) { |
4654
|
0
|
|
|
|
|
|
my $f = $self->{strmap}->{$s}{name}; |
4655
|
0
|
|
|
|
|
|
my $m = $self->{strmap}->{$s}{mode}; |
4656
|
0
|
|
|
|
|
|
my $p = $self->{strmap}->{$s}{pos}; |
4657
|
|
|
|
|
|
|
|
4658
|
0
|
|
|
|
|
|
$self->{warn}->('translate', "fh $s $f not supported"); |
4659
|
0
|
|
|
|
|
|
return; |
4660
|
|
|
|
|
|
|
} elsif ($s =~ /^#blk\d+$/) { |
4661
|
0
|
|
|
|
|
|
my ($type, $a) = @{$self->{strmap}->{$s}}; |
|
0
|
|
|
|
|
|
|
4662
|
|
|
|
|
|
|
|
4663
|
0
|
0
|
|
|
|
|
if ($type eq 'expr') { |
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
4664
|
0
|
|
|
|
|
|
foreach my $k (@$a) { |
4665
|
0
|
0
|
|
|
|
|
return unless $self->translate_stmt($out, $k, $info); |
4666
|
0
|
|
|
|
|
|
push(@$out, ','); |
4667
|
|
|
|
|
|
|
} |
4668
|
0
|
0
|
|
|
|
|
if (scalar @$a > 0) { |
4669
|
0
|
|
|
|
|
|
pop(@$out); |
4670
|
|
|
|
|
|
|
} |
4671
|
|
|
|
|
|
|
} elsif ($type eq 'flat') { |
4672
|
0
|
|
|
|
|
|
foreach my $k (@$a) { |
4673
|
0
|
0
|
|
|
|
|
return unless $self->translate_stmt($out, $k, $info); |
4674
|
0
|
0
|
|
|
|
|
if ($k =~ /^#pfx\d+$/) { |
4675
|
0
|
|
|
|
|
|
next; # avoid ; |
4676
|
|
|
|
|
|
|
} |
4677
|
0
|
0
|
|
|
|
|
if ($out->[-1] ne '}') { |
4678
|
0
|
|
|
|
|
|
push(@$out, ';'); |
4679
|
|
|
|
|
|
|
} |
4680
|
|
|
|
|
|
|
} |
4681
|
0
|
0
|
0
|
|
|
|
if ((scalar @$a > 0) && ($out->[-1] eq ';')) { |
4682
|
0
|
|
|
|
|
|
pop(@$out); |
4683
|
|
|
|
|
|
|
} |
4684
|
|
|
|
|
|
|
} elsif ($type eq 'case') { |
4685
|
0
|
|
|
|
|
|
foreach my $k (@$a) { |
4686
|
0
|
0
|
|
|
|
|
return unless $self->translate_stmt($out, $k, $info); |
4687
|
0
|
|
|
|
|
|
push(@$out, ';'); |
4688
|
|
|
|
|
|
|
} |
4689
|
0
|
0
|
|
|
|
|
if (scalar @$a > 0) { |
4690
|
0
|
|
|
|
|
|
pop(@$out); |
4691
|
|
|
|
|
|
|
} |
4692
|
|
|
|
|
|
|
} elsif ($type eq 'brace') { |
4693
|
0
|
0
|
|
|
|
|
if (scalar @$a == 1) { |
4694
|
0
|
0
|
|
|
|
|
return unless $self->translate_stmt($out, $a->[0], $info); |
4695
|
|
|
|
|
|
|
} else { |
4696
|
0
|
|
|
|
|
|
push(@$out, '('); |
4697
|
0
|
|
|
|
|
|
foreach my $k (@$a) { |
4698
|
0
|
0
|
|
|
|
|
return unless $self->translate_stmt($out, $k, $info); |
4699
|
0
|
0
|
|
|
|
|
if ($out->[-1] ne ')') { |
4700
|
0
|
|
|
|
|
|
push(@$out, ';'); |
4701
|
|
|
|
|
|
|
} |
4702
|
|
|
|
|
|
|
} |
4703
|
0
|
0
|
0
|
|
|
|
if ((scalar @$a > 0) && ($out->[-1] eq ';')) { |
4704
|
0
|
|
|
|
|
|
pop(@$out); |
4705
|
|
|
|
|
|
|
} |
4706
|
0
|
|
|
|
|
|
push(@$out, ')'); |
4707
|
|
|
|
|
|
|
} |
4708
|
|
|
|
|
|
|
} else { |
4709
|
0
|
|
|
|
|
|
push(@$out, '{'); |
4710
|
0
|
|
|
|
|
|
foreach my $k (@$a) { |
4711
|
0
|
0
|
|
|
|
|
return unless $self->translate_stmt($out, $k, $info); |
4712
|
0
|
0
|
|
|
|
|
if ($k =~ /^#pfx\d+$/) { |
4713
|
0
|
|
|
|
|
|
next; # avoid ; |
4714
|
|
|
|
|
|
|
} |
4715
|
0
|
0
|
|
|
|
|
if ($out->[-1] ne '}') { |
4716
|
0
|
|
|
|
|
|
push(@$out, ';'); |
4717
|
|
|
|
|
|
|
} |
4718
|
|
|
|
|
|
|
} |
4719
|
0
|
0
|
0
|
|
|
|
if ((scalar @$a > 0) && ($out->[-1] eq ';')) { |
4720
|
0
|
|
|
|
|
|
pop(@$out); |
4721
|
|
|
|
|
|
|
} |
4722
|
0
|
|
|
|
|
|
push(@$out, '}'); |
4723
|
|
|
|
|
|
|
} |
4724
|
|
|
|
|
|
|
} elsif ($s =~ /^#stmt\d+$/) { |
4725
|
0
|
|
|
|
|
|
my $cmd = $self->{strmap}->{$s}->[0]; |
4726
|
0
|
0
|
|
|
|
|
if ($cmd eq 'echo') { |
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
4727
|
0
|
|
|
|
|
|
my $a = $self->{strmap}->{$s}->[1]; |
4728
|
0
|
|
|
|
|
|
push(@$out, 'print'); |
4729
|
0
|
|
|
|
|
|
foreach my $k (@$a) { |
4730
|
0
|
0
|
|
|
|
|
return unless $self->translate_stmt($out, $k, $info); |
4731
|
0
|
|
|
|
|
|
push(@$out, ','); |
4732
|
|
|
|
|
|
|
} |
4733
|
0
|
0
|
|
|
|
|
if (scalar @$a > 0) { |
4734
|
0
|
|
|
|
|
|
pop(@$out); |
4735
|
|
|
|
|
|
|
} |
4736
|
|
|
|
|
|
|
} elsif ($cmd eq 'print') { |
4737
|
0
|
|
|
|
|
|
my $arg = $self->{strmap}->{$s}->[1]; |
4738
|
0
|
|
|
|
|
|
push(@$out, $cmd); |
4739
|
0
|
0
|
|
|
|
|
return unless $self->translate_stmt($out, $arg, $info); |
4740
|
|
|
|
|
|
|
} elsif ($cmd eq 'namespace') { |
4741
|
0
|
|
|
|
|
|
my ($a, $block) = @{$self->{strmap}->{$s}}[1..2]; |
|
0
|
|
|
|
|
|
|
4742
|
0
|
|
|
|
|
|
$self->{warn}->('translate', "namespace $s $a not supported"); |
4743
|
0
|
|
|
|
|
|
return; |
4744
|
|
|
|
|
|
|
} elsif ($cmd =~ /^(include|include_once|require|require_once)$/) { |
4745
|
0
|
|
|
|
|
|
my $arg = $self->{strmap}->{$s}->[1]; |
4746
|
0
|
|
|
|
|
|
push(@$out, $cmd); |
4747
|
0
|
0
|
|
|
|
|
return unless $self->translate_stmt($out, $arg, $info); |
4748
|
|
|
|
|
|
|
} elsif ($cmd eq 'use') { |
4749
|
0
|
|
|
|
|
|
my $a = $self->{strmap}->{$s}->[1]; |
4750
|
0
|
|
|
|
|
|
$self->{warn}->('translate', "use $s not supported"); |
4751
|
0
|
|
|
|
|
|
return; |
4752
|
|
|
|
|
|
|
} elsif ($cmd eq 'global') { |
4753
|
0
|
|
|
|
|
|
my $a = $self->{strmap}->{$s}->[1]; |
4754
|
0
|
|
|
|
|
|
$self->{warn}->('translate', "global $s not supported"); |
4755
|
0
|
|
|
|
|
|
return; |
4756
|
|
|
|
|
|
|
} elsif ($cmd eq 'static') { |
4757
|
0
|
|
|
|
|
|
my $a = $self->{strmap}->{$s}->[1]; |
4758
|
0
|
|
|
|
|
|
$self->{warn}->('translate', "static $s not supported"); |
4759
|
0
|
|
|
|
|
|
return; |
4760
|
|
|
|
|
|
|
} elsif ($cmd eq 'const') { |
4761
|
0
|
|
|
|
|
|
my $a = $self->{strmap}->{$s}->[1]; |
4762
|
0
|
|
|
|
|
|
$self->{warn}->('translate', "const $s not supported"); |
4763
|
0
|
|
|
|
|
|
return; |
4764
|
|
|
|
|
|
|
} elsif ($cmd eq 'unset') { |
4765
|
0
|
|
|
|
|
|
my $a = $self->{strmap}->{$s}->[1]; |
4766
|
0
|
|
|
|
|
|
$self->{warn}->('translate', "unset $s not supported"); |
4767
|
0
|
|
|
|
|
|
return; |
4768
|
|
|
|
|
|
|
} elsif ($cmd eq 'return') { |
4769
|
0
|
|
|
|
|
|
my $a = $self->{strmap}->{$s}->[1]; |
4770
|
0
|
|
|
|
|
|
push(@$out, $cmd); |
4771
|
0
|
0
|
|
|
|
|
return unless $self->translate_stmt($out, $a, $info); |
4772
|
|
|
|
|
|
|
} elsif ($cmd eq 'goto') { |
4773
|
0
|
|
|
|
|
|
my $a = $self->{strmap}->{$s}->[1]; |
4774
|
0
|
|
|
|
|
|
$self->{warn}->('translate', "goto $s not supported"); |
4775
|
0
|
|
|
|
|
|
return; |
4776
|
|
|
|
|
|
|
} elsif ($cmd eq 'label') { |
4777
|
0
|
|
|
|
|
|
my $a = $self->{strmap}->{$s}->[1]; |
4778
|
0
|
|
|
|
|
|
$self->{warn}->('translate', "label $s not supported"); |
4779
|
0
|
|
|
|
|
|
return; |
4780
|
|
|
|
|
|
|
} elsif ($cmd eq 'if') { |
4781
|
0
|
|
|
|
|
|
my ($cond, $then, $else) = @{$self->{strmap}->{$s}}[1..3]; |
|
0
|
|
|
|
|
|
|
4782
|
|
|
|
|
|
|
|
4783
|
0
|
|
|
|
|
|
push(@$out, $cmd); |
4784
|
0
|
|
|
|
|
|
push(@$out, '('); |
4785
|
0
|
0
|
|
|
|
|
return unless $self->translate_stmt($out, $cond, $info); |
4786
|
0
|
|
|
|
|
|
push(@$out, ')'); |
4787
|
0
|
0
|
|
|
|
|
return unless $self->translate_stmt($out, $then, $info); |
4788
|
0
|
0
|
|
|
|
|
if (defined $else) { |
4789
|
0
|
|
|
|
|
|
push(@$out, 'else'); |
4790
|
0
|
0
|
|
|
|
|
return unless $self->translate_stmt($out, $else, $info); |
4791
|
|
|
|
|
|
|
} |
4792
|
|
|
|
|
|
|
} elsif ($cmd eq 'while') { |
4793
|
0
|
|
|
|
|
|
my ($cond, $block) = @{$self->{strmap}->{$s}}[1..2]; |
|
0
|
|
|
|
|
|
|
4794
|
|
|
|
|
|
|
|
4795
|
0
|
|
|
|
|
|
push(@$out, $cmd); |
4796
|
0
|
|
|
|
|
|
push(@$out, '('); |
4797
|
0
|
0
|
|
|
|
|
return unless $self->translate_stmt($out, $cond, $info); |
4798
|
0
|
|
|
|
|
|
push(@$out, ')'); |
4799
|
0
|
0
|
|
|
|
|
return unless $self->translate_stmt($out, $block, $info); |
4800
|
|
|
|
|
|
|
} elsif ($cmd eq 'do') { |
4801
|
0
|
|
|
|
|
|
my ($cond, $block) = @{$self->{strmap}->{$s}}[1..2]; |
|
0
|
|
|
|
|
|
|
4802
|
|
|
|
|
|
|
|
4803
|
0
|
|
|
|
|
|
push(@$out, $cmd); |
4804
|
0
|
0
|
|
|
|
|
return unless $self->translate_stmt($out, $block, $info); |
4805
|
0
|
|
|
|
|
|
push(@$out, 'while'); |
4806
|
0
|
|
|
|
|
|
push(@$out, '('); |
4807
|
0
|
0
|
|
|
|
|
return unless $self->translate_stmt($out, $cond, $info); |
4808
|
0
|
|
|
|
|
|
push(@$out, ')'); |
4809
|
|
|
|
|
|
|
} elsif ($cmd eq 'for') { |
4810
|
0
|
|
|
|
|
|
my ($pre, $cond, $post, $block) = @{$self->{strmap}->{$s}}[1..4]; |
|
0
|
|
|
|
|
|
|
4811
|
|
|
|
|
|
|
|
4812
|
0
|
|
|
|
|
|
push(@$out, $cmd); |
4813
|
0
|
|
|
|
|
|
push(@$out, '('); |
4814
|
|
|
|
|
|
|
#push(@$out, 'my'); # set as local -> persists after for-loop |
4815
|
0
|
0
|
|
|
|
|
return unless $self->translate_stmt($out, $pre, $info); |
4816
|
0
|
|
|
|
|
|
push(@$out, ';'); |
4817
|
0
|
0
|
|
|
|
|
return unless $self->translate_stmt($out, $cond, $info); |
4818
|
0
|
|
|
|
|
|
push(@$out, ';'); |
4819
|
0
|
0
|
|
|
|
|
return unless $self->translate_stmt($out, $post, $info); |
4820
|
0
|
|
|
|
|
|
push(@$out, ')'); |
4821
|
0
|
0
|
|
|
|
|
return unless $self->translate_stmt($out, $block, $info); |
4822
|
|
|
|
|
|
|
} elsif ($cmd eq 'foreach') { |
4823
|
0
|
|
|
|
|
|
my ($expr, $key, $value, $block) = @{$self->{strmap}->{$s}}[1..4]; |
|
0
|
|
|
|
|
|
|
4824
|
|
|
|
|
|
|
|
4825
|
0
|
0
|
|
|
|
|
if (defined $key) { |
4826
|
|
|
|
|
|
|
# convert 'foreach ($x as $k => $v)' to |
4827
|
|
|
|
|
|
|
# foreach my $k ( sort { $a <=> $b } keys %$x ) { my $v = $x->{$k}; .. } |
4828
|
|
|
|
|
|
|
# |
4829
|
0
|
|
|
|
|
|
push(@$out, 'foreach'); |
4830
|
|
|
|
|
|
|
#push(@$out, 'my'); |
4831
|
0
|
0
|
|
|
|
|
return unless $self->translate_stmt($out, $key, $info); |
4832
|
0
|
|
|
|
|
|
push(@$out, '('); |
4833
|
0
|
|
|
|
|
|
push(@$out, 'sort'); |
4834
|
0
|
|
|
|
|
|
push(@$out, '{'); |
4835
|
0
|
|
|
|
|
|
push(@$out, '$a'); |
4836
|
0
|
|
|
|
|
|
push(@$out, '<=>'); |
4837
|
0
|
|
|
|
|
|
push(@$out, '$b'); |
4838
|
0
|
|
|
|
|
|
push(@$out, '}'); |
4839
|
0
|
|
|
|
|
|
push(@$out, 'keys'); |
4840
|
0
|
|
|
|
|
|
push(@$out, '%'); |
4841
|
0
|
|
|
|
|
|
push(@$out, '{'); |
4842
|
0
|
0
|
|
|
|
|
return unless $self->translate_stmt($out, $expr, $info); |
4843
|
0
|
|
|
|
|
|
push(@$out, '}'); |
4844
|
0
|
|
|
|
|
|
push(@$out, ')'); |
4845
|
0
|
|
|
|
|
|
push(@$out, '{'); |
4846
|
|
|
|
|
|
|
|
4847
|
|
|
|
|
|
|
#push(@$out, 'my'); |
4848
|
0
|
0
|
|
|
|
|
return unless $self->translate_stmt($out, $value, $info); |
4849
|
0
|
|
|
|
|
|
push(@$out, '='); |
4850
|
0
|
0
|
|
|
|
|
return unless $self->translate_stmt($out, $expr, $info); |
4851
|
0
|
|
|
|
|
|
push(@$out, '->'); |
4852
|
0
|
|
|
|
|
|
push(@$out, '{'); |
4853
|
0
|
0
|
|
|
|
|
return unless $self->translate_stmt($out, $key, $info); |
4854
|
0
|
|
|
|
|
|
push(@$out, '}'); |
4855
|
0
|
|
|
|
|
|
push(@$out, ';'); |
4856
|
|
|
|
|
|
|
|
4857
|
0
|
|
|
|
|
|
my $type = $self->{strmap}->{$block}->[1]; |
4858
|
0
|
|
|
|
|
|
my $c = $self->{strmap}->{$block}->[2]; |
4859
|
0
|
|
|
|
|
|
foreach my $k (@$c) { |
4860
|
0
|
0
|
|
|
|
|
return unless $self->translate_stmt($out, $k, $info); |
4861
|
|
|
|
|
|
|
#if ($out->[-1] ne '}') { |
4862
|
0
|
|
|
|
|
|
push(@$out, ';'); # might follow {} after map define/deref |
4863
|
|
|
|
|
|
|
#} |
4864
|
|
|
|
|
|
|
} |
4865
|
0
|
|
|
|
|
|
push(@$out, '}'); |
4866
|
0
|
|
|
|
|
|
return 1; |
4867
|
|
|
|
|
|
|
} else { |
4868
|
0
|
|
|
|
|
|
push(@$out, $cmd); |
4869
|
0
|
|
|
|
|
|
push(@$out, 'my'); |
4870
|
0
|
0
|
|
|
|
|
return unless $self->translate_stmt($out, $value, $info); |
4871
|
0
|
|
|
|
|
|
push(@$out, '('); |
4872
|
0
|
0
|
|
|
|
|
return unless $self->translate_stmt($out, $expr, $info); |
4873
|
0
|
|
|
|
|
|
push(@$out, ')'); |
4874
|
|
|
|
|
|
|
} |
4875
|
0
|
0
|
|
|
|
|
return unless $self->translate_stmt($out, $block, $info); |
4876
|
|
|
|
|
|
|
} elsif ($cmd eq 'switch') { |
4877
|
0
|
|
|
|
|
|
my ($expr, $cases) = @{$self->{strmap}->{$s}}[1..2]; |
|
0
|
|
|
|
|
|
|
4878
|
0
|
|
|
|
|
|
my $first = 1; |
4879
|
|
|
|
|
|
|
|
4880
|
0
|
|
|
|
|
|
foreach my $e (@$cases) { |
4881
|
0
|
|
|
|
|
|
my $c = $e->[0]; |
4882
|
0
|
|
|
|
|
|
my $b = $e->[1]; |
4883
|
0
|
0
|
|
|
|
|
if (!defined $c) { |
4884
|
0
|
0
|
|
|
|
|
if ($first) { |
4885
|
0
|
|
|
|
|
|
$self->{warn}->('translate', "bad switch $s"); |
4886
|
0
|
|
|
|
|
|
return; |
4887
|
|
|
|
|
|
|
} |
4888
|
0
|
|
|
|
|
|
push(@$out, 'else'); |
4889
|
|
|
|
|
|
|
} else { |
4890
|
0
|
0
|
|
|
|
|
if ($first) { |
4891
|
0
|
|
|
|
|
|
push(@$out, 'if'); |
4892
|
0
|
|
|
|
|
|
$first = 0; |
4893
|
|
|
|
|
|
|
} else { |
4894
|
0
|
|
|
|
|
|
push(@$out, 'elsif'); |
4895
|
|
|
|
|
|
|
} |
4896
|
0
|
|
|
|
|
|
push(@$out, '('); |
4897
|
0
|
0
|
|
|
|
|
return unless $self->translate_stmt($out, $expr, $info); |
4898
|
0
|
|
|
|
|
|
push(@$out, '=='); |
4899
|
0
|
|
|
|
|
|
push(@$out, '('); |
4900
|
0
|
0
|
|
|
|
|
return unless $self->translate_stmt($out, $c, $info); |
4901
|
0
|
|
|
|
|
|
push(@$out, ')'); |
4902
|
0
|
|
|
|
|
|
push(@$out, ')'); |
4903
|
|
|
|
|
|
|
} |
4904
|
0
|
|
|
|
|
|
push(@$out, '{'); |
4905
|
0
|
0
|
|
|
|
|
return unless $self->translate_stmt($out, $b, $info); |
4906
|
0
|
|
|
|
|
|
push(@$out, '}'); |
4907
|
|
|
|
|
|
|
} |
4908
|
|
|
|
|
|
|
} elsif ($cmd eq 'break') { |
4909
|
0
|
|
|
|
|
|
push(@$out, 'last'); |
4910
|
|
|
|
|
|
|
} elsif ($cmd eq 'continue') { |
4911
|
0
|
|
|
|
|
|
push(@$out, 'next'); |
4912
|
|
|
|
|
|
|
} else { |
4913
|
0
|
|
|
|
|
|
$self->{warn}->('translate', "bad statement $s"); |
4914
|
0
|
|
|
|
|
|
return; |
4915
|
|
|
|
|
|
|
} |
4916
|
|
|
|
|
|
|
} elsif (is_variable($s)) { |
4917
|
0
|
|
|
|
|
|
my ($global) = global_split($s); |
4918
|
0
|
0
|
|
|
|
|
if (defined $global) { |
4919
|
0
|
|
|
|
|
|
$self->{warn}->('translate', "global $s not supported"); |
4920
|
0
|
|
|
|
|
|
return; |
4921
|
|
|
|
|
|
|
} |
4922
|
0
|
0
|
|
|
|
|
unless (is_symbol($s)) { |
4923
|
0
|
|
|
|
|
|
$self->{warn}->('translate', "bad var name $s not supported"); |
4924
|
0
|
|
|
|
|
|
return; |
4925
|
|
|
|
|
|
|
} |
4926
|
0
|
|
|
|
|
|
push(@$out, $s); |
4927
|
|
|
|
|
|
|
} else { |
4928
|
0
|
|
|
|
|
|
$self->{warn}->('translate', "bad symbol $s not supported"); |
4929
|
0
|
|
|
|
|
|
return; |
4930
|
|
|
|
|
|
|
} |
4931
|
0
|
|
|
|
|
|
return 1; |
4932
|
|
|
|
|
|
|
} |
4933
|
|
|
|
|
|
|
|
4934
|
|
|
|
|
|
|
sub translate_func { |
4935
|
0
|
|
|
0
|
0
|
|
my ($self, $s, $maxlen, $format) = @_; |
4936
|
0
|
|
|
|
|
|
my @out = (); |
4937
|
|
|
|
|
|
|
|
4938
|
0
|
0
|
|
|
|
|
unless ($s =~ /^#fun\d+$/) { |
4939
|
0
|
|
|
|
|
|
$self->{warn}->('translate', "no func $s"); |
4940
|
0
|
|
|
|
|
|
return; |
4941
|
|
|
|
|
|
|
} |
4942
|
|
|
|
|
|
|
# create anonymous subroutine here |
4943
|
|
|
|
|
|
|
# |
4944
|
0
|
|
|
|
|
|
my ($f, $a, $b, $p) = @{$self->{strmap}->{$s}}; |
|
0
|
|
|
|
|
|
|
4945
|
0
|
|
|
|
|
|
$f = $self->setfun(undef, $a, $b, $p); |
4946
|
|
|
|
|
|
|
|
4947
|
0
|
|
|
|
|
|
my $info = {args => {}, vars => {}, locals => {}, globals => {}, calls => {}, returns => {}}; |
4948
|
0
|
|
|
|
|
|
$self->stmt_info($b, $info); |
4949
|
|
|
|
|
|
|
|
4950
|
0
|
0
|
|
|
|
|
if (scalar @$a > 0) { |
4951
|
0
|
|
|
|
|
|
foreach my $v (@$a) { |
4952
|
0
|
|
|
|
|
|
$info->{args}{$v} = 0; |
4953
|
|
|
|
|
|
|
} |
4954
|
0
|
|
|
|
|
|
foreach my $v (keys %{$info->{vars}}) { |
|
0
|
|
|
|
|
|
|
4955
|
0
|
0
|
|
|
|
|
$info->{locals}{$v} |= $info->{vars}{$v} unless exists $info->{args}{$v}; |
4956
|
|
|
|
|
|
|
} |
4957
|
0
|
|
|
|
|
|
foreach my $v (keys %{$info->{args}}) { |
|
0
|
|
|
|
|
|
|
4958
|
0
|
0
|
|
|
|
|
$info->{vars}{$v} |= $info->{args}{$v} unless exists $info->{vars}{$v}; |
4959
|
|
|
|
|
|
|
} |
4960
|
|
|
|
|
|
|
} else { |
4961
|
0
|
|
|
|
|
|
$info->{locals} = $info->{vars}; |
4962
|
|
|
|
|
|
|
} |
4963
|
0
|
0
|
|
|
|
|
if (keys %{$info->{args}}) { |
|
0
|
|
|
|
|
|
|
4964
|
0
|
0
|
|
|
|
|
$self->{log}->('translate', "local args: %s", join(' ', map { ($info->{vars}{$_} ne '1') ? "$_:$info->{vars}{$_}" : $_ } keys %{$info->{args}})) if $self->{log}; |
|
0
|
0
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
4965
|
|
|
|
|
|
|
} |
4966
|
0
|
0
|
|
|
|
|
if (keys %{$info->{locals}}) { |
|
0
|
|
|
|
|
|
|
4967
|
0
|
0
|
|
|
|
|
$self->{log}->('translate', "local vars: %s", join(' ', map { ($info->{vars}{$_} ne '1') ? "$_:$info->{vars}{$_}" : $_ } keys %{$info->{locals}})) if $self->{log}; |
|
0
|
0
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
4968
|
|
|
|
|
|
|
} |
4969
|
0
|
0
|
|
|
|
|
if (keys %{$info->{globals}}) { |
|
0
|
|
|
|
|
|
|
4970
|
0
|
0
|
|
|
|
|
$self->{log}->('translate', "globals: %s", join(' ', keys %{$info->{globals}})) if $self->{log}; |
|
0
|
|
|
|
|
|
|
4971
|
|
|
|
|
|
|
} |
4972
|
0
|
0
|
|
|
|
|
if (keys %{$info->{calls}}) { |
|
0
|
|
|
|
|
|
|
4973
|
0
|
0
|
|
|
|
|
$self->{log}->('translate', "calls: %s", join(' ', keys %{$info->{calls}})) if $self->{log}; |
|
0
|
|
|
|
|
|
|
4974
|
|
|
|
|
|
|
} |
4975
|
0
|
0
|
|
|
|
|
if (keys %{$info->{returns}}) { |
|
0
|
|
|
|
|
|
|
4976
|
0
|
0
|
|
|
|
|
$self->{log}->('translate', "returns: %s", join(' ', keys %{$info->{returns}})) if $self->{log}; |
|
0
|
|
|
|
|
|
|
4977
|
|
|
|
|
|
|
} else { |
4978
|
0
|
|
|
|
|
|
$self->{warn}->('translate', "no return for func $s"); |
4979
|
0
|
|
|
|
|
|
return; |
4980
|
|
|
|
|
|
|
} |
4981
|
|
|
|
|
|
|
|
4982
|
0
|
0
|
|
|
|
|
unless ($self->translate_stmt(\@out, $f, $info)) { |
4983
|
0
|
|
|
|
|
|
return; |
4984
|
|
|
|
|
|
|
} |
4985
|
|
|
|
|
|
|
|
4986
|
0
|
0
|
|
|
|
|
if ($format) { |
4987
|
0
|
|
|
|
|
|
my @tmp = (); |
4988
|
0
|
|
|
|
|
|
expand_formatted(\@tmp, \@out, 0); |
4989
|
0
|
|
|
|
|
|
return join(' ', @tmp); |
4990
|
|
|
|
|
|
|
} |
4991
|
0
|
|
|
|
|
|
return join(' ', @out); |
4992
|
|
|
|
|
|
|
} |
4993
|
|
|
|
|
|
|
|
4994
|
|
|
|
|
|
|
1; |
4995
|
|
|
|
|
|
|
|
4996
|
|
|
|
|
|
|
__END__ |