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