diff options
author | Stuart Henderson <sthen@cvs.openbsd.org> | 2013-03-25 20:09:46 +0000 |
---|---|---|
committer | Stuart Henderson <sthen@cvs.openbsd.org> | 2013-03-25 20:09:46 +0000 |
commit | 6eda9412f8dc717200dec22c57afdd2a46edfa8e (patch) | |
tree | c835d11c3e3f90de6a8561320ec54f077bfd358f /gnu/usr.bin/perl/regen/keywords.pl | |
parent | 19adbb7d6dbd1516758cad91978165088a19e917 (diff) |
import perl 5.16.3 from CPAN - worked on by Andrew Fresh and myself
Diffstat (limited to 'gnu/usr.bin/perl/regen/keywords.pl')
-rw-r--r-- | gnu/usr.bin/perl/regen/keywords.pl | 372 |
1 files changed, 372 insertions, 0 deletions
diff --git a/gnu/usr.bin/perl/regen/keywords.pl b/gnu/usr.bin/perl/regen/keywords.pl new file mode 100644 index 00000000000..b783d08f770 --- /dev/null +++ b/gnu/usr.bin/perl/regen/keywords.pl @@ -0,0 +1,372 @@ +#!/usr/bin/perl -w +# +# Regenerate (overwriting only if changed): +# +# keywords.h keywords.c +# +# from information stored in the DATA section of this file. +# +# Accepts the standard regen_lib -q and -v args. + +use strict; +use Devel::Tokenizer::C 0.05; + +require 'regen/regen_lib.pl'; + +my $h = open_new('keywords.h', '>', + { by => 'regen/keywords.pl', from => 'its data', + file => 'keywords.h', style => '*', + copyright => [1994 .. 1997, 1999 .. 2002, 2005 .. 2007]}); +my $c = open_new('keywords.c', '>', + { by => 'regen/keywords.pl', from => 'its data', style => '*'}); + +my %by_strength; + +my $keynum = 0; +while (<DATA>) { + chop; + next unless $_; + next if /^#/; + my ($strength, $keyword) = /^([- +])([A-Z_a-z2]+)/; + die "Bad line '$_'" unless defined $strength; + print $h tab(5, "#define KEY_$keyword"), $keynum++, "\n"; + push @{$by_strength{$strength}}, $keyword; +} + +# If this hash changes, make sure the equivalent hash in +# dist/B-Deparse/Deparse.pm is also updated. +my %feature_kw = ( + given => 'switch', + when => 'switch', + default => 'switch', + # continue is already a keyword + break => 'switch', + + say => 'say', + + state => 'state', + + evalbytes=>'evalbytes', + + __SUB__ => '__SUB__', + + fc => 'fc', + ); + +my %pos = map { ($_ => 1) } @{$by_strength{'+'}}; + +my $t = Devel::Tokenizer::C->new(TokenFunc => \&perl_keyword, + TokenString => 'name', + StringLength => 'len', + MergeSwitches => 1, + ); + +$t->add_tokens(@{$by_strength{'+'}}, @{$by_strength{'-'}}, 'elseif'); + +my $switch = $t->generate(Indent => ' '); + +print $c <<"END"; +#include "EXTERN.h" +#define PERL_IN_KEYWORDS_C +#include "perl.h" +#include "keywords.h" +#include "feature.h" + +I32 +Perl_keyword (pTHX_ const char *name, I32 len, bool all_keywords) +{ + dVAR; + + PERL_ARGS_ASSERT_KEYWORD; + +$switch +unknown: + return 0; +} +END + +sub perl_keyword +{ + my $k = shift; + my $sign = $pos{$k} ? '' : '-'; + + if ($k eq 'elseif') { + return <<END; +Perl_ck_warner_d(aTHX_ packWARN(WARN_SYNTAX), "elseif should be elsif"); +END + } + elsif (my $feature = $feature_kw{$k}) { + $feature =~ s/([\\"])/\\$1/g; + return <<END; +return (all_keywords || FEATURE_\U$feature\E_IS_ENABLED ? ${sign}KEY_$k : 0); +END + } + return <<END; +return ${sign}KEY_$k; +END +} + +read_only_bottom_close_and_rename($_, [$0]) foreach $c, $h; + + +# coresub_op in op.c expects __FILE__, __LINE__ and __PACKAGE__ to be the +# first three. + +__END__ + + NULL +-__FILE__ +-__LINE__ +-__PACKAGE__ ++__DATA__ ++__END__ +-__SUB__ ++AUTOLOAD ++BEGIN ++UNITCHECK +-CORE ++DESTROY ++END ++INIT ++CHECK +-abs +-accept +-alarm +-and +-atan2 +-bind +-binmode +-bless +-break +-caller +-chdir +-chmod +-chomp +-chop +-chown +-chr +-chroot +-close +-closedir +-cmp +-connect +-continue +-cos +-crypt +-dbmclose +-dbmopen ++default ++defined ++delete +-die ++do +-dump +-each ++else ++elsif +-endgrent +-endhostent +-endnetent +-endprotoent +-endpwent +-endservent +-eof +-eq ++eval +-evalbytes +-exec ++exists +-exit +-exp +-fc +-fcntl +-fileno +-flock ++for ++foreach +-fork ++format +-formline +-ge +-getc +-getgrent +-getgrgid +-getgrnam +-gethostbyaddr +-gethostbyname +-gethostent +-getlogin +-getnetbyaddr +-getnetbyname +-getnetent +-getpeername +-getpgrp +-getppid +-getpriority +-getprotobyname +-getprotobynumber +-getprotoent +-getpwent +-getpwnam +-getpwuid +-getservbyname +-getservbyport +-getservent +-getsockname +-getsockopt ++given ++glob +-gmtime ++goto ++grep +-gt +-hex ++if +-index +-int +-ioctl +-join +-keys +-kill ++last +-lc +-lcfirst +-le +-length +-link +-listen ++local +-localtime +-lock +-log +-lstat +-lt ++m ++map +-mkdir +-msgctl +-msgget +-msgrcv +-msgsnd ++my +-ne ++next ++no +-not +-oct +-open +-opendir +-or +-ord ++our +-pack ++package +-pipe +-pop ++pos ++print ++printf ++prototype +-push ++q ++qq ++qr +-quotemeta ++qw ++qx +-rand +-read +-readdir +-readline +-readlink +-readpipe +-recv ++redo +-ref +-rename ++require +-reset ++return +-reverse +-rewinddir +-rindex +-rmdir ++s ++say ++scalar +-seek +-seekdir +-select +-semctl +-semget +-semop +-send +-setgrent +-sethostent +-setnetent +-setpgrp +-setpriority +-setprotoent +-setpwent +-setservent +-setsockopt +-shift +-shmctl +-shmget +-shmread +-shmwrite +-shutdown +-sin +-sleep +-socket +-socketpair ++sort +-splice ++split +-sprintf +-sqrt +-srand +-stat ++state ++study ++sub +-substr +-symlink +-syscall +-sysopen +-sysread +-sysseek +-system +-syswrite +-tell +-telldir +-tie +-tied +-time +-times ++tr +-truncate +-uc +-ucfirst +-umask ++undef ++unless +-unlink +-unpack +-unshift +-untie ++until ++use +-utime +-values +-vec +-wait +-waitpid +-wantarray +-warn ++when ++while +-write +-x +-xor ++y |