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