X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/ce716c52d393ac84495b7b8f262c39ecc5447cc9..3811bd2be82e0f518b04f768c5303f164dd5e290:/regen/keywords.pl

diff --git a/regen/keywords.pl b/regen/keywords.pl
index 452bfc9..eeed6d4 100755
--- a/regen/keywords.pl
+++ b/regen/keywords.pl
@@ -1,298 +1,358 @@
 #!/usr/bin/perl -w
-# 
+#
 # Regenerate (overwriting only if changed):
 #
-#    keywords.h
+#    keywords.h keywords.c
 #
 # from information stored in the DATA section of this file.
 #
 # Accepts the standard regen_lib -q and -v args.
-#
-# This script is normally invoked from regen.pl.
 
 use strict;
+use Devel::Tokenizer::C 0.05;
 
 require 'regen/regen_lib.pl';
 
-my $kw = safer_open('keywords.h-new', 'keywords.h');
-select $kw;
+my $h = safer_open('keywords.h-new', 'keywords.h');
+my $c = safer_open('keywords.c-new', 'keywords.c');
 
-print read_only_top(lang => 'C', by => 'regen/keywords.pl', from => 'its data',
-		    file => 'keywords.h', style => '*',
-		    copyright => [1994 .. 1997, 1999 .. 2002, 2005 .. 2007]);
+print $h read_only_top(lang => 'C', by => 'regen/keywords.pl',
+		       from => 'its data', file => 'keywords.h', style => '*',
+		       copyright => [1994 .. 1997, 1999 .. 2002, 2005 .. 2007]);
+print $c read_only_top(lang => 'C', by => 'regen/keywords.pl',
+		       from => 'its data', style => '*');
 
-# Read & print data.
+my %by_strength;
 
 my $keynum = 0;
 while (<DATA>) {
     chop;
     next unless $_;
     next if /^#/;
-    my ($keyword) = split;
-    print &tab(5, "#define KEY_$keyword"), $keynum++, "\n";
+    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;
+}
+
+my %feature_kw = (
+	given   => 'switch',
+	when    => 'switch',
+	default => 'switch',
+	# continue is already a keyword
+	break   => 'switch',
+
+	say     => 'say',
+
+	state	=> 'state',
+	);
+
+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"
+
+I32
+Perl_keyword (pTHX_ const char *name, I32 len, bool all_keywords)
+{
+  dVAR;
+
+  PERL_ARGS_ASSERT_KEYWORD;
+
+$switch
+unknown:
+  return 0;
 }
+END
 
-read_only_bottom_close_and_rename($kw);
+sub perl_keyword
+{
+  my $k = shift;
+  my $sign = $pos{$k} ? '' : '-';
 
-###########################################################################
-sub tab {
-    my ($l, $t) = @_;
-    $t .= "\t" x ($l - (length($t) + 1) / 8);
-    $t;
+  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_IS_ENABLED("$feature") ? ${sign}KEY_$k : 0);
+END
+  }
+  return <<END;
+return ${sign}KEY_$k;
+END
 }
-###########################################################################
-__END__
 
-NULL
-__FILE__
-__LINE__
-__PACKAGE__
-__DATA__
+read_only_bottom_close_and_rename($_, [$0]) foreach $c, $h;
+
 __END__
-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
-exec
-exists
-exit
-exp
-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
+
+ NULL
+-__FILE__
+-__LINE__
+-__PACKAGE__
++__DATA__
++__END__
++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
+-exec
++exists
+-exit
+-exp
+-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