Mercurial > repo
comparison perl-5.22.2/regen/keywords.pl @ 8045:a16537d2fe07
<xfix> tar xf perl-5.22.2.tar.gz # Ah, whatever, I\'m doing it anyway
author | HackBot |
---|---|
date | Sat, 14 May 2016 14:54:38 +0000 |
parents | |
children |
comparison
equal
deleted
inserted
replaced
8044:711c038a7dce | 8045:a16537d2fe07 |
---|---|
1 #!/usr/bin/perl -w | |
2 # | |
3 # Regenerate (overwriting only if changed): | |
4 # | |
5 # keywords.h keywords.c | |
6 # | |
7 # from information stored in the DATA section of this file. | |
8 # | |
9 # Accepts the standard regen_lib -q and -v args. | |
10 | |
11 use strict; | |
12 use Devel::Tokenizer::C 0.05; | |
13 | |
14 require 'regen/regen_lib.pl'; | |
15 | |
16 my $h = open_new('keywords.h', '>', | |
17 { by => 'regen/keywords.pl', from => 'its data', | |
18 file => 'keywords.h', style => '*', | |
19 copyright => [1994 .. 1997, 1999 .. 2002, 2005 .. 2007]}); | |
20 my $c = open_new('keywords.c', '>', | |
21 { by => 'regen/keywords.pl', from => 'its data', style => '*'}); | |
22 | |
23 my %by_strength; | |
24 | |
25 my $keynum = 0; | |
26 while (<DATA>) { | |
27 chop; | |
28 next unless $_; | |
29 next if /^#/; | |
30 my ($strength, $keyword) = /^([- +])([A-Z_a-z2]+)/; | |
31 die "Bad line '$_'" unless defined $strength; | |
32 print $h tab(5, "#define KEY_$keyword"), $keynum++, "\n"; | |
33 push @{$by_strength{$strength}}, $keyword; | |
34 } | |
35 | |
36 # If this hash changes, make sure the equivalent hash in | |
37 # dist/B-Deparse/Deparse.pm is also updated. | |
38 my %feature_kw = ( | |
39 given => 'switch', | |
40 when => 'switch', | |
41 default => 'switch', | |
42 # continue is already a keyword | |
43 break => 'switch', | |
44 | |
45 say => 'say', | |
46 | |
47 state => 'state', | |
48 | |
49 evalbytes=>'evalbytes', | |
50 | |
51 __SUB__ => '__SUB__', | |
52 | |
53 fc => 'fc', | |
54 ); | |
55 | |
56 my %pos = map { ($_ => 1) } @{$by_strength{'+'}}; | |
57 | |
58 my $t = Devel::Tokenizer::C->new(TokenFunc => \&perl_keyword, | |
59 TokenString => 'name', | |
60 StringLength => 'len', | |
61 MergeSwitches => 1, | |
62 ); | |
63 | |
64 $t->add_tokens(@{$by_strength{'+'}}, @{$by_strength{'-'}}, 'elseif'); | |
65 | |
66 my $switch = $t->generate(Indent => ' '); | |
67 | |
68 print $c <<"END"; | |
69 #include "EXTERN.h" | |
70 #define PERL_IN_KEYWORDS_C | |
71 #include "perl.h" | |
72 #include "keywords.h" | |
73 #include "feature.h" | |
74 | |
75 I32 | |
76 Perl_keyword (pTHX_ const char *name, I32 len, bool all_keywords) | |
77 { | |
78 PERL_ARGS_ASSERT_KEYWORD; | |
79 | |
80 $switch | |
81 unknown: | |
82 return 0; | |
83 } | |
84 END | |
85 | |
86 sub perl_keyword | |
87 { | |
88 my $k = shift; | |
89 my $sign = $pos{$k} ? '' : '-'; | |
90 | |
91 if ($k eq 'elseif') { | |
92 return <<END; | |
93 Perl_ck_warner_d(aTHX_ packWARN(WARN_SYNTAX), "elseif should be elsif"); | |
94 END | |
95 } | |
96 elsif (my $feature = $feature_kw{$k}) { | |
97 $feature =~ s/([\\"])/\\$1/g; | |
98 return <<END; | |
99 return (all_keywords || FEATURE_\U$feature\E_IS_ENABLED ? ${sign}KEY_$k : 0); | |
100 END | |
101 } | |
102 return <<END; | |
103 return ${sign}KEY_$k; | |
104 END | |
105 } | |
106 | |
107 read_only_bottom_close_and_rename($_, [$0]) foreach $c, $h; | |
108 | |
109 | |
110 # coresub_op in op.c expects __FILE__, __LINE__ and __PACKAGE__ to be the | |
111 # first three. | |
112 | |
113 __END__ | |
114 | |
115 NULL | |
116 -__FILE__ | |
117 -__LINE__ | |
118 -__PACKAGE__ | |
119 +__DATA__ | |
120 +__END__ | |
121 -__SUB__ | |
122 +AUTOLOAD | |
123 +BEGIN | |
124 +UNITCHECK | |
125 +DESTROY | |
126 +END | |
127 +INIT | |
128 +CHECK | |
129 -abs | |
130 -accept | |
131 -alarm | |
132 -and | |
133 -atan2 | |
134 -bind | |
135 -binmode | |
136 -bless | |
137 -break | |
138 -caller | |
139 -chdir | |
140 -chmod | |
141 -chomp | |
142 -chop | |
143 -chown | |
144 -chr | |
145 -chroot | |
146 -close | |
147 -closedir | |
148 -cmp | |
149 -connect | |
150 -continue | |
151 -cos | |
152 -crypt | |
153 -dbmclose | |
154 -dbmopen | |
155 +default | |
156 +defined | |
157 +delete | |
158 -die | |
159 +do | |
160 -dump | |
161 -each | |
162 +else | |
163 +elsif | |
164 -endgrent | |
165 -endhostent | |
166 -endnetent | |
167 -endprotoent | |
168 -endpwent | |
169 -endservent | |
170 -eof | |
171 -eq | |
172 +eval | |
173 -evalbytes | |
174 -exec | |
175 +exists | |
176 -exit | |
177 -exp | |
178 -fc | |
179 -fcntl | |
180 -fileno | |
181 -flock | |
182 +for | |
183 +foreach | |
184 -fork | |
185 +format | |
186 -formline | |
187 -ge | |
188 -getc | |
189 -getgrent | |
190 -getgrgid | |
191 -getgrnam | |
192 -gethostbyaddr | |
193 -gethostbyname | |
194 -gethostent | |
195 -getlogin | |
196 -getnetbyaddr | |
197 -getnetbyname | |
198 -getnetent | |
199 -getpeername | |
200 -getpgrp | |
201 -getppid | |
202 -getpriority | |
203 -getprotobyname | |
204 -getprotobynumber | |
205 -getprotoent | |
206 -getpwent | |
207 -getpwnam | |
208 -getpwuid | |
209 -getservbyname | |
210 -getservbyport | |
211 -getservent | |
212 -getsockname | |
213 -getsockopt | |
214 +given | |
215 +glob | |
216 -gmtime | |
217 +goto | |
218 +grep | |
219 -gt | |
220 -hex | |
221 +if | |
222 -index | |
223 -int | |
224 -ioctl | |
225 -join | |
226 -keys | |
227 -kill | |
228 +last | |
229 -lc | |
230 -lcfirst | |
231 -le | |
232 -length | |
233 -link | |
234 -listen | |
235 +local | |
236 -localtime | |
237 -lock | |
238 -log | |
239 -lstat | |
240 -lt | |
241 +m | |
242 +map | |
243 -mkdir | |
244 -msgctl | |
245 -msgget | |
246 -msgrcv | |
247 -msgsnd | |
248 +my | |
249 -ne | |
250 +next | |
251 +no | |
252 -not | |
253 -oct | |
254 -open | |
255 -opendir | |
256 -or | |
257 -ord | |
258 +our | |
259 -pack | |
260 +package | |
261 -pipe | |
262 -pop | |
263 +pos | |
264 +print | |
265 +printf | |
266 +prototype | |
267 -push | |
268 +q | |
269 +qq | |
270 +qr | |
271 -quotemeta | |
272 +qw | |
273 +qx | |
274 -rand | |
275 -read | |
276 -readdir | |
277 -readline | |
278 -readlink | |
279 -readpipe | |
280 -recv | |
281 +redo | |
282 -ref | |
283 -rename | |
284 +require | |
285 -reset | |
286 +return | |
287 -reverse | |
288 -rewinddir | |
289 -rindex | |
290 -rmdir | |
291 +s | |
292 +say | |
293 +scalar | |
294 -seek | |
295 -seekdir | |
296 -select | |
297 -semctl | |
298 -semget | |
299 -semop | |
300 -send | |
301 -setgrent | |
302 -sethostent | |
303 -setnetent | |
304 -setpgrp | |
305 -setpriority | |
306 -setprotoent | |
307 -setpwent | |
308 -setservent | |
309 -setsockopt | |
310 -shift | |
311 -shmctl | |
312 -shmget | |
313 -shmread | |
314 -shmwrite | |
315 -shutdown | |
316 -sin | |
317 -sleep | |
318 -socket | |
319 -socketpair | |
320 +sort | |
321 -splice | |
322 +split | |
323 -sprintf | |
324 -sqrt | |
325 -srand | |
326 -stat | |
327 +state | |
328 +study | |
329 +sub | |
330 -substr | |
331 -symlink | |
332 -syscall | |
333 -sysopen | |
334 -sysread | |
335 -sysseek | |
336 -system | |
337 -syswrite | |
338 -tell | |
339 -telldir | |
340 -tie | |
341 -tied | |
342 -time | |
343 -times | |
344 +tr | |
345 -truncate | |
346 -uc | |
347 -ucfirst | |
348 -umask | |
349 +undef | |
350 +unless | |
351 -unlink | |
352 -unpack | |
353 -unshift | |
354 -untie | |
355 +until | |
356 +use | |
357 -utime | |
358 -values | |
359 -vec | |
360 -wait | |
361 -waitpid | |
362 -wantarray | |
363 -warn | |
364 +when | |
365 +while | |
366 -write | |
367 -x | |
368 -xor | |
369 +y |