AUTHORS: better email address
[perl.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         evalbytes=>'evalbytes',
50
51         __SUB__ => '__SUB__',
52         );
53
54 my %pos = map { ($_ => 1) } @{$by_strength{'+'}};
55
56 my $t = Devel::Tokenizer::C->new(TokenFunc     => \&perl_keyword,
57                                  TokenString   => 'name',
58                                  StringLength  => 'len',
59                                  MergeSwitches => 1,
60                                 );
61
62 $t->add_tokens(@{$by_strength{'+'}}, @{$by_strength{'-'}}, 'elseif');
63
64 my $switch = $t->generate(Indent => '  ');
65
66 print $c <<"END";
67 #include "EXTERN.h"
68 #define PERL_IN_KEYWORDS_C
69 #include "perl.h"
70 #include "keywords.h"
71
72 I32
73 Perl_keyword (pTHX_ const char *name, I32 len, bool all_keywords)
74 {
75   dVAR;
76
77   PERL_ARGS_ASSERT_KEYWORD;
78
79 $switch
80 unknown:
81   return 0;
82 }
83 END
84
85 sub perl_keyword
86 {
87   my $k = shift;
88   my $sign = $pos{$k} ? '' : '-';
89
90   if ($k eq 'elseif') {
91     return <<END;
92 Perl_ck_warner_d(aTHX_ packWARN(WARN_SYNTAX), "elseif should be elsif");
93 END
94   }
95   elsif (my $feature = $feature_kw{$k}) {
96     $feature =~ s/([\\"])/\\$1/g;
97     return <<END;
98 return (all_keywords || FEATURE_IS_ENABLED("$feature") ? ${sign}KEY_$k : 0);
99 END
100   }
101   return <<END;
102 return ${sign}KEY_$k;
103 END
104 }
105
106 read_only_bottom_close_and_rename($_, [$0]) foreach $c, $h;
107
108
109 # coresub_op in op.c expects __FILE__, __LINE__ and __PACKAGE__ to be the
110 # first three.
111
112 __END__
113
114  NULL
115 -__FILE__
116 -__LINE__
117 -__PACKAGE__
118 +__DATA__
119 +__END__
120 -__SUB__
121 +AUTOLOAD
122 +BEGIN
123 +UNITCHECK
124 -CORE
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 -fcntl
179 -fileno
180 -flock
181 +for
182 +foreach
183 -fork
184 +format
185 -formline
186 -ge
187 -getc
188 -getgrent
189 -getgrgid
190 -getgrnam
191 -gethostbyaddr
192 -gethostbyname
193 -gethostent
194 -getlogin
195 -getnetbyaddr
196 -getnetbyname
197 -getnetent
198 -getpeername
199 -getpgrp
200 -getppid
201 -getpriority
202 -getprotobyname
203 -getprotobynumber
204 -getprotoent
205 -getpwent
206 -getpwnam
207 -getpwuid
208 -getservbyname
209 -getservbyport
210 -getservent
211 -getsockname
212 -getsockopt
213 +given
214 +glob
215 -gmtime
216 +goto
217 +grep
218 -gt
219 -hex
220 +if
221 -index
222 -int
223 -ioctl
224 -join
225 -keys
226 -kill
227 +last
228 -lc
229 -lcfirst
230 -le
231 -length
232 -link
233 -listen
234 +local
235 -localtime
236 -lock
237 -log
238 -lstat
239 -lt
240 +m
241 +map
242 -mkdir
243 -msgctl
244 -msgget
245 -msgrcv
246 -msgsnd
247 +my
248 -ne
249 +next
250 +no
251 -not
252 -oct
253 -open
254 -opendir
255 -or
256 -ord
257 +our
258 -pack
259 +package
260 -pipe
261 -pop
262 +pos
263 +print
264 +printf
265 +prototype
266 -push
267 +q
268 +qq
269 +qr
270 -quotemeta
271 +qw
272 +qx
273 -rand
274 -read
275 -readdir
276 -readline
277 -readlink
278 -readpipe
279 -recv
280 +redo
281 -ref
282 -rename
283 +require
284 -reset
285 +return
286 -reverse
287 -rewinddir
288 -rindex
289 -rmdir
290 +s
291 +say
292 +scalar
293 -seek
294 -seekdir
295 -select
296 -semctl
297 -semget
298 -semop
299 -send
300 -setgrent
301 -sethostent
302 -setnetent
303 -setpgrp
304 -setpriority
305 -setprotoent
306 -setpwent
307 -setservent
308 -setsockopt
309 -shift
310 -shmctl
311 -shmget
312 -shmread
313 -shmwrite
314 -shutdown
315 -sin
316 -sleep
317 -socket
318 -socketpair
319 +sort
320 -splice
321 +split
322 -sprintf
323 -sqrt
324 -srand
325 -stat
326 +state
327 +study
328 +sub
329 -substr
330 -symlink
331 -syscall
332 -sysopen
333 -sysread
334 -sysseek
335 -system
336 -syswrite
337 -tell
338 -telldir
339 -tie
340 -tied
341 -time
342 -times
343 +tr
344 -truncate
345 -uc
346 -ucfirst
347 -umask
348 +undef
349 +unless
350 -unlink
351 -unpack
352 -unshift
353 -untie
354 +until
355 +use
356 -utime
357 -values
358 -vec
359 -wait
360 -waitpid
361 -wantarray
362 -warn
363 +when
364 +while
365 -write
366 -x
367 -xor
368 +y