This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Deparse CORE::break
[perl5.git] / regen / keywords.pl
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
50 my %pos = map { ($_ => 1) } @{$by_strength{'+'}};
51
52 my $t = Devel::Tokenizer::C->new(TokenFunc     => \&perl_keyword,
53                                  TokenString   => 'name',
54                                  StringLength  => 'len',
55                                  MergeSwitches => 1,
56                                 );
57
58 $t->add_tokens(@{$by_strength{'+'}}, @{$by_strength{'-'}}, 'elseif');
59
60 my $switch = $t->generate(Indent => '  ');
61
62 print $c <<"END";
63 #include "EXTERN.h"
64 #define PERL_IN_KEYWORDS_C
65 #include "perl.h"
66 #include "keywords.h"
67
68 I32
69 Perl_keyword (pTHX_ const char *name, I32 len, bool all_keywords)
70 {
71   dVAR;
72
73   PERL_ARGS_ASSERT_KEYWORD;
74
75 $switch
76 unknown:
77   return 0;
78 }
79 END
80
81 sub perl_keyword
82 {
83   my $k = shift;
84   my $sign = $pos{$k} ? '' : '-';
85
86   if ($k eq 'elseif') {
87     return <<END;
88 Perl_ck_warner_d(aTHX_ packWARN(WARN_SYNTAX), "elseif should be elsif");
89 END
90   }
91   elsif (my $feature = $feature_kw{$k}) {
92     $feature =~ s/([\\"])/\\$1/g;
93     return <<END;
94 return (all_keywords || FEATURE_IS_ENABLED("$feature") ? ${sign}KEY_$k : 0);
95 END
96   }
97   return <<END;
98 return ${sign}KEY_$k;
99 END
100 }
101
102 read_only_bottom_close_and_rename($_, [$0]) foreach $c, $h;
103
104 __END__
105
106  NULL
107 -__FILE__
108 -__LINE__
109 -__PACKAGE__
110 +__DATA__
111 +__END__
112 +AUTOLOAD
113 +BEGIN
114 +UNITCHECK
115 -CORE
116 +DESTROY
117 +END
118 +INIT
119 +CHECK
120 -abs
121 -accept
122 -alarm
123 -and
124 -atan2
125 -bind
126 -binmode
127 -bless
128 -break
129 -caller
130 -chdir
131 -chmod
132 -chomp
133 -chop
134 -chown
135 -chr
136 -chroot
137 -close
138 -closedir
139 -cmp
140 -connect
141 -continue
142 -cos
143 -crypt
144 -dbmclose
145 -dbmopen
146 +default
147 +defined
148 +delete
149 -die
150 +do
151 -dump
152 -each
153 +else
154 +elsif
155 -endgrent
156 -endhostent
157 -endnetent
158 -endprotoent
159 -endpwent
160 -endservent
161 -eof
162 -eq
163 +eval
164 -exec
165 +exists
166 -exit
167 -exp
168 -fcntl
169 -fileno
170 -flock
171 +for
172 +foreach
173 -fork
174 +format
175 -formline
176 -ge
177 -getc
178 -getgrent
179 -getgrgid
180 -getgrnam
181 -gethostbyaddr
182 -gethostbyname
183 -gethostent
184 -getlogin
185 -getnetbyaddr
186 -getnetbyname
187 -getnetent
188 -getpeername
189 -getpgrp
190 -getppid
191 -getpriority
192 -getprotobyname
193 -getprotobynumber
194 -getprotoent
195 -getpwent
196 -getpwnam
197 -getpwuid
198 -getservbyname
199 -getservbyport
200 -getservent
201 -getsockname
202 -getsockopt
203 +given
204 +glob
205 -gmtime
206 +goto
207 +grep
208 -gt
209 -hex
210 +if
211 -index
212 -int
213 -ioctl
214 -join
215 -keys
216 -kill
217 +last
218 -lc
219 -lcfirst
220 -le
221 -length
222 -link
223 -listen
224 +local
225 -localtime
226 -lock
227 -log
228 -lstat
229 -lt
230 +m
231 +map
232 -mkdir
233 -msgctl
234 -msgget
235 -msgrcv
236 -msgsnd
237 +my
238 -ne
239 +next
240 +no
241 -not
242 -oct
243 -open
244 -opendir
245 -or
246 -ord
247 +our
248 -pack
249 +package
250 -pipe
251 -pop
252 +pos
253 +print
254 +printf
255 +prototype
256 -push
257 +q
258 +qq
259 +qr
260 -quotemeta
261 +qw
262 +qx
263 -rand
264 -read
265 -readdir
266 -readline
267 -readlink
268 -readpipe
269 -recv
270 +redo
271 -ref
272 -rename
273 +require
274 -reset
275 +return
276 -reverse
277 -rewinddir
278 -rindex
279 -rmdir
280 +s
281 +say
282 +scalar
283 -seek
284 -seekdir
285 -select
286 -semctl
287 -semget
288 -semop
289 -send
290 -setgrent
291 -sethostent
292 -setnetent
293 -setpgrp
294 -setpriority
295 -setprotoent
296 -setpwent
297 -setservent
298 -setsockopt
299 -shift
300 -shmctl
301 -shmget
302 -shmread
303 -shmwrite
304 -shutdown
305 -sin
306 -sleep
307 -socket
308 -socketpair
309 +sort
310 -splice
311 +split
312 -sprintf
313 -sqrt
314 -srand
315 -stat
316 +state
317 +study
318 +sub
319 -substr
320 -symlink
321 -syscall
322 -sysopen
323 -sysread
324 -sysseek
325 -system
326 -syswrite
327 -tell
328 -telldir
329 -tie
330 -tied
331 -time
332 -times
333 +tr
334 -truncate
335 -uc
336 -ucfirst
337 -umask
338 +undef
339 +unless
340 -unlink
341 -unpack
342 -unshift
343 -untie
344 +until
345 +use
346 -utime
347 -values
348 -vec
349 -wait
350 -waitpid
351 -wantarray
352 -warn
353 +when
354 +while
355 -write
356 -x
357 -xor
358 +y