diff perl-5.22.2/regen/keywords.pl @ 8045:a16537d2fe07

<xfix> tar xf perl-5.22.2.tar.gz # Ah, whatever, I\'m doing it anyway
author HackBot
date Sat, 14 May 2016 14:54:38 +0000
parents
children
line wrap: on
line diff
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/perl-5.22.2/regen/keywords.pl	Sat May 14 14:54:38 2016 +0000
@@ -0,0 +1,369 @@
+#!/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)
+{
+  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
++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