line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Perl6::Tokener; |
2
|
1
|
|
|
1
|
|
20471
|
use Text::Balanced qw(extract_quotelike); |
|
1
|
|
|
|
|
51391
|
|
|
1
|
|
|
|
|
18688
|
|
3
|
|
|
|
|
|
|
my %keywords = map {$_=>1} (qw( |
4
|
|
|
|
|
|
|
given when CATCH break try POST class |
5
|
|
|
|
|
|
|
__FILE__ __LINE__ __PACKAGE__ __DATA__ __END__ AUTOLOAD BEGIN CORE |
6
|
|
|
|
|
|
|
DESTROY END INIT CHECK abs accept alarm and atan2 bind binmode bless |
7
|
|
|
|
|
|
|
caller chdir chmod chomp chop chown chr chroot close closedir cmp |
8
|
|
|
|
|
|
|
connect continue cos crypt dbmclose dbmopen defined delete die do |
9
|
|
|
|
|
|
|
each else elsif endgrent endhostent endnetent endprotoent endpwent |
10
|
|
|
|
|
|
|
endservent eof eq eval exec exists exit exp fcntl fileno flock for |
11
|
|
|
|
|
|
|
foreach fork format formline ge getc glob gmtime goto grep gt hex if |
12
|
|
|
|
|
|
|
index int ioctl join keys kill last lc lcfirst le length link listen |
13
|
|
|
|
|
|
|
local localtime lock log lstat lt m map mkdir my ne next no not oct |
14
|
|
|
|
|
|
|
open opendir or ord our pack package pipe pop pos print printf prototype |
15
|
|
|
|
|
|
|
push q qq qr quotemeta qw qx rand read readdir readline readlink readpipe |
16
|
|
|
|
|
|
|
recv redo ref rename require reset return reverse rewinddir rindex rmdir |
17
|
|
|
|
|
|
|
s scalar seek seekdir select shift sin sleep sort splice split sprintf |
18
|
|
|
|
|
|
|
sqrt srand stat study sub substr tell telldir tie tied time tr truncate |
19
|
|
|
|
|
|
|
uc ucfirst umask undef unless unlink unpack unshift untie until use |
20
|
|
|
|
|
|
|
values vec wait waitpid wantarray warn while write x xor y |
21
|
|
|
|
|
|
|
)); |
22
|
|
|
|
|
|
|
|
23
|
|
|
|
|
|
|
my %tokener = ( |
24
|
|
|
|
|
|
|
'$' => \&dollar, |
25
|
|
|
|
|
|
|
'@' => \&at, |
26
|
|
|
|
|
|
|
'%' => \&hash, |
27
|
|
|
|
|
|
|
'+' => sub {operator(shift, type => "addop")}, |
28
|
|
|
|
|
|
|
'+=' => sub {operator(shift, type => "assignop", length => 2)}, |
29
|
|
|
|
|
|
|
'*' => sub {operator(shift, type => "mulop")}, |
30
|
|
|
|
|
|
|
'**' => sub {operator(shift, type => "powop", length => 2)}, |
31
|
|
|
|
|
|
|
'*=' => sub {operator(shift, type => "assignop", length => 2)}, |
32
|
|
|
|
|
|
|
'-' => sub {operator(shift, type => "addop")}, |
33
|
|
|
|
|
|
|
'-=' => sub {operator(shift, type => "assignop", length => 2)}, |
34
|
|
|
|
|
|
|
'++' => \&inc, |
35
|
|
|
|
|
|
|
'--' => \&dec, |
36
|
|
|
|
|
|
|
'/' => \&slash, |
37
|
|
|
|
|
|
|
|
38
|
|
|
|
|
|
|
'>=' => sub {operator(shift, type => "comparison", length => 2)}, |
39
|
|
|
|
|
|
|
'>' => sub {operator(shift, type => "comparison")}, |
40
|
|
|
|
|
|
|
'>>' => sub {operator(shift, type => "shiftop", length => 2)}, |
41
|
|
|
|
|
|
|
|
42
|
|
|
|
|
|
|
'==' => sub {operator(shift, type => "comparison", length => 2)}, |
43
|
|
|
|
|
|
|
'=>' => sub {operator(shift, type => "pair", length => 2)}, |
44
|
|
|
|
|
|
|
'=~' => sub {operator(shift, type => "match", length => 2)}, |
45
|
|
|
|
|
|
|
'=' => sub {operator(shift, type => "assignop") }, |
46
|
|
|
|
|
|
|
'#' => \&comment, |
47
|
|
|
|
|
|
|
|
48
|
|
|
|
|
|
|
'<' => \&less_or_readln, |
49
|
|
|
|
|
|
|
'<=' => sub {operator(shift, type => "comparison", length => 2)}, |
50
|
|
|
|
|
|
|
'<=>' => sub {operator(shift, type => "comparison", length => 3)}, |
51
|
|
|
|
|
|
|
'<<' => \&shift_or_heredoc, |
52
|
|
|
|
|
|
|
|
53
|
|
|
|
|
|
|
' ' => \&space, "\t" => \&space, "\n" => \&space, |
54
|
|
|
|
|
|
|
';' => \&operator, |
55
|
|
|
|
|
|
|
'.' => \&dot, |
56
|
|
|
|
|
|
|
'..' => sub {operator(shift, type => "range", length => 2)}, |
57
|
|
|
|
|
|
|
'...' => \&tripledot, |
58
|
|
|
|
|
|
|
',' => \&operator, |
59
|
|
|
|
|
|
|
'[' => \&operator, |
60
|
|
|
|
|
|
|
']' => \&term, |
61
|
|
|
|
|
|
|
'!' => sub {operator(shift, type=> "unop") }, |
62
|
|
|
|
|
|
|
'\\' => sub {operator(shift, type=> "refgen") }, |
63
|
|
|
|
|
|
|
'(' => sub {operator(shift, type=> "token", check => "no") }, |
64
|
|
|
|
|
|
|
')' => sub {term(shift, check=>"no") }, |
65
|
|
|
|
|
|
|
'{' => sub {operator(shift, type=> "blockstart") }, |
66
|
|
|
|
|
|
|
'}' => sub {operator(shift, type=> "blockend", check => "no", state => "ANY") }, |
67
|
|
|
|
|
|
|
#'{' => \&block_or_subscript, |
68
|
|
|
|
|
|
|
#'}' => \&end_curly, |
69
|
|
|
|
|
|
|
'_' => sub {operator(shift, type=>"addop")}, |
70
|
|
|
|
|
|
|
'|' => sub {operator(shift, type=>"logop")}, |
71
|
|
|
|
|
|
|
'||' => sub {operator(shift, length=>2, type=>"logop")}, |
72
|
|
|
|
|
|
|
'||=' => sub {operator(shift, length=>3, type=>"assignop")}, |
73
|
|
|
|
|
|
|
|
74
|
|
|
|
|
|
|
'^' => \&hyper, |
75
|
|
|
|
|
|
|
'"' => \"e, "'" => \"e, |
76
|
|
|
|
|
|
|
'`' => \"e, # Of sorts |
77
|
|
|
|
|
|
|
|
78
|
|
|
|
|
|
|
); |
79
|
|
|
|
|
|
|
|
80
|
|
|
|
|
|
|
$tokener{$_} = \&number for 0 .. 9; |
81
|
|
|
|
|
|
|
$tokener{$_} = \&bareword for "a".."z","A".."Z", "_"; |
82
|
|
|
|
|
|
|
|
83
|
|
|
|
|
|
|
$tokener{"-$_"} = \&filetest |
84
|
|
|
|
|
|
|
for split //, "rwxoRWXOezsfdlpSugkbctTBMAC"; |
85
|
|
|
|
|
|
|
|
86
|
|
|
|
|
|
|
my %keyword_tokens = ( |
87
|
|
|
|
|
|
|
'__FILE__' => sub {$_[0]->{type}="constant"; $_[0]->{token}=$_[0]->file }, |
88
|
|
|
|
|
|
|
'__LINE__' => sub {$_[0]->{type}="constant"; $_[0]->{token}=$_[0]->{line} }, |
89
|
|
|
|
|
|
|
'__PACKAGE__' => sub {$_[0]->{type}="constant"; $_[0]->{token}=$_[0]->{package} }, |
90
|
|
|
|
|
|
|
'AUTOLOAD' => \&block_or_sub, |
91
|
|
|
|
|
|
|
'BEGIN' => \&block_or_sub, |
92
|
|
|
|
|
|
|
'CATCH' => \&block_or_sub, |
93
|
|
|
|
|
|
|
'CHECK' => \&block_or_sub, |
94
|
|
|
|
|
|
|
'DESTROY' => \&block_or_sub, |
95
|
|
|
|
|
|
|
'END' => \&block_or_sub, |
96
|
|
|
|
|
|
|
'INIT' => \&block_or_sub, |
97
|
|
|
|
|
|
|
'POST' => \&block_or_sub, |
98
|
|
|
|
|
|
|
# I don't care about CORE:: any more. Do you? |
99
|
|
|
|
|
|
|
'abs' => \&uni, |
100
|
|
|
|
|
|
|
'alarm' => \&uni, |
101
|
|
|
|
|
|
|
'and' => sub { my $t=shift; $t->{state}="TERM"; $t->{type}="andop" }, |
102
|
|
|
|
|
|
|
'atan2' => \&uni, |
103
|
|
|
|
|
|
|
'binmode' => \&lop, |
104
|
|
|
|
|
|
|
'bless' => \&lop, |
105
|
|
|
|
|
|
|
'chop' => \&uni, |
106
|
|
|
|
|
|
|
'continue' => \&preblock, |
107
|
|
|
|
|
|
|
'chdir' => \&uni, |
108
|
|
|
|
|
|
|
'close' => \&uni, |
109
|
|
|
|
|
|
|
'closedir' => \&uni, |
110
|
|
|
|
|
|
|
'cmp' => sub { my $t=shift; $t->{state}="TERM"; $t->{type}="comparison" }, |
111
|
|
|
|
|
|
|
'caller' => \&uni, |
112
|
|
|
|
|
|
|
'crypt' => \&lop, |
113
|
|
|
|
|
|
|
'chmod' => \&lop, |
114
|
|
|
|
|
|
|
'chown' => \&lop, |
115
|
|
|
|
|
|
|
'class' => sub { my $t=shift; $t->{state}="TERM"; $t->{type}="operator" }, #also need to set $t->{package} |
116
|
|
|
|
|
|
|
'connect' => \&lop, |
117
|
|
|
|
|
|
|
'chr' => \&uni, |
118
|
|
|
|
|
|
|
'cos' => \&uni, |
119
|
|
|
|
|
|
|
'die' => \&lop, |
120
|
|
|
|
|
|
|
'defined' => \&uni, |
121
|
|
|
|
|
|
|
'delete' => \&uni, |
122
|
|
|
|
|
|
|
'else' => \&preblock, |
123
|
|
|
|
|
|
|
'elsif' => sub { my $t=shift; $t->{state}="TERM"; $t->{type}="operator" }, |
124
|
|
|
|
|
|
|
'eq' => sub { my $t=shift; $t->{state}="TERM"; $t->{type}="comparison" }, |
125
|
|
|
|
|
|
|
'eval' => \&preblock, # A Perl 6ism. |
126
|
|
|
|
|
|
|
'exists' => \&uni, |
127
|
|
|
|
|
|
|
'exit' => \&uni, |
128
|
|
|
|
|
|
|
'eof' => \&uni, |
129
|
|
|
|
|
|
|
'exp' => \&uni, |
130
|
|
|
|
|
|
|
'each' => \&uni, |
131
|
|
|
|
|
|
|
'exec' => \&lop, |
132
|
|
|
|
|
|
|
'fcntl' => \&lop, |
133
|
|
|
|
|
|
|
'fileno' => \&uni, |
134
|
|
|
|
|
|
|
'flock' => \&lop, |
135
|
|
|
|
|
|
|
#'for' => \&do_for, # This is going to suck |
136
|
|
|
|
|
|
|
#'foreach' => \&do_for, # really quite nastily |
137
|
|
|
|
|
|
|
'fork' => sub { my $t=shift; $t->{type}="func0" }, |
138
|
|
|
|
|
|
|
'ge' => sub { my $t=shift; $t->{state}="TERM"; $t->{type}="comparison" }, |
139
|
|
|
|
|
|
|
'getc' => \&uni, |
140
|
|
|
|
|
|
|
'given' => sub { my $t=shift; $t->{state}="TERM"; $t->{type}="operator" }, |
141
|
|
|
|
|
|
|
'glob' => \&lop, |
142
|
|
|
|
|
|
|
'gmtime' => \&uni, |
143
|
|
|
|
|
|
|
'goto' => sub { my $t=shift; $t->{state}="TERM"; $t->{type}="loopx"; $t->{next}->{type} = "bareword" }, |
144
|
|
|
|
|
|
|
'grep' => sub { lop(shift, "REF") }, |
145
|
|
|
|
|
|
|
'gt' => sub { my $t=shift; $t->{state}="TERM"; $t->{type}="comparison" }, |
146
|
|
|
|
|
|
|
'hex' => \&uni, |
147
|
|
|
|
|
|
|
'if' => sub { my $t=shift; $t->{state}="TERM"; $t->{type}="operator" }, |
148
|
|
|
|
|
|
|
'index' => \&lop, |
149
|
|
|
|
|
|
|
'int' => \&uni, |
150
|
|
|
|
|
|
|
'ioctl' => \&lop, |
151
|
|
|
|
|
|
|
'join' => \&lop, |
152
|
|
|
|
|
|
|
'keys' => \&uni, |
153
|
|
|
|
|
|
|
'kill' => \&lop, |
154
|
|
|
|
|
|
|
'last' => sub { my $t=shift; $t->{state}="TERM"; $t->{type}="loopx"; $t->{next}->{type} = "bareword" }, |
155
|
|
|
|
|
|
|
'lc' => \&uni, |
156
|
|
|
|
|
|
|
'lcfirst' => \&uni, |
157
|
|
|
|
|
|
|
'le' => sub { my $t=shift; $t->{state}="TERM"; $t->{type}="comparison" }, |
158
|
|
|
|
|
|
|
'length' => \&uni, |
159
|
|
|
|
|
|
|
'local' => sub { my $t=shift; $t->{state}="TERM"; $t->{type}="operator" }, |
160
|
|
|
|
|
|
|
'localtime' => \&uni, |
161
|
|
|
|
|
|
|
'log' => \&uni, |
162
|
|
|
|
|
|
|
'link' => \&lop, |
163
|
|
|
|
|
|
|
'listen' => \&lop, |
164
|
|
|
|
|
|
|
'lock' => \&uni, |
165
|
|
|
|
|
|
|
'lstat' => \&uni, |
166
|
|
|
|
|
|
|
'lt' => sub { my $t=shift; $t->{state}="TERM"; $t->{type}="comparison" }, |
167
|
|
|
|
|
|
|
'map' => sub { lop(shift, "REF") }, |
168
|
|
|
|
|
|
|
'mkdir' => \&lop, |
169
|
|
|
|
|
|
|
'my' => sub { my $t=shift; $t->{state}="TERM"; $t->{type}="operator" }, |
170
|
|
|
|
|
|
|
'ne' => sub { my $t=shift; $t->{state}="TERM"; $t->{type}="comparison" }, |
171
|
|
|
|
|
|
|
'next' => sub { my $t=shift; $t->{state}="TERM"; $t->{type}="loopx"; $t->{next}->{type} = "bareword" }, |
172
|
|
|
|
|
|
|
#'no' => \&use_no, |
173
|
|
|
|
|
|
|
#'not' => \&do_not, |
174
|
|
|
|
|
|
|
'open' => \&lop, |
175
|
|
|
|
|
|
|
'or' => sub { my $t=shift; $t->{state}="TERM"; $t->{type}="operator" }, |
176
|
|
|
|
|
|
|
'ord' => \&uni, |
177
|
|
|
|
|
|
|
'oct' => \&uni, |
178
|
|
|
|
|
|
|
'open' => \&lop, |
179
|
|
|
|
|
|
|
'opendir' => \&lop, |
180
|
|
|
|
|
|
|
'our' => sub { my $t=shift; $t->{state}="TERM"; $t->{type}="operator" }, |
181
|
|
|
|
|
|
|
'package' => sub { my $t=shift; $t->{state}="TERM"; $t->{type}="operator" }, #also need to set $t->{package} |
182
|
|
|
|
|
|
|
'print' => sub { lop(shift, "REF") }, |
183
|
|
|
|
|
|
|
'printf' => sub { lop(shift, "REF") }, |
184
|
|
|
|
|
|
|
'prototype' => \&uni, |
185
|
|
|
|
|
|
|
'push' => \&lop, |
186
|
|
|
|
|
|
|
'pop' => \&uni, |
187
|
|
|
|
|
|
|
'pos' => \&uni, |
188
|
|
|
|
|
|
|
'pack' => \&lop, |
189
|
|
|
|
|
|
|
'pipe_op' => \&lop, |
190
|
|
|
|
|
|
|
'quotemeta' => \&uni, |
191
|
|
|
|
|
|
|
'redo' => sub { my $t=shift; $t->{state}="TERM"; $t->{type}="loopx"; $t->{next}->{type} = "bareword" }, |
192
|
|
|
|
|
|
|
'return' => \&lop, # XXX |
193
|
|
|
|
|
|
|
'require' => \&uni, |
194
|
|
|
|
|
|
|
'reset' => \&uni, |
195
|
|
|
|
|
|
|
'rename' => \&lop, |
196
|
|
|
|
|
|
|
'rand' => \&uni, |
197
|
|
|
|
|
|
|
'rmdir' => \&uni, |
198
|
|
|
|
|
|
|
'rindex' => \&lop, |
199
|
|
|
|
|
|
|
'read' => \&lop, |
200
|
|
|
|
|
|
|
'readdir' => \&uni, |
201
|
|
|
|
|
|
|
'readline' => \&uni, |
202
|
|
|
|
|
|
|
'rewinddir' => \&uni, |
203
|
|
|
|
|
|
|
'recv' => \&lop, |
204
|
|
|
|
|
|
|
'reverse' => \&lop, |
205
|
|
|
|
|
|
|
'readlink' => \&uni, |
206
|
|
|
|
|
|
|
'ref' => \&uni, |
207
|
|
|
|
|
|
|
'chomp' => \&uni, |
208
|
|
|
|
|
|
|
'scalar' => \&uni, |
209
|
|
|
|
|
|
|
'select' => \&lop, |
210
|
|
|
|
|
|
|
'seek' => \&lop, |
211
|
|
|
|
|
|
|
'shift' => \&uni, |
212
|
|
|
|
|
|
|
'sin' => \&uni, |
213
|
|
|
|
|
|
|
'sleep' => \&uni, |
214
|
|
|
|
|
|
|
'socket' => \&lop, |
215
|
|
|
|
|
|
|
'sort' => sub { lop(shift, "REF") }, |
216
|
|
|
|
|
|
|
'split' => \&lop, |
217
|
|
|
|
|
|
|
'sprintf' => \&lop, |
218
|
|
|
|
|
|
|
'splice' => \&lop, |
219
|
|
|
|
|
|
|
'sqrt' => \&uni, |
220
|
|
|
|
|
|
|
'srand' => \&uni, |
221
|
|
|
|
|
|
|
'stat' => \&uni, |
222
|
|
|
|
|
|
|
'study' => \&uni, |
223
|
|
|
|
|
|
|
#'sub' => \&do_sub, |
224
|
|
|
|
|
|
|
'substr' => \&lop, |
225
|
|
|
|
|
|
|
'system' => \&lop, |
226
|
|
|
|
|
|
|
'symlink' => \&lop, |
227
|
|
|
|
|
|
|
'syscall' => \&lop, |
228
|
|
|
|
|
|
|
'sysopen' => \&lop, |
229
|
|
|
|
|
|
|
'sysseek' => \&lop, |
230
|
|
|
|
|
|
|
'sysread' => \&lop, |
231
|
|
|
|
|
|
|
'syswrite' => \&lop, |
232
|
|
|
|
|
|
|
'tell' => \&uni, |
233
|
|
|
|
|
|
|
'telldir' => \&uni, |
234
|
|
|
|
|
|
|
'tie' => \&lop, |
235
|
|
|
|
|
|
|
'tied' => \&uni, |
236
|
|
|
|
|
|
|
'time' => sub { my $t=shift; $t->{type}="func0" }, |
237
|
|
|
|
|
|
|
'truncate' => \&lop, |
238
|
|
|
|
|
|
|
'uc' => \&uni, |
239
|
|
|
|
|
|
|
'ucfirst' => \&uni, |
240
|
|
|
|
|
|
|
'untie' => \&uni, |
241
|
|
|
|
|
|
|
'until' => sub { my $t=shift; $t->{state}="TERM"; $t->{type}="operator" }, |
242
|
|
|
|
|
|
|
'unless' => sub { my $t=shift; $t->{state}="TERM"; $t->{type}="operator" }, |
243
|
|
|
|
|
|
|
'unlink' => \&lop, |
244
|
|
|
|
|
|
|
'undef' => \&uni, |
245
|
|
|
|
|
|
|
'unpack' => \&lop, |
246
|
|
|
|
|
|
|
'utime' => \&lop, |
247
|
|
|
|
|
|
|
'umask' => \&uni, |
248
|
|
|
|
|
|
|
'unshift' => \&lop, |
249
|
|
|
|
|
|
|
#'use' => \&use_no, |
250
|
|
|
|
|
|
|
'values' => \&uni, |
251
|
|
|
|
|
|
|
'vec' => \&lop, |
252
|
|
|
|
|
|
|
'warn' => \&lop, |
253
|
|
|
|
|
|
|
'wait' => sub { my $t=shift; $t->{type}="func0" }, |
254
|
|
|
|
|
|
|
'waitpid' => \&lop, |
255
|
|
|
|
|
|
|
'when' => sub { my $t=shift; $t->{state}="TERM"; $t->{type}="operator" }, |
256
|
|
|
|
|
|
|
'while' => sub { my $t=shift; $t->{state}="TERM"; $t->{type}="operator" }, |
257
|
|
|
|
|
|
|
'write' => \&uni, |
258
|
|
|
|
|
|
|
'x' => \&do_repeat, |
259
|
|
|
|
|
|
|
'xor' => sub { my $t=shift; $t->{state}="TERM"; $t->{type}="operator" }, |
260
|
|
|
|
|
|
|
); |
261
|
|
|
|
|
|
|
|
262
|
|
|
|
|
|
|
$Perl6::Tokener::VERSION = '0.01'; |
263
|
|
|
|
|
|
|
|
264
|
|
|
|
|
|
|
=head1 NAME |
265
|
|
|
|
|
|
|
|
266
|
|
|
|
|
|
|
Perl6::Tokener - It's a Perl 6 tokener. It tokenises Perl 6. |
267
|
|
|
|
|
|
|
|
268
|
|
|
|
|
|
|
=head1 SYNOPSIS |
269
|
|
|
|
|
|
|
|
270
|
|
|
|
|
|
|
use Perl6::Tokener; |
271
|
|
|
|
|
|
|
my $t = new Perl6::Tokener(file=>"foo.pl", buffer => $code); |
272
|
|
|
|
|
|
|
while ($t->{buffer}) { |
273
|
|
|
|
|
|
|
my ($type, $token) = $t->toke(); |
274
|
|
|
|
|
|
|
... |
275
|
|
|
|
|
|
|
} |
276
|
|
|
|
|
|
|
|
277
|
|
|
|
|
|
|
=head1 DESCRIPTION |
278
|
|
|
|
|
|
|
|
279
|
|
|
|
|
|
|
I don't think there's really much I need to say about this. It isn't |
280
|
|
|
|
|
|
|
perfect, but I'm working on it. The synopsis pretty much gives you all |
281
|
|
|
|
|
|
|
you need to know to drive the thing, and, bluntly, if you're futzing |
282
|
|
|
|
|
|
|
with tokenising Perl 6, you're already beyond the need for most kinds of |
283
|
|
|
|
|
|
|
documentation. So have fun. |
284
|
|
|
|
|
|
|
|
285
|
|
|
|
|
|
|
Oh, one thing - when you're parsing, you probably want to discard the |
286
|
|
|
|
|
|
|
type of everything called C or C and just use the token |
287
|
|
|
|
|
|
|
value. Oh, and white space will return C for token and type, so |
288
|
|
|
|
|
|
|
don't try using this in a C loop. |
289
|
|
|
|
|
|
|
|
290
|
|
|
|
|
|
|
=head1 BUGS |
291
|
|
|
|
|
|
|
|
292
|
|
|
|
|
|
|
=over 3 |
293
|
|
|
|
|
|
|
|
294
|
|
|
|
|
|
|
=item * |
295
|
|
|
|
|
|
|
|
296
|
|
|
|
|
|
|
C<{> doesn't do what it ought. This is going to suck. |
297
|
|
|
|
|
|
|
|
298
|
|
|
|
|
|
|
=item * |
299
|
|
|
|
|
|
|
|
300
|
|
|
|
|
|
|
Some of the important keyword subs aren't implemented. |
301
|
|
|
|
|
|
|
|
302
|
|
|
|
|
|
|
=head1 AUTHOR |
303
|
|
|
|
|
|
|
|
304
|
|
|
|
|
|
|
Simon Cozens, C |
305
|
|
|
|
|
|
|
|
306
|
|
|
|
|
|
|
=cut |
307
|
|
|
|
|
|
|
|
308
|
|
|
|
|
|
|
sub new { |
309
|
1
|
|
|
1
|
0
|
105
|
my $class = shift; |
310
|
1
|
|
|
|
|
7
|
my $t = bless { |
311
|
|
|
|
|
|
|
state => "STATE", |
312
|
|
|
|
|
|
|
line => 1, |
313
|
|
|
|
|
|
|
char => 1, |
314
|
|
|
|
|
|
|
@_ |
315
|
|
|
|
|
|
|
}, $class; |
316
|
1
|
|
|
|
|
12
|
return $class; |
317
|
|
|
|
|
|
|
|
318
|
|
|
|
|
|
|
} |
319
|
|
|
|
|
|
|
|
320
|
|
|
|
|
|
|
sub toke { |
321
|
12
|
|
|
12
|
0
|
27
|
my $t = shift; |
322
|
12
|
|
|
|
|
58
|
my $thistoke = { line => $t->{line}, char => $t->{char} }; |
323
|
12
|
50
|
|
|
|
34
|
if (not $t->prime()) { |
324
|
12
|
|
|
|
|
252
|
for (sort { length $b <=> length $a } keys %tokener) { |
|
6468
|
|
|
|
|
7162
|
|
325
|
736
|
100
|
|
|
|
7092
|
if ($t->{buffer} =~ /^\Q$_/) { |
326
|
|
|
|
|
|
|
#print "Matched |$_|\n"; |
327
|
12
|
|
|
|
|
78
|
$tokener{$_}->($t); |
328
|
12
|
|
|
|
|
80
|
goto done; |
329
|
|
|
|
|
|
|
} |
330
|
|
|
|
|
|
|
} |
331
|
0
|
|
|
|
|
0
|
die "Can't find a callback for \"$t->{buffer}\"\n"; |
332
|
|
|
|
|
|
|
} |
333
|
|
|
|
|
|
|
done: |
334
|
12
|
50
|
|
|
|
184
|
die $t->{error} if $t->{error}; |
335
|
12
|
50
|
|
|
|
36
|
if ($t->{hyper}) { |
336
|
0
|
|
|
|
|
0
|
$t->{token} = "^".$t->{token}; |
337
|
|
|
|
|
|
|
} |
338
|
12
|
|
|
|
|
96
|
return ($t->{type}, $t->{token}); # Convenience |
339
|
|
|
|
|
|
|
} |
340
|
|
|
|
|
|
|
# Utility functions |
341
|
|
|
|
|
|
|
|
342
|
|
|
|
|
|
|
sub prime { |
343
|
12
|
|
|
12
|
0
|
19
|
my $t = shift; |
344
|
12
|
|
|
|
|
42
|
$t->{hyper} = $t->{next}->{hyper}; |
345
|
12
|
50
|
|
|
|
40
|
$t->{state} = $t->{next}->{state} if $t->{next}->{state}; |
346
|
12
|
50
|
33
|
|
|
42
|
if ($t->{next}->{type} and $t->{next}->{token}) { |
347
|
0
|
|
|
|
|
0
|
$t->{type} = $t->{next}->{type}; |
348
|
0
|
|
|
|
|
0
|
$t->{token} = $t->{next}->{token}; |
349
|
0
|
|
|
|
|
0
|
delete $t->{next}; |
350
|
0
|
|
|
|
|
0
|
return 1; |
351
|
|
|
|
|
|
|
} |
352
|
12
|
|
|
|
|
29
|
delete $t->{next}; |
353
|
12
|
|
|
|
|
37
|
return 0; |
354
|
|
|
|
|
|
|
} |
355
|
|
|
|
|
|
|
|
356
|
0
|
|
|
0
|
0
|
0
|
sub no_op { return "$_[0] found where operator expected" } |
357
|
0
|
|
|
0
|
0
|
0
|
sub not_op { return "$_[0] found where term expected" } |
358
|
|
|
|
|
|
|
|
359
|
|
|
|
|
|
|
sub read_ident { |
360
|
3
|
|
|
3
|
0
|
9
|
$_[0] =~ s/^\s+//; |
361
|
3
|
50
|
|
|
|
12
|
$_[0] =~ s/^(\d+)// and return $1; |
362
|
3
|
50
|
|
|
|
18
|
$_[0] =~ s/^((\w+|::)+)// and return $1; |
363
|
3
|
50
|
|
|
|
28
|
$_[0] =~ s/^([\$@%](\w+|::)+)// and return $1; |
364
|
0
|
0
|
|
|
|
0
|
$_[0] =~ s/^(\$)$// and return $1; |
365
|
0
|
0
|
|
|
|
0
|
$_[0] =~ s/^(\$[?!\$])// and return $1; |
366
|
0
|
|
|
|
|
0
|
die "tricky identifier encountered: $_[0]"; |
367
|
|
|
|
|
|
|
} |
368
|
|
|
|
|
|
|
|
369
|
|
|
|
|
|
|
|
370
|
|
|
|
|
|
|
# Individual characters |
371
|
|
|
|
|
|
|
|
372
|
|
|
|
|
|
|
sub dollar { |
373
|
3
|
|
|
3
|
0
|
6
|
my ($t) = shift; |
374
|
3
|
|
|
|
|
14
|
my $first = substr($t->{buffer}, 1, 1); |
375
|
3
|
50
|
|
|
|
13
|
if ($t->{state} eq "OPERATOR") { |
376
|
0
|
|
|
|
|
0
|
$t->{error} = no_op('$'); |
377
|
0
|
|
|
|
|
0
|
return; |
378
|
|
|
|
|
|
|
} |
379
|
3
|
50
|
|
|
|
10
|
if ($first eq "#") { |
380
|
0
|
|
|
|
|
0
|
$t->{buffer} =~ s/../@/; |
381
|
0
|
|
|
|
|
0
|
my $ident = read_ident($t->{buffer}); |
382
|
0
|
|
|
|
|
0
|
$_[0] = $buffer; |
383
|
0
|
|
|
|
|
0
|
$t->{type} = "term"; |
384
|
0
|
|
|
|
|
0
|
$t->{token} = "\$#$ident"; |
385
|
0
|
|
|
|
|
0
|
$t->{char}+= length $t->{token}; |
386
|
0
|
|
|
|
|
0
|
$t->{state} = "OPERATOR"; |
387
|
0
|
|
|
|
|
0
|
return ; |
388
|
|
|
|
|
|
|
} |
389
|
3
|
|
|
|
|
13
|
my $ident = read_ident($t->{buffer}); |
390
|
3
|
50
|
|
|
|
11
|
if (length $ident ==1) { |
391
|
0
|
0
|
|
|
|
0
|
$t->{error} = 'Final $ should be \\$ or $name' if not $t->{buffer}; |
392
|
0
|
|
|
|
|
0
|
$t->{type} = "preref"; |
393
|
0
|
|
|
|
|
0
|
$t->{token} = '$'; |
394
|
0
|
|
|
|
|
0
|
$t->{char}+= length $t->{token}; |
395
|
0
|
|
|
|
|
0
|
$t->{state} = "REF"; |
396
|
0
|
|
|
|
|
0
|
return; |
397
|
|
|
|
|
|
|
} |
398
|
3
|
|
|
|
|
12
|
$t->{type} = "term"; |
399
|
3
|
|
|
|
|
7
|
$t->{token} = $ident; |
400
|
3
|
|
|
|
|
10
|
$t->{char}+= length $t->{token}; |
401
|
3
|
|
|
|
|
9
|
$t->{state} = "OPERATOR"; |
402
|
|
|
|
|
|
|
} |
403
|
|
|
|
|
|
|
|
404
|
|
|
|
|
|
|
sub hash { |
405
|
0
|
|
|
0
|
0
|
0
|
my $t = shift; |
406
|
0
|
0
|
|
|
|
0
|
if ($t->{state} eq "OPERATOR") { |
407
|
0
|
|
|
|
|
0
|
operator($t, type=>"mulop"); |
408
|
|
|
|
|
|
|
return |
409
|
0
|
|
|
|
|
0
|
} |
410
|
0
|
|
|
|
|
0
|
$t->{token} = read_ident($t->{buffer}); |
411
|
0
|
|
|
|
|
0
|
$t->{type} = "term"; |
412
|
0
|
|
|
|
|
0
|
$t->{char}+= length $t->{token}; |
413
|
0
|
|
|
|
|
0
|
$t->{state} = "OPERATOR"; |
414
|
|
|
|
|
|
|
|
415
|
|
|
|
|
|
|
} |
416
|
|
|
|
|
|
|
|
417
|
|
|
|
|
|
|
|
418
|
|
|
|
|
|
|
sub at { |
419
|
0
|
|
|
0
|
0
|
0
|
my $t = shift; |
420
|
0
|
|
|
|
|
0
|
$t->{token} = read_ident($t->{buffer}); |
421
|
0
|
|
|
|
|
0
|
$t->{type} = "term"; |
422
|
0
|
|
|
|
|
0
|
$t->{char}+= length $t->{token}; |
423
|
0
|
|
|
|
|
0
|
$t->{state} = "OPERATOR"; |
424
|
|
|
|
|
|
|
} |
425
|
|
|
|
|
|
|
|
426
|
|
|
|
|
|
|
sub space { |
427
|
4
|
|
|
4
|
0
|
7
|
my $t = shift; |
428
|
4
|
50
|
|
|
|
19
|
$t->{char}=1, $t->{line}++ if $t->{buffer}=~ s/^\n//; |
429
|
4
|
|
|
|
|
18
|
$t->{buffer} =~ s/^([\t ]+)//s; $t->{char} += length $1; |
|
4
|
|
|
|
|
16
|
|
430
|
4
|
|
|
|
|
18
|
delete $t->{type}; delete $t->{token}; |
|
4
|
|
|
|
|
12
|
|
431
|
|
|
|
|
|
|
} |
432
|
|
|
|
|
|
|
|
433
|
|
|
|
|
|
|
sub inc { |
434
|
0
|
|
|
0
|
0
|
0
|
my $t = shift; |
435
|
0
|
|
|
|
|
0
|
$t->{buffer} =~ s/..//; |
436
|
0
|
|
|
|
|
0
|
$t->{char}+=2; |
437
|
0
|
|
|
|
|
0
|
$t->{token}="++"; |
438
|
0
|
0
|
|
|
|
0
|
$t->{type} = $t->{state} eq "OPERATOR" ? "postinc" : "preinc"; |
439
|
|
|
|
|
|
|
} |
440
|
|
|
|
|
|
|
|
441
|
|
|
|
|
|
|
sub dec { |
442
|
0
|
|
|
0
|
0
|
0
|
my $t = shift; |
443
|
0
|
|
|
|
|
0
|
$t->{buffer} =~ s/..//; |
444
|
0
|
|
|
|
|
0
|
$t->{char}+=2; |
445
|
0
|
|
|
|
|
0
|
$t->{token}="--"; |
446
|
0
|
0
|
|
|
|
0
|
$t->{type} = $t->{state} eq "OPERATOR" ? "postdec" : "predec"; |
447
|
|
|
|
|
|
|
} |
448
|
|
|
|
|
|
|
|
449
|
|
|
|
|
|
|
sub operator { |
450
|
4
|
|
|
4
|
0
|
7
|
my $t = shift; |
451
|
4
|
|
|
|
|
16
|
my %options = @_; |
452
|
4
|
50
|
66
|
|
|
25
|
if ($t->{state} eq "TERM" and not $options{check} eq "no") { |
453
|
0
|
|
0
|
|
|
0
|
$t->{error} = not_op($options{token} || "operator"); |
454
|
0
|
|
|
|
|
0
|
return; |
455
|
|
|
|
|
|
|
} |
456
|
4
|
100
|
|
|
|
13
|
$options{length} = 1 if not defined $options{length}; |
457
|
4
|
|
|
|
|
17
|
my $was = substr($t->{buffer},0,$options{length},""); |
458
|
4
|
|
|
|
|
10
|
$t->{char} += $options{length}; |
459
|
4
|
|
33
|
|
|
30
|
$t->{token} = $options{token} || $was; |
460
|
4
|
|
50
|
|
|
15
|
$t->{type} = $options{type} || "operator"; |
461
|
4
|
|
50
|
|
|
25
|
$t->{state} = $options{state} || "TERM"; |
462
|
|
|
|
|
|
|
} |
463
|
|
|
|
|
|
|
|
464
|
|
|
|
|
|
|
sub term { |
465
|
0
|
|
|
0
|
0
|
0
|
my $t = shift; |
466
|
0
|
|
|
|
|
0
|
my %options = @_; |
467
|
0
|
0
|
0
|
|
|
0
|
if ($t->{state} eq "OPERATOR" and not $options{check} eq "no") { |
468
|
0
|
|
0
|
|
|
0
|
$t->{error} = no_op($options{token} || "term"); |
469
|
0
|
|
|
|
|
0
|
return; |
470
|
|
|
|
|
|
|
} |
471
|
0
|
0
|
|
|
|
0
|
$options{length} = 1 if not defined $options{length}; |
472
|
0
|
|
|
|
|
0
|
my $was = substr($t->{buffer},0,$options{length},""); |
473
|
0
|
|
|
|
|
0
|
$t->{char} += $options{length}; |
474
|
0
|
|
0
|
|
|
0
|
$t->{token} = $options{token} || $was; |
475
|
0
|
|
0
|
|
|
0
|
$t->{type} = $options{type} || "term"; |
476
|
0
|
|
0
|
|
|
0
|
$t->{state} = $options{state} || "OPERATOR"; |
477
|
|
|
|
|
|
|
} |
478
|
|
|
|
|
|
|
|
479
|
|
|
|
|
|
|
sub number { |
480
|
0
|
|
|
0
|
0
|
0
|
$t = shift; |
481
|
0
|
0
|
|
|
|
0
|
$t->{buffer} =~ s/^ |
482
|
|
|
|
|
|
|
( |
483
|
|
|
|
|
|
|
0x[0-9A-Fa-f](_?[0-9A-Fa-f])* |
484
|
|
|
|
|
|
|
| 0[0-7](_?[0-7])* |
485
|
|
|
|
|
|
|
| 0b[01](_?[01])* |
486
|
|
|
|
|
|
|
| \.\d(_?\d)*[Ee][\+\-]?(\d(_?\d)*) |
487
|
|
|
|
|
|
|
| \d(_?\d)*(\.(\d(_?\d)*)?)?[Ee][\+\-]?(\d(_?\d)*) |
488
|
|
|
|
|
|
|
| [\d_]+(\.[\d_]+)? |
489
|
|
|
|
|
|
|
)//x or die "Didn't match $t->{buffer}!"; |
490
|
0
|
|
|
|
|
0
|
$t->{type} = "const", |
491
|
|
|
|
|
|
|
$t->{char} += length $1; |
492
|
0
|
|
|
|
|
0
|
$t->{token} = eval $1; |
493
|
0
|
|
|
|
|
0
|
$t->{state} = "OPERATOR"; |
494
|
|
|
|
|
|
|
} |
495
|
|
|
|
|
|
|
|
496
|
|
|
|
|
|
|
sub bareword { |
497
|
1
|
|
|
1
|
0
|
3
|
$t = shift; |
498
|
1
|
|
|
|
|
6
|
$t->{buffer} =~ s/^(\w+)//; |
499
|
1
|
|
|
|
|
29
|
my $what = $1; |
500
|
1
|
|
|
|
|
3
|
$t->{token} = $what; |
501
|
1
|
50
|
|
|
|
6
|
if ($t->{token} =~ /^(s|tr|y|m|qr)$/) { |
502
|
0
|
|
|
|
|
0
|
($t->{token}, $t->{buffer}) = extract_quotelike($t->{token}.$t->{buffer}); |
503
|
0
|
|
|
|
|
0
|
$t->{type} = "regex"; |
504
|
0
|
|
|
|
|
0
|
$t->{state} = "OPERATOR"; |
505
|
0
|
|
|
|
|
0
|
$t->{char}+= length $t->{token}; # XXX NEWLINES. |
506
|
0
|
|
|
|
|
0
|
return; |
507
|
|
|
|
|
|
|
} |
508
|
1
|
50
|
|
|
|
6
|
if ($t->{token} =~ /^(q|qq|qw|qx)$/) { |
509
|
0
|
|
|
|
|
0
|
($t->{token}, $t->{buffer}) = extract_quotelike($t->{token}.$t->{buffer}); |
510
|
0
|
|
|
|
|
0
|
$t->{type} = "const"; |
511
|
0
|
|
|
|
|
0
|
$t->{state} = "OPERATOR"; |
512
|
0
|
|
|
|
|
0
|
$t->{char}+= length $t->{token}; # XXX NEWLINES. |
513
|
0
|
|
|
|
|
0
|
return; |
514
|
|
|
|
|
|
|
} |
515
|
|
|
|
|
|
|
|
516
|
1
|
|
|
|
|
4
|
$t->{char} += length $what; |
517
|
1
|
50
|
|
|
|
16
|
if ($t->{buffer} =~ s/^((::\w+)+)//) { |
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
518
|
0
|
|
|
|
|
0
|
$t->{token} .= $1; |
519
|
0
|
|
|
|
|
0
|
$t->{type} = "class"; |
520
|
|
|
|
|
|
|
} elsif ($t->{buffer} =~ s/^://) { |
521
|
0
|
|
|
|
|
0
|
$t->{type} = "label"; |
522
|
|
|
|
|
|
|
} elsif ($t->{buffer} =~ /^\s*=>/) { |
523
|
0
|
|
|
|
|
0
|
$t->{type} = "const"; |
524
|
|
|
|
|
|
|
} elsif (exists $keywords{$what}) { |
525
|
0
|
|
|
|
|
0
|
$t->{type} = "key_$what"; |
526
|
0
|
0
|
|
|
|
0
|
$keyword_tokens{$t->{token}}->($t) |
527
|
|
|
|
|
|
|
if exists $keyword_tokens{$t->{token}}; |
528
|
|
|
|
|
|
|
} elsif ($t->{buffer} =~ /^\s*\(/) { |
529
|
|
|
|
|
|
|
# It's a subroutine, so fake up a subroutine call |
530
|
0
|
|
|
|
|
0
|
$t->{next}->{token} = $t->{token}; |
531
|
0
|
|
|
|
|
0
|
$t->{next}->{type} = "bareword"; |
532
|
0
|
|
|
|
|
0
|
$t->{token} = "&"; |
533
|
0
|
|
|
|
|
0
|
$t->{type} = "token"; |
534
|
|
|
|
|
|
|
} else { |
535
|
1
|
|
|
|
|
10
|
$t->{type} = "bareword"; |
536
|
|
|
|
|
|
|
} |
537
|
1
|
|
|
|
|
4
|
$t->{state} = "ANY"; # Hack |
538
|
|
|
|
|
|
|
} |
539
|
|
|
|
|
|
|
|
540
|
|
|
|
|
|
|
sub hyper { |
541
|
0
|
|
|
0
|
0
|
0
|
$t=shift; |
542
|
0
|
|
|
|
|
0
|
$t->{buffer} =~ s/.//; |
543
|
0
|
0
|
|
|
|
0
|
if ($t->{state} ne "OPERATOR") { |
544
|
0
|
|
|
|
|
0
|
$t->{error} = no_op("hyperoperation"); |
545
|
0
|
|
|
|
|
0
|
return; |
546
|
|
|
|
|
|
|
} |
547
|
0
|
0
|
|
|
|
0
|
if ($t->{hyper}) { |
548
|
0
|
|
|
|
|
0
|
$t->{error} = "Can't multiply hyperoperate"; |
549
|
0
|
|
|
|
|
0
|
return; |
550
|
|
|
|
|
|
|
} |
551
|
0
|
|
|
|
|
0
|
$t->{next}->{hyper}=1; |
552
|
|
|
|
|
|
|
} |
553
|
|
|
|
|
|
|
|
554
|
|
|
|
|
|
|
sub quote { |
555
|
0
|
|
|
0
|
0
|
0
|
$t = shift; |
556
|
|
|
|
|
|
|
# Cheat |
557
|
0
|
|
|
|
|
0
|
($t->{token}, $t->{buffer}) = extract_quotelike($t->{buffer}); |
558
|
0
|
|
|
|
|
0
|
$t->{type} = "const"; |
559
|
0
|
|
|
|
|
0
|
for (split //, $t->{token}) { |
560
|
0
|
|
|
|
|
0
|
$t->{char}++; |
561
|
0
|
0
|
|
|
|
0
|
$t->{line}++, $t->{char} = 1 if $_ eq "\n"; |
562
|
|
|
|
|
|
|
} |
563
|
0
|
|
|
|
|
0
|
$t->{state} = "OPERATOR"; |
564
|
|
|
|
|
|
|
} |
565
|
|
|
|
|
|
|
|
566
|
|
|
|
|
|
|
sub comment { |
567
|
0
|
|
|
0
|
0
|
0
|
$t = shift; |
568
|
0
|
|
|
|
|
0
|
$t->{buffer} =~ s/.*//; |
569
|
0
|
|
|
|
|
0
|
$t->{line}++; $t->{char}=1; |
|
0
|
|
|
|
|
0
|
|
570
|
|
|
|
|
|
|
} |
571
|
|
|
|
|
|
|
|
572
|
|
|
|
|
|
|
sub slash { |
573
|
0
|
|
|
0
|
0
|
0
|
my $t= shift; |
574
|
0
|
0
|
|
|
|
0
|
if ($t->{state} eq "OPERATOR") { |
575
|
0
|
|
|
|
|
0
|
return operator($t, type =>"mulop"); |
576
|
|
|
|
|
|
|
} |
577
|
0
|
|
|
|
|
0
|
($t->{token}, $t->{buffer}) = extract_quotelike($t->{buffer}); |
578
|
0
|
|
|
|
|
0
|
$t->{type} = "regex"; |
579
|
0
|
|
|
|
|
0
|
$t->{state} = "OPERATOR"; |
580
|
|
|
|
|
|
|
} |
581
|
|
|
|
|
|
|
|
582
|
|
|
|
|
|
|
sub tripledot { |
583
|
0
|
|
|
0
|
0
|
0
|
my $t = shift; |
584
|
0
|
0
|
|
|
|
0
|
if ($t->{state} eq "OPERATOR") { |
585
|
0
|
|
|
|
|
0
|
return operator($t, type=>"range", length => 3); |
586
|
|
|
|
|
|
|
} else { |
587
|
0
|
|
|
|
|
0
|
return operator($t, type=>"notyet", check=> "no", state=>"ANY", length => 3); |
588
|
|
|
|
|
|
|
} |
589
|
|
|
|
|
|
|
} |
590
|
|
|
|
|
|
|
|
591
|
|
|
|
|
|
|
sub dot { |
592
|
1
|
|
|
1
|
0
|
3
|
my $t = shift; |
593
|
1
|
50
|
|
|
|
7
|
if ($t->{state} eq "OPERATOR") { |
594
|
1
|
|
|
|
|
5
|
return operator($t, type=>"method"); |
595
|
|
|
|
|
|
|
} else { |
596
|
|
|
|
|
|
|
# Dirty hack |
597
|
0
|
|
|
|
|
0
|
$t->{buffer} = '$_'. $t->{buffer}; |
598
|
0
|
|
|
|
|
0
|
$t->{char} -= 2; |
599
|
0
|
|
|
|
|
0
|
delete $t->{token}; delete $t->{type}; |
|
0
|
|
|
|
|
0
|
|
600
|
|
|
|
|
|
|
} |
601
|
|
|
|
|
|
|
} |
602
|
|
|
|
|
|
|
|
603
|
|
|
|
|
|
|
sub filetest { |
604
|
1
|
|
|
1
|
0
|
4
|
my $t = shift; |
605
|
1
|
50
|
|
|
|
10
|
if ($t->{buffer}=~/-\w\w+/) { |
606
|
|
|
|
|
|
|
# I'm not really a filetest |
607
|
0
|
|
|
|
|
0
|
return operator($t, type=>"addop"); # Just return the -, try again |
608
|
|
|
|
|
|
|
} |
609
|
1
|
|
|
|
|
4
|
return operator($t, type=>"filetest", length=>2, check=>"no"); |
610
|
|
|
|
|
|
|
} |
611
|
|
|
|
|
|
|
|
612
|
|
|
|
|
|
|
# Keywords, and what we do with them |
613
|
|
|
|
|
|
|
|
614
|
|
|
|
|
|
|
sub block_or_sub { |
615
|
0
|
|
|
0
|
0
|
|
my $t= shift; |
616
|
0
|
0
|
|
|
|
|
if ($t->{state} eq "STATE") { # XXX |
617
|
0
|
|
|
|
|
|
do_sub($t); |
618
|
|
|
|
|
|
|
} else { |
619
|
0
|
|
|
|
|
|
$t->{type}="bareword"; |
620
|
|
|
|
|
|
|
} |
621
|
|
|
|
|
|
|
} |
622
|
|
|
|
|
|
|
|
623
|
|
|
|
|
|
|
sub uni { |
624
|
0
|
|
|
0
|
0
|
|
my $t = shift; |
625
|
0
|
|
|
|
|
|
$t->{state} = "TERM"; |
626
|
0
|
0
|
|
|
|
|
if ($t->{buffer}=~/^s*\(/) { |
627
|
0
|
|
|
|
|
|
$t->{type} = "func1"; |
628
|
|
|
|
|
|
|
} else { |
629
|
0
|
|
|
|
|
|
$t->{type} = "unop"; |
630
|
|
|
|
|
|
|
} |
631
|
|
|
|
|
|
|
} |
632
|
|
|
|
|
|
|
|
633
|
|
|
|
|
|
|
sub lop { |
634
|
0
|
|
|
0
|
0
|
|
my $t = shift; |
635
|
0
|
|
|
|
|
|
$t->{state} = "TERM"; |
636
|
0
|
0
|
|
|
|
|
if ($t->{next}->{type}) { |
|
|
0
|
|
|
|
|
|
637
|
0
|
|
|
|
|
|
$t->{type} = "listop"; |
638
|
|
|
|
|
|
|
} elsif ($t->{buffer}=~/^s*\(/) { |
639
|
0
|
|
|
|
|
|
$t->{type} = "func"; |
640
|
|
|
|
|
|
|
} else { |
641
|
0
|
|
|
|
|
|
$t->{type} = "listop"; |
642
|
|
|
|
|
|
|
} |
643
|
|
|
|
|
|
|
} |
644
|
|
|
|
|
|
|
|
645
|
|
|
|
|
|
|
__END__ |