Commit | Line | Data |
d30bcfc1 |
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" |
f8901870 |
34 | sub name_param_definition { |
d30bcfc1 |
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 | |
f8901870 |
51 | sub namelen_param_definition { |
52 | 'I32 ' . $_[0] -> namelen_param; |
d30bcfc1 |
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 |