This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
More consistent names for all the parameter name/declaration methods
[perl5.git] / perl_keyword.pl
1 #!./perl -w
2
3 # How to generate the logic of the lookup table Perl_keyword() in toke.c
4
5 use strict;
6 package Toke;
7 use vars qw(@ISA %types);
8 require ExtUtils::Constant::Base;
9 @ISA = 'ExtUtils::Constant::Base';
10
11 %types = (pos => "KEY_", neg => "-KEY_");
12
13 # We're allowing scalar references to produce evil customisation.
14 sub valid_type {
15   defined $types{$_[1]} or ref $_[1];
16 }
17
18
19 # This might actually be a return statement
20 sub assignment_clause_for_type {
21   my ($self, $args, $value) = @_;
22   my ($type, $item) = @{$args}{qw(type item)};
23   my $comment = '';
24   $comment = " /* Weight $item->{weight} */" if defined $item->{weight};
25   return "return $types{$type}$value;$comment" if $types{$type};
26   "$$type$value;$comment";
27 }
28
29 sub return_statement_for_notfound {
30   "return 0;"
31 }
32
33 # Ditch the default "const"
34 sub name_param_definition {
35   "char *" . $_[0]->name_param;
36 }
37
38 sub C_constant_return_type {
39   "I32";
40 }
41
42
43 sub C_constant_prefix_param {
44   "aTHX_ ";
45 }
46
47 sub C_constant_prefix_param_defintion {
48   "pTHX_ ";
49 }
50
51 sub namelen_param_definition {
52   'I32 ' . $_[0] -> namelen_param;
53 }
54
55 package main;
56
57 my @pos = qw(__DATA__ __END__ AUTOLOAD BEGIN CHECK DESTROY do delete defined
58              END else eval elsif exists for format foreach grep goto glob INIT
59              if last local m my map next no our pos print printf package
60              prototype q qr qq qw qx redo return require s scalar sort split
61              study sub tr tie tied use undef until untie unless while y);
62
63 my @neg = qw(__FILE__ __LINE__ __PACKAGE__ and abs alarm atan2 accept bless
64              bind binmode CORE cmp chr cos chop close chdir chomp chmod chown
65              crypt chroot caller connect closedir continue die dump dbmopen
66              dbmclose eq eof err exp exit exec each endgrent endpwent
67              endnetent endhostent endservent endprotoent fork fcntl flock
68              fileno formline getppid getpgrp getpwent getpwnam getpwuid
69              getpeername getprotoent getpriority getprotobyname
70              getprotobynumber gethostbyname gethostbyaddr gethostent
71              getnetbyname getnetbyaddr getnetent getservbyname getservbyport
72              getservent getsockname getsockopt getgrent getgrnam getgrgid
73              getlogin getc gt ge gmtime hex int index ioctl join keys kill lt
74              le lc log link lock lstat length listen lcfirst localtime mkdir
75              msgctl msgget msgrcv msgsnd ne not or ord oct open opendir pop
76              push pack pipe quotemeta ref read rand recv rmdir reset rename
77              rindex reverse readdir readlink readline readpipe rewinddir seek
78              send semop select semctl semget setpgrp seekdir setpwent setgrent
79              setnetent setsockopt sethostent setservent setpriority
80              setprotoent shift shmctl shmget shmread shmwrite shutdown sin
81              sleep socket socketpair sprintf splice sqrt srand stat substr
82              system symlink syscall sysopen sysread sysseek syswrite tell time
83              times telldir truncate uc utime umask unpack unlink unshift
84              ucfirst values vec warn wait write waitpid wantarray x xor);
85
86 my %frequencies = (map {/(.*):\t(.*)/} <DATA>);
87
88 my @names;
89 push @names, map {{name=>$_, type=>"pos", weight=>$frequencies{$_}}} @pos;
90 push @names, map {{name=>$_, type=>"neg", weight=>$frequencies{$_}}} @neg;
91 push @names, {name=>'elseif', type=>\"", value=><<'EOC'};
92 /* This is somewhat hacky.  */
93 if(ckWARN_d(WARN_SYNTAX))
94   Perl_warner(aTHX_ packWARN(WARN_SYNTAX), "elseif should be elsif");
95 break;
96 EOC
97
98 print Toke->C_constant ({subname=>'Perl_keyword', breakout=>~0}, @names);
99
100 __DATA__
101 my:     3785925
102 if:     2482605
103 sub:    2053554
104 return: 1401629
105 unless: 913955
106 shift:  904125
107 eq:     797065
108 defined:        694277
109 use:    686081
110 else:   527806
111 qw:     415641
112 or:     405163
113 s:      403691
114 require:        375220
115 ref:    347102
116 elsif:  322365
117 undef:  311156
118 and:    284867
119 foreach:        281720
120 local:  262973
121 push:   256975
122 package:        245661
123 print:  220904
124 our:    194417
125 die:    192203
126 length: 163975
127 next:   153355
128 m:      148776
129 caller: 148457
130 exists: 145939
131 eval:   136977
132 keys:   131427
133 join:   130820
134 substr: 121344
135 while:  120305
136 for:    118158
137 map:    115207
138 ne:     112906
139 __END__:        112636
140 vec:    110566
141 goto:   109258
142 do:     96004
143 last:   95078
144 split:  93678
145 warn:   91372
146 grep:   75912
147 delete: 74966
148 sprintf:        72704
149 q:      69076
150 bless:  62111
151 no:     61989
152 not:    55868
153 qq:     55149
154 index:  51465
155 CORE:   47391
156 pop:    46933
157 close:  44077
158 scalar: 43953
159 wantarray:      43024
160 open:   39060
161 x:      38549
162 lc:     38487
163 __PACKAGE__:    36767
164 stat:   36702
165 unshift:        36504
166 sort:   36394
167 chr:    35654
168 time:   32168
169 qr:     28519
170 splice: 25143
171 BEGIN:  24125
172 tr:     22665
173 chomp:  22337
174 ord:    22221
175 chdir:  20317
176 unlink: 18616
177 int:    18549
178 chmod:  18455
179 each:   18414
180 uc:     16961
181 pack:   14491
182 lstat:  13859
183 binmode:        12301
184 select: 12209
185 closedir:       11986
186 readdir:        11716
187 reverse:        10571
188 chop:   10172
189 tie:    10131
190 values: 10110
191 tied:   9749
192 read:   9434
193 opendir:        9007
194 fileno: 8591
195 exit:   8262
196 localtime:      7993
197 unpack: 7849
198 abs:    7767
199 printf: 6874
200 cmp:    6808
201 ge:     5666
202 pos:    5503
203 redo:   5219
204 rindex: 5005
205 rename: 4918
206 syswrite:       4437
207 system: 4326
208 lock:   4210
209 oct:    4195
210 le:     4052
211 gmtime: 4040
212 utime:  3849
213 sysread:        3729
214 hex:    3629
215 END:    3565
216 quotemeta:      3120
217 mkdir:  2951
218 continue:       2925
219 AUTOLOAD:       2713
220 tell:   2578
221 write:  2525
222 rmdir:  2493
223 seek:   2174
224 glob:   2172
225 study:  1933
226 rand:   1824
227 format: 1735
228 umask:  1658
229 eof:    1618
230 prototype:      1602
231 readlink:       1537
232 truncate:       1351
233 fcntl:  1257
234 sysopen:        1230
235 ucfirst:        1012
236 getc:   981
237 gethostbyname:  970
238 ioctl:  967
239 formline:       959
240 gt:     897
241 __FILE__:       888
242 until:  818
243 sqrt:   766
244 getprotobyname: 755
245 sysseek:        721
246 getpeername:    713
247 getpwuid:       681
248 xor:    619
249 y:      567
250 syscall:        560
251 CHECK:  538
252 connect:        526
253 err:    522
254 sleep:  519
255 sin:    499
256 send:   496
257 getpwnam:       483
258 cos:    447
259 exec:   429
260 link:   425
261 exp:    423
262 untie:  420
263 INIT:   418
264 waitpid:        414
265 __DATA__:       395
266 symlink:        386
267 kill:   382
268 setsockopt:     356
269 atan2:  350
270 pipe:   344
271 lt:     335
272 fork:   327
273 times:  310
274 getservbyname:  299
275 telldir:        294
276 bind:   290
277 dump:   274
278 flock:  260
279 recv:   250
280 getsockopt:     243
281 getsockname:    235
282 accept: 233
283 getprotobynumber:       232
284 rewinddir:      218
285 __LINE__:       209
286 qx:     177
287 lcfirst:        165
288 getlogin:       158
289 reset:  127
290 gethostbyaddr:  68
291 getgrgid:       67
292 srand:  41
293 chown:  34
294 seekdir:        20
295 readline:       19
296 semctl: 17
297 getpwent:       12
298 getgrnam:       11
299 getppid:        10
300 crypt:  8
301 DESTROY:        7
302 getpriority:    5
303 getservent:     4
304 gethostent:     3
305 setpriority:    2
306 setnetent:      1