From: Nicholas Clark Date: Mon, 24 Jan 2005 22:06:05 +0000 (+0000) Subject: A script to regenerate Perl_keyword() X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=d30bcfc16b8d58581237bdcf9a2169c169d9b26f;p=p5sagit%2Fp5-mst-13.2.git A script to regenerate Perl_keyword() p4raw-id: //depot/perl@23877 --- diff --git a/MANIFEST b/MANIFEST index 3db53b5..493acb0 100644 --- a/MANIFEST +++ b/MANIFEST @@ -2180,6 +2180,7 @@ perly.c parser code (NOT derived from perly.y) perly.h header file for perly.c; derived from perly.y perly.tab parser state tables; derived from perly.y perly.y Yacc grammar for perl +perl_keyword.pl A script to generate Perl_keyword() in toke.c plan9/aperl Shell to make Perl error messages Acme-friendly plan9/arpa/inet.h Plan9 port: replacement C header file plan9/buildinfo Plan9 port: configuration information diff --git a/perl_keyword.pl b/perl_keyword.pl new file mode 100644 index 0000000..a8c015e --- /dev/null +++ b/perl_keyword.pl @@ -0,0 +1,306 @@ +#!./perl -w + +# How to generate the logic of the lookup table Perl_keyword() in toke.c + +use strict; +package Toke; +use vars qw(@ISA %types); +require ExtUtils::Constant::Base; +@ISA = 'ExtUtils::Constant::Base'; + +%types = (pos => "KEY_", neg => "-KEY_"); + +# We're allowing scalar references to produce evil customisation. +sub valid_type { + defined $types{$_[1]} or ref $_[1]; +} + + +# This might actually be a return statement +sub assignment_clause_for_type { + my ($self, $args, $value) = @_; + my ($type, $item) = @{$args}{qw(type item)}; + my $comment = ''; + $comment = " /* Weight $item->{weight} */" if defined $item->{weight}; + return "return $types{$type}$value;$comment" if $types{$type}; + "$$type$value;$comment"; +} + +sub return_statement_for_notfound { + "return 0;" +} + +# Ditch the default "const" +sub C_constant_name_param_definition { + "char *" . $_[0]->name_param; +} + +sub C_constant_return_type { + "I32"; +} + + +sub C_constant_prefix_param { + "aTHX_ "; +} + +sub C_constant_prefix_param_defintion { + "pTHX_ "; +} + +sub C_constant_namelen_param_definition { + 'I32 ' . $_[0] -> C_constant_namelen_param; +} + +package main; + +my @pos = qw(__DATA__ __END__ AUTOLOAD BEGIN CHECK DESTROY do delete defined + END else eval elsif exists for format foreach grep goto glob INIT + if last local m my map next no our pos print printf package + prototype q qr qq qw qx redo return require s scalar sort split + study sub tr tie tied use undef until untie unless while y); + +my @neg = qw(__FILE__ __LINE__ __PACKAGE__ and abs alarm atan2 accept bless + bind binmode CORE cmp chr cos chop close chdir chomp chmod chown + crypt chroot caller connect closedir continue die dump dbmopen + dbmclose eq eof err exp exit exec each endgrent endpwent + endnetent endhostent endservent endprotoent fork fcntl flock + fileno formline getppid getpgrp getpwent getpwnam getpwuid + getpeername getprotoent getpriority getprotobyname + getprotobynumber gethostbyname gethostbyaddr gethostent + getnetbyname getnetbyaddr getnetent getservbyname getservbyport + getservent getsockname getsockopt getgrent getgrnam getgrgid + getlogin getc gt ge gmtime hex int index ioctl join keys kill lt + le lc log link lock lstat length listen lcfirst localtime mkdir + msgctl msgget msgrcv msgsnd ne not or ord oct open opendir pop + push pack pipe quotemeta ref read rand recv rmdir reset rename + rindex reverse readdir readlink readline readpipe rewinddir seek + send semop select semctl semget setpgrp seekdir setpwent setgrent + setnetent setsockopt sethostent setservent setpriority + setprotoent shift shmctl shmget shmread shmwrite shutdown sin + sleep socket socketpair sprintf splice sqrt srand stat substr + system symlink syscall sysopen sysread sysseek syswrite tell time + times telldir truncate uc utime umask unpack unlink unshift + ucfirst values vec warn wait write waitpid wantarray x xor); + +my %frequencies = (map {/(.*):\t(.*)/} ); + +my @names; +push @names, map {{name=>$_, type=>"pos", weight=>$frequencies{$_}}} @pos; +push @names, map {{name=>$_, type=>"neg", weight=>$frequencies{$_}}} @neg; +push @names, {name=>'elseif', type=>\"", value=><<'EOC'}; +/* This is somewhat hacky. */ +if(ckWARN_d(WARN_SYNTAX)) + Perl_warner(aTHX_ packWARN(WARN_SYNTAX), "elseif should be elsif"); +break; +EOC + +print Toke->C_constant ({subname=>'Perl_keyword', breakout=>~0}, @names); + +__DATA__ +my: 3785925 +if: 2482605 +sub: 2053554 +return: 1401629 +unless: 913955 +shift: 904125 +eq: 797065 +defined: 694277 +use: 686081 +else: 527806 +qw: 415641 +or: 405163 +s: 403691 +require: 375220 +ref: 347102 +elsif: 322365 +undef: 311156 +and: 284867 +foreach: 281720 +local: 262973 +push: 256975 +package: 245661 +print: 220904 +our: 194417 +die: 192203 +length: 163975 +next: 153355 +m: 148776 +caller: 148457 +exists: 145939 +eval: 136977 +keys: 131427 +join: 130820 +substr: 121344 +while: 120305 +for: 118158 +map: 115207 +ne: 112906 +__END__: 112636 +vec: 110566 +goto: 109258 +do: 96004 +last: 95078 +split: 93678 +warn: 91372 +grep: 75912 +delete: 74966 +sprintf: 72704 +q: 69076 +bless: 62111 +no: 61989 +not: 55868 +qq: 55149 +index: 51465 +CORE: 47391 +pop: 46933 +close: 44077 +scalar: 43953 +wantarray: 43024 +open: 39060 +x: 38549 +lc: 38487 +__PACKAGE__: 36767 +stat: 36702 +unshift: 36504 +sort: 36394 +chr: 35654 +time: 32168 +qr: 28519 +splice: 25143 +BEGIN: 24125 +tr: 22665 +chomp: 22337 +ord: 22221 +chdir: 20317 +unlink: 18616 +int: 18549 +chmod: 18455 +each: 18414 +uc: 16961 +pack: 14491 +lstat: 13859 +binmode: 12301 +select: 12209 +closedir: 11986 +readdir: 11716 +reverse: 10571 +chop: 10172 +tie: 10131 +values: 10110 +tied: 9749 +read: 9434 +opendir: 9007 +fileno: 8591 +exit: 8262 +localtime: 7993 +unpack: 7849 +abs: 7767 +printf: 6874 +cmp: 6808 +ge: 5666 +pos: 5503 +redo: 5219 +rindex: 5005 +rename: 4918 +syswrite: 4437 +system: 4326 +lock: 4210 +oct: 4195 +le: 4052 +gmtime: 4040 +utime: 3849 +sysread: 3729 +hex: 3629 +END: 3565 +quotemeta: 3120 +mkdir: 2951 +continue: 2925 +AUTOLOAD: 2713 +tell: 2578 +write: 2525 +rmdir: 2493 +seek: 2174 +glob: 2172 +study: 1933 +rand: 1824 +format: 1735 +umask: 1658 +eof: 1618 +prototype: 1602 +readlink: 1537 +truncate: 1351 +fcntl: 1257 +sysopen: 1230 +ucfirst: 1012 +getc: 981 +gethostbyname: 970 +ioctl: 967 +formline: 959 +gt: 897 +__FILE__: 888 +until: 818 +sqrt: 766 +getprotobyname: 755 +sysseek: 721 +getpeername: 713 +getpwuid: 681 +xor: 619 +y: 567 +syscall: 560 +CHECK: 538 +connect: 526 +err: 522 +sleep: 519 +sin: 499 +send: 496 +getpwnam: 483 +cos: 447 +exec: 429 +link: 425 +exp: 423 +untie: 420 +INIT: 418 +waitpid: 414 +__DATA__: 395 +symlink: 386 +kill: 382 +setsockopt: 356 +atan2: 350 +pipe: 344 +lt: 335 +fork: 327 +times: 310 +getservbyname: 299 +telldir: 294 +bind: 290 +dump: 274 +flock: 260 +recv: 250 +getsockopt: 243 +getsockname: 235 +accept: 233 +getprotobynumber: 232 +rewinddir: 218 +__LINE__: 209 +qx: 177 +lcfirst: 165 +getlogin: 158 +reset: 127 +gethostbyaddr: 68 +getgrgid: 67 +srand: 41 +chown: 34 +seekdir: 20 +readline: 19 +semctl: 17 +getpwent: 12 +getgrnam: 11 +getppid: 10 +crypt: 8 +DESTROY: 7 +getpriority: 5 +getservent: 4 +gethostent: 3 +setpriority: 2 +setnetent: 1