diff options
| -rwxr-xr-x | Configure | 7 | ||||
| -rw-r--r-- | Cross/config.sh-arm-linux | 6 | ||||
| -rw-r--r-- | Cross/config.sh-arm-linux-n770 | 6 | ||||
| -rw-r--r-- | MANIFEST | 5 | ||||
| -rw-r--r-- | NetWare/Makefile | 12 | ||||
| -rwxr-xr-x | Porting/Maintainers.pl | 8 | ||||
| -rw-r--r-- | Porting/config.sh | 6 | ||||
| -rw-r--r-- | djgpp/config.over | 1 | ||||
| -rw-r--r-- | embed.fnc | 2 | ||||
| -rw-r--r-- | ext/XS-APItest-KeywordRPN/KeywordRPN.pm | 146 | ||||
| -rw-r--r-- | ext/XS-APItest-KeywordRPN/KeywordRPN.xs | 283 | ||||
| -rw-r--r-- | ext/XS-APItest-KeywordRPN/Makefile.PL | 17 | ||||
| -rw-r--r-- | ext/XS-APItest-KeywordRPN/README | 25 | ||||
| -rw-r--r-- | ext/XS-APItest-KeywordRPN/t/keyword_plugin.t | 76 | ||||
| -rw-r--r-- | perl.h | 5 | ||||
| -rw-r--r-- | perlvars.h | 68 | ||||
| -rw-r--r-- | perly.y | 4 | ||||
| -rw-r--r-- | plan9/config_sh.sample | 2 | ||||
| -rw-r--r-- | pod/perl5112delta.pod | 22 | ||||
| -rw-r--r-- | pod/perldiag.pod | 5 | ||||
| -rw-r--r-- | pod/perlfunc.pod | 8 | ||||
| -rw-r--r-- | pod/perlsyn.pod | 8 | ||||
| -rw-r--r-- | symbian/install.cfg | 1 | ||||
| -rw-r--r-- | toke.c | 75 | ||||
| -rw-r--r-- | utils/perlivp.PL | 1 |
25 files changed, 768 insertions, 31 deletions
@@ -21836,6 +21836,13 @@ for xxx in $known_extensions ; do $define) avail_ext="$avail_ext $xxx" ;; esac ;; + XS/APItest/KeywordRPN|xs/apitest/keywordrpn) + # This is just for testing. Skip it unless we have dynamic loading. + + case "$usedl" in + $define) avail_ext="$avail_ext $xxx" ;; + esac + ;; XS/Typemap|xs/typemap) # This is just for testing. Skip it unless we have dynamic loading. case "$usedl" in diff --git a/Cross/config.sh-arm-linux b/Cross/config.sh-arm-linux index 4a903a2510..61011ab408 100644 --- a/Cross/config.sh-arm-linux +++ b/Cross/config.sh-arm-linux @@ -546,7 +546,7 @@ doublesize='8' drand01='drand48()' drand48_r_proto='0' dtrace='' -dynamic_ext='B ByteLoader Cwd Data/Dumper Devel/DProf Devel/PPPort Devel/Peek Digest/MD5 Encode Fcntl File/Glob Filter/Util/Call I18N/Langinfo IO IPC/SysV List/Util MIME/Base64 Opcode POSIX PerlIO/encoding PerlIO/scalar PerlIO/via SDBM_File Socket Storable Sys/Hostname Sys/Syslog Time/HiRes Unicode/Normalize XS/APItest XS/Typemap attributes re threads threads/shared' +dynamic_ext='B ByteLoader Cwd Data/Dumper Devel/DProf Devel/PPPort Devel/Peek Digest/MD5 Encode Fcntl File/Glob Filter/Util/Call I18N/Langinfo IO IPC/SysV List/Util MIME/Base64 Opcode POSIX PerlIO/encoding PerlIO/scalar PerlIO/via SDBM_File Socket Storable Sys/Hostname Sys/Syslog Time/HiRes Unicode/Normalize XS/APItest XS/APItest/KeywordRPN XS/Typemap attributes re threads threads/shared' eagain='EAGAIN' ebcdic='undef' echo='echo' @@ -561,7 +561,7 @@ endservent_r_proto='0' eunicefix=':' exe_ext='' expr='expr' -extensions='B ByteLoader Cwd Data/Dumper Devel/DProf Devel/PPPort Devel/Peek Digest/MD5 Encode Fcntl File/Glob Filter/Util/Call I18N/Langinfo IO IPC/SysV List/Util MIME/Base64 Opcode POSIX PerlIO/encoding PerlIO/scalar PerlIO/via SDBM_File Socket Storable Sys/Hostname Sys/Syslog Time/HiRes Unicode/Normalize XS/APItest XS/Typemap attributes re threads threads/shared Errno' +extensions='B ByteLoader Cwd Data/Dumper Devel/DProf Devel/PPPort Devel/Peek Digest/MD5 Encode Fcntl File/Glob Filter/Util/Call I18N/Langinfo IO IPC/SysV List/Util MIME/Base64 Opcode POSIX PerlIO/encoding PerlIO/scalar PerlIO/via SDBM_File Socket Storable Sys/Hostname Sys/Syslog Time/HiRes Unicode/Normalize XS/APItest XS/APItest/KeywordRPN XS/Typemap attributes re threads threads/shared Errno' extras='' fflushNULL='define' fflushall='undef' @@ -751,7 +751,7 @@ issymlink='/usr/bin/test -h' ivdformat='"ld"' ivsize='4' ivtype='long' -known_extensions='B ByteLoader Cwd DB_File Data/Dumper Devel/DProf Devel/PPPort Devel/Peek Digest/MD5 Encode Fcntl File/Glob Filter/Util/Call GDBM_File I18N/Langinfo IO IPC/SysV List/Util MIME/Base64 NDBM_File ODBM_File Opcode POSIX PerlIO/encoding PerlIO/scalar PerlIO/via SDBM_File Socket Storable Sys/Hostname Sys/Syslog Time/HiRes Unicode/Normalize XS/APItest XS/Typemap attributes re threads threads/shared' +known_extensions='B ByteLoader Cwd DB_File Data/Dumper Devel/DProf Devel/PPPort Devel/Peek Digest/MD5 Encode Fcntl File/Glob Filter/Util/Call GDBM_File I18N/Langinfo IO IPC/SysV List/Util MIME/Base64 NDBM_File ODBM_File Opcode POSIX PerlIO/encoding PerlIO/scalar PerlIO/via SDBM_File Socket Storable Sys/Hostname Sys/Syslog Time/HiRes Unicode/Normalize XS/APItest XS/APItest/KeywordRPN XS/Typemap attributes re threads threads/shared' ksh='' ld='cc' lddlflags='-shared -L/usr/local/lib' diff --git a/Cross/config.sh-arm-linux-n770 b/Cross/config.sh-arm-linux-n770 index 3e5ebdd1fe..d65aabad8d 100644 --- a/Cross/config.sh-arm-linux-n770 +++ b/Cross/config.sh-arm-linux-n770 @@ -531,7 +531,7 @@ dlsrc='dl_dlopen.xs' doublesize='8' drand01='drand48()' drand48_r_proto='0' -dynamic_ext='B ByteLoader Cwd Data/Dumper Devel/DProf Devel/PPPort Devel/Peek Digest/MD5 Encode Fcntl File/Glob Filter/Util/Call I18N/Langinfo IO IPC/SysV List/Util MIME/Base64 Opcode POSIX PerlIO/encoding PerlIO/scalar PerlIO/via SDBM_File Socket Storable Sys/Hostname Sys/Syslog Time/HiRes Unicode/Normalize XS/APItest XS/Typemap attributes re threads threads/shared' +dynamic_ext='B ByteLoader Cwd Data/Dumper Devel/DProf Devel/PPPort Devel/Peek Digest/MD5 Encode Fcntl File/Glob Filter/Util/Call I18N/Langinfo IO IPC/SysV List/Util MIME/Base64 Opcode POSIX PerlIO/encoding PerlIO/scalar PerlIO/via SDBM_File Socket Storable Sys/Hostname Sys/Syslog Time/HiRes Unicode/Normalize XS/APItest XS/APItest/KeywordRPN XS/Typemap attributes re threads threads/shared' eagain='EAGAIN' ebcdic='undef' echo='echo' @@ -546,7 +546,7 @@ endservent_r_proto='0' eunicefix=':' exe_ext='' expr='expr' -extensions='B ByteLoader Cwd Data/Dumper Devel/DProf Devel/PPPort Devel/Peek Digest/MD5 Encode Fcntl File/Glob Filter/Util/Call I18N/Langinfo IO IPC/SysV List/Util MIME/Base64 Opcode POSIX PerlIO/encoding PerlIO/scalar PerlIO/via SDBM_File Socket Storable Sys/Hostname Sys/Syslog Time/HiRes Unicode/Normalize XS/APItest XS/Typemap attributes re threads threads/shared Errno' +extensions='B ByteLoader Cwd Data/Dumper Devel/DProf Devel/PPPort Devel/Peek Digest/MD5 Encode Fcntl File/Glob Filter/Util/Call I18N/Langinfo IO IPC/SysV List/Util MIME/Base64 Opcode POSIX PerlIO/encoding PerlIO/scalar PerlIO/via SDBM_File Socket Storable Sys/Hostname Sys/Syslog Time/HiRes Unicode/Normalize XS/APItest XS/APItest/KeywordRPN XS/Typemap attributes re threads threads/shared Errno' extras='' fflushNULL='define' fflushall='undef' @@ -736,7 +736,7 @@ issymlink='/usr/bin/test -h' ivdformat='"ld"' ivsize='4' ivtype='long' -known_extensions='B ByteLoader Cwd DB_File Data/Dumper Devel/DProf Devel/PPPort Devel/Peek Digest/MD5 Encode Fcntl File/Glob Filter/Util/Call GDBM_File I18N/Langinfo IO IPC/SysV List/Util MIME/Base64 NDBM_File ODBM_File Opcode POSIX PerlIO/encoding PerlIO/scalar PerlIO/via SDBM_File Socket Storable Sys/Hostname Sys/Syslog Time/HiRes Unicode/Normalize XS/APItest XS/Typemap attributes re threads threads/shared' +known_extensions='B ByteLoader Cwd DB_File Data/Dumper Devel/DProf Devel/PPPort Devel/Peek Digest/MD5 Encode Fcntl File/Glob Filter/Util/Call GDBM_File I18N/Langinfo IO IPC/SysV List/Util MIME/Base64 NDBM_File ODBM_File Opcode POSIX PerlIO/encoding PerlIO/scalar PerlIO/via SDBM_File Socket Storable Sys/Hostname Sys/Syslog Time/HiRes Unicode/Normalize XS/APItest XS/APItest/KeywordRPN XS/Typemap attributes re threads threads/shared' ksh='' ld='arm-none-linux-gnueabi-gcc' lddlflags='-shared -L/usr/local/lib' @@ -3198,6 +3198,11 @@ ext/XS-APItest/APItest.xs XS::APItest extension ext/XS-APItest/core.c Test API functions when PERL_CORE is defined ext/XS-APItest/core_or_not.inc Code common to core.c and notcore.c ext/XS-APItest/exception.c XS::APItest extension +ext/XS-APItest-KeywordRPN/KeywordRPN.pm XS::APItest::KeywordRPN extension +ext/XS-APItest-KeywordRPN/KeywordRPN.xs XS::APItest::KeywordRPN extension +ext/XS-APItest-KeywordRPN/Makefile.PL XS::APItest::KeywordRPN extension +ext/XS-APItest-KeywordRPN/README XS::APItest::KeywordRPN extension +ext/XS-APItest-KeywordRPN/t/keyword_plugin.t test keyword plugin mechanism ext/XS-APItest/Makefile.PL XS::APItest extension ext/XS-APItest/MANIFEST XS::APItest extension ext/XS-APItest/notcore.c Test API functions when PERL_CORE is not defined diff --git a/NetWare/Makefile b/NetWare/Makefile index 20e99ff800..280711150a 100644 --- a/NetWare/Makefile +++ b/NetWare/Makefile @@ -326,6 +326,7 @@ STORABLE_NLM = $(EXTDIR)\Storable\Storable.NLM LISTUTIL_NLM = $(EXTDIR)\List\Util.NLM MIMEBASE64_NLM = $(EXTDIR)\MIME\Base64\Base64.NLM XSAPITEST_NLM = $(EXTDIR)\XS\APItest\APItest.NLM +XSAPITESTKEYWORDRPN_NLM = $(EXTDIR)\XS\APItest\KeywordRPN\KeywordRPN.NLM XSTYPEMAP_NLM = $(EXTDIR)\XS\Typemap\Typemap.NLM UNICODENORMALIZE_NLM = $(EXTDIR)\Unicode\Normalize\Normalize.NLM @@ -350,6 +351,7 @@ EXTENSION_NLM = \ $(LISTUTIL_NLM) \ $(MIMEBASE64_NLM) \ $(XSAPITEST_NLM) \ + $(XSAPITESTKEYWORDRPN_NLM) \ $(XSTYPEMAP_NLM) \ $(UNICODENORMALIZE_NLM) \ $(FILTER_NLM) @@ -789,7 +791,7 @@ X2P_OBJ = $(X2P_SRC:.c=.obj) DYNAMIC_EXT = Socket IO Fcntl Opcode SDBM_File POSIX attributes B re \ Data/Dumper Devel/Peek ByteLoader Devel/DProf File/Glob \ - Storable/Storable List/Util MIME/Base64/Base64 XS/APItest/APItest \ + Storable/Storable List/Util MIME/Base64/Base64 XS/APItest/APItest XS/APItest/KeywordRPN \ XS/Typemap/Typemap Unicode/Normalize/Normalize Sys/Hostname STATIC_EXT = DynaLoader @@ -817,6 +819,7 @@ STORABLE = $(EXTDIR)\Storable\Storable LISTUTIL = $(EXTDIR)\List\Util MIMEBASE64 = $(EXTDIR)\MIME\Base64\Base64 XSAPITEST = $(EXTDIR)\XS\APItest\APItest +XSAPITESTKEYWORDRPN = $(EXTDIR)\XS\APItest\KeywordRPN\KeywordRPN XSTYPEMAP = $(EXTDIR)\XS\Typemap\Typemap UNICODENORMALIZE = $(EXTDIR)\Unicode\Normalize\Normalize @@ -843,6 +846,7 @@ EXTENSION_C = \ $(LISTUTIL).c \ $(MIMEBASE64).c \ $(XSAPITEST).c \ + $(XSAPITESTKEYWORDRPN).c \ $(XSTYPEMAP).c \ $(UNICODENORMALIZE).c \ @@ -1267,6 +1271,12 @@ $(XSAPITEST_NLM): $(MAKE) cd ..\..\..\netware +$(XSAPITESTKEYWORDRPN_NLM): + cd $(EXTDIR)\XS\$(*B) + ..\..\..\miniperl -I..\..\lib Makefile.PL PERL_CORE=1 INSTALLDIRS=perl + $(MAKE) + cd ..\..\..\netware + $(XSTYPEMAP_NLM): cd $(EXTDIR)\XS\$(*B) ..\..\..\miniperl -I..\..\lib Makefile.PL PERL_CORE=1 INSTALLDIRS=perl diff --git a/Porting/Maintainers.pl b/Porting/Maintainers.pl index f72f3e1c7b..1703d2598a 100755 --- a/Porting/Maintainers.pl +++ b/Porting/Maintainers.pl @@ -1734,6 +1734,14 @@ use File::Glob qw(:case); 'UPSTREAM' => 'cpan', }, + 'XS::APItest::KeywordRPN' => + { + 'MAINTAINER' => 'zefram', + 'FILES' => q[ext/XS-APItest-KeywordRPN], + 'CPAN' => 0, + 'UPSTREAM' => 'blead', + }, + 'XSLoader' => { 'MAINTAINER' => 'saper', diff --git a/Porting/config.sh b/Porting/config.sh index b958755cb1..c18faa4876 100644 --- a/Porting/config.sh +++ b/Porting/config.sh @@ -560,7 +560,7 @@ doublesize='8' drand01='drand48()' drand48_r_proto='0' dtrace='' -dynamic_ext='attributes B Compress/Raw/Zlib Cwd Data/Dumper DB_File Devel/DProf Devel/Peek Devel/PPPort Digest/MD5 Digest/SHA Encode Fcntl File/Glob Filter/Util/Call GDBM_File Hash/Util I18N/Langinfo IO IPC/SysV List/Util Math/BigInt/FastCalc MIME/Base64 NDBM_File ODBM_File Opcode PerlIO/encoding PerlIO/scalar PerlIO/via POSIX re SDBM_File Socket Storable Sys/Hostname Sys/Syslog Text/Soundex threads Time/HiRes Time/Piece Unicode/Normalize XS/APItest XS/Typemap threads/shared Hash/Util/FieldHash' +dynamic_ext='attributes B Compress/Raw/Zlib Cwd Data/Dumper DB_File Devel/DProf Devel/Peek Devel/PPPort Digest/MD5 Digest/SHA Encode Fcntl File/Glob Filter/Util/Call GDBM_File Hash/Util I18N/Langinfo IO IPC/SysV List/Util Math/BigInt/FastCalc MIME/Base64 NDBM_File ODBM_File Opcode PerlIO/encoding PerlIO/scalar PerlIO/via POSIX re SDBM_File Socket Storable Sys/Hostname Sys/Syslog Text/Soundex threads Time/HiRes Time/Piece Unicode/Normalize XS/APItest XS/APItest/KeywordRPN XS/Typemap threads/shared Hash/Util/FieldHash' eagain='EAGAIN' ebcdic='undef' echo='echo' @@ -575,7 +575,7 @@ endservent_r_proto='0' eunicefix=':' exe_ext='' expr='expr' -extensions='attributes B Compress/Raw/Zlib Cwd Data/Dumper DB_File Devel/DProf Devel/Peek Devel/PPPort Digest/MD5 Digest/SHA Encode Fcntl File/Glob Filter/Util/Call GDBM_File Hash/Util I18N/Langinfo IO IPC/SysV List/Util Math/BigInt/FastCalc MIME/Base64 NDBM_File ODBM_File Opcode PerlIO/encoding PerlIO/scalar PerlIO/via POSIX re SDBM_File Socket Storable Sys/Hostname Sys/Syslog Text/Soundex threads Time/HiRes Time/Piece Unicode/Normalize XS/APItest XS/Typemap threads/shared Hash/Util/FieldHash Compress/Zlib Errno IO_Compress_Base IO_Compress_Zlib Module/Pluggable Test/Harness' +extensions='attributes B Compress/Raw/Zlib Cwd Data/Dumper DB_File Devel/DProf Devel/Peek Devel/PPPort Digest/MD5 Digest/SHA Encode Fcntl File/Glob Filter/Util/Call GDBM_File Hash/Util I18N/Langinfo IO IPC/SysV List/Util Math/BigInt/FastCalc MIME/Base64 NDBM_File ODBM_File Opcode PerlIO/encoding PerlIO/scalar PerlIO/via POSIX re SDBM_File Socket Storable Sys/Hostname Sys/Syslog Text/Soundex threads Time/HiRes Time/Piece Unicode/Normalize XS/APItest XS/APItest/KeywordRPN XS/Typemap threads/shared Hash/Util/FieldHash Compress/Zlib Errno IO_Compress_Base IO_Compress_Zlib Module/Pluggable Test/Harness' extern_C='extern' extras='' fflushNULL='define' @@ -767,7 +767,7 @@ issymlink='test -h' ivdformat='"Ld"' ivsize='8' ivtype='long long' -known_extensions='attributes B Compress/Raw/Zlib Cwd Data/Dumper DB_File Devel/DProf Devel/Peek Devel/PPPort Digest/MD5 Digest/SHA Encode Fcntl File/Glob Filter/Util/Call GDBM_File Hash/Util I18N/Langinfo IO IPC/SysV List/Util Math/BigInt/FastCalc MIME/Base64 NDBM_File ODBM_File Opcode PerlIO/encoding PerlIO/scalar PerlIO/via POSIX re SDBM_File Socket Storable Sys/Hostname Sys/Syslog Text/Soundex threads Time/HiRes Time/Piece Unicode/Normalize Win32 Win32API/File Win32CORE XS/APItest XS/Typemap threads/shared Hash/Util/FieldHash' +known_extensions='attributes B Compress/Raw/Zlib Cwd Data/Dumper DB_File Devel/DProf Devel/Peek Devel/PPPort Digest/MD5 Digest/SHA Encode Fcntl File/Glob Filter/Util/Call GDBM_File Hash/Util I18N/Langinfo IO IPC/SysV List/Util Math/BigInt/FastCalc MIME/Base64 NDBM_File ODBM_File Opcode PerlIO/encoding PerlIO/scalar PerlIO/via POSIX re SDBM_File Socket Storable Sys/Hostname Sys/Syslog Text/Soundex threads Time/HiRes Time/Piece Unicode/Normalize Win32 Win32API/File Win32CORE XS/APItest XS/APItest/KeywordRPN XS/Typemap threads/shared Hash/Util/FieldHash' ksh='' ld='cc' lddlflags='-shared -O2 -L/usr/local/lib -fstack-protector' diff --git a/djgpp/config.over b/djgpp/config.over index f385f55369..5d97c85725 100644 --- a/djgpp/config.over +++ b/djgpp/config.over @@ -46,6 +46,7 @@ repair() -e 's=cwd=Cwd=' \ -e 's=perlio/via=PerlIO/via=' \ -e 's=perlio/encoding=PerlIO/encoding=' \ + -e 's=xs/apitest/keywordrpn=XS/APItest/KeywordRPN=' \ -e 's=xs/apitest=XS/APItest=' \ -e 's=xs/typemap=XS/Typemap=' \ -e 's=unicode/normaliz=Unicode/Normalize=' \ @@ -2228,6 +2228,8 @@ ApoM |const char *|fetch_cop_label|NULLOK struct refcounted_he *const chain \ xpoM |struct refcounted_he *|store_cop_label \ |NULLOK struct refcounted_he *const chain|NN const char *label +xpo |int |keyword_plugin_standard|NN char* keyword_ptr|STRLEN keyword_len|NN OP** op_ptr + END_EXTERN_C /* * ex: set ts=8 sts=4 sw=4 noet: diff --git a/ext/XS-APItest-KeywordRPN/KeywordRPN.pm b/ext/XS-APItest-KeywordRPN/KeywordRPN.pm new file mode 100644 index 0000000000..085d3f68b2 --- /dev/null +++ b/ext/XS-APItest-KeywordRPN/KeywordRPN.pm @@ -0,0 +1,146 @@ +=head1 NAME + +XS::APItest::KeywordRPN - write arithmetic expressions in RPN + +=head1 SYNOPSIS + + use XS::APItest::KeywordRPN qw(rpn calcrpn); + + $triangle = rpn($n $n 1 + * 2 /); + + calcrpn $triangle { $n $n 1 + * 2 / } + +=head1 DESCRIPTION + +This module supplies plugged-in keywords, using the new mechanism in Perl +5.11.2, that allow arithmetic to be expressed in reverse Polish notation, +in an otherwise Perl program. This module has serious limitations and +is not intended for real use: its purpose is only to test the keyword +plugin mechanism. For that purpose it is part of the Perl core source +distribution, and is not meant to be installed. + +=head2 RPN expression syntax + +Tokens of an RPN expression may be separated by whitespace, but such +separation is usually not required. It is required only where unseparated +tokens would look like a longer token. For example, C<12 34 +> can be +written as C<12 34+>, but not as C<1234 +>. + +An RPN expression may be any of: + +=over + +=item C<1234> + +A sequence of digits is an unsigned decimal literal number. + +=item C<$foo> + +An alphanumeric name preceded by dollar sign refers to a Perl scalar +variable. Only variables declared with C<my> or C<state> are supported. +If the variable's value is not a native integer, it will be converted +to an integer, by Perl's usual mechanisms, at the time it is evaluated. + +=item I<A> I<B> C<+> + +Sum of I<A> and I<B>. + +=item I<A> I<B> C<-> + +Difference of I<A> and I<B>, the result of subtracting I<B> from I<A>. + +=item I<A> I<B> C<*> + +Product of I<A> and I<B>. + +=item I<A> I<B> C</> + +Quotient when I<A> is divided by I<B>, rounded towards zero. +Division by zero generates an exception. + +=item I<A> I<B> C<%> + +Remainder when I<A> is divided by I<B> with the quotient rounded towards zero. +Division by zero generates an exception. + +=back + +Because the arithmetic operators all have fixed arity and are postfixed, +there is no need for operator precedence, nor for a grouping operator +to override precedence. This is half of the point of RPN. + +An RPN expression can also be interpreted in another way, as a sequence +of operations on a stack, one operation per token. A literal or variable +token pushes a value onto the stack. A binary operator pulls two items +off the stack, performs a calculation with them, and pushes the result +back onto the stack. The stack starts out empty, and at the end of the +expression there must be exactly one value left on the stack. + +=cut + +package XS::APItest::KeywordRPN; + +{ use 5.011001; } +use warnings; +use strict; + +our $VERSION = "0.000"; + +require XSLoader; +XSLoader::load(__PACKAGE__, $VERSION); + +=head1 OPERATORS + +These are the operators being added to the Perl language. + +=over + +=item rpn(EXPRESSION) + +This construct is a Perl expression. I<EXPRESSION> must be an RPN +arithmetic expression, as described above. The RPN expression is +evaluated, and its value is returned as the value of the Perl expression. + +=item calcrpn VARIABLE { EXPRESSION } + +This construct is a complete Perl statement. (No semicolon should +follow the closing brace.) I<VARIABLE> must be a Perl scalar C<my> +variable, and I<EXPRESSION> must be an RPN arithmetic expression as +described above. The RPN expression is evaluated, and its value is +assigned to the variable. + +=back + +=head1 BUGS + +This module only performs arithmetic on native integers, and only a +small subset of the arithmetic operations that Perl offers. This is +due to it being intended only for demonstration and test purposes. + +The RPN parser is liable to leak memory when a parse error occurs. +It doesn't leak on success, however. + +The linkage with Perl's lexer is liable to fail when an RPN expression +is spread across multiple lines. + +=head1 SEE ALSO + +L<Devel::Declare>, +L<perlapi/PL_keyword_plugin> + +=head1 AUTHOR + +Andrew Main (Zefram) <zefram@fysh.org> + +=head1 COPYRIGHT + +Copyright (C) 2009 Andrew Main (Zefram) <zefram@fysh.org> + +=head1 LICENSE + +This module is free software; you can redistribute it and/or modify it +under the same terms as Perl itself. + +=cut + +1; diff --git a/ext/XS-APItest-KeywordRPN/KeywordRPN.xs b/ext/XS-APItest-KeywordRPN/KeywordRPN.xs new file mode 100644 index 0000000000..219d6ac1d9 --- /dev/null +++ b/ext/XS-APItest-KeywordRPN/KeywordRPN.xs @@ -0,0 +1,283 @@ +#define PERL_CORE 1 /* for pad_findmy() */ +#include "EXTERN.h" +#include "perl.h" +#include "XSUB.h" + +#define sv_is_glob(sv) (SvTYPE(sv) == SVt_PVGV) +#define sv_is_regexp(sv) (SvTYPE(sv) == SVt_REGEXP) +#define sv_is_string(sv) \ + (!sv_is_glob(sv) && !sv_is_regexp(sv) && \ + (SvFLAGS(sv) & (SVf_IOK|SVf_NOK|SVf_POK|SVp_IOK|SVp_NOK|SVp_POK))) + +static SV *hintkey_rpn_sv, *hintkey_calcrpn_sv; +static int (*next_keyword_plugin)(pTHX_ char *, STRLEN, OP **); + +/* low-level parser helpers */ + +#define PL_bufptr (PL_parser->bufptr) +#define PL_bufend (PL_parser->bufend) + +static char THX_peek_char(pTHX) +{ + if(PL_bufptr == PL_bufend) + Perl_croak(aTHX_ + "unexpected EOF " + "(or you were unlucky about buffer position, FIXME)"); + return *PL_bufptr; +} +#define peek_char() THX_peek_char(aTHX) + +static char THX_read_char(pTHX) +{ + char c = peek_char(); + PL_bufptr++; + if(c == '\n') CopLINE_inc(PL_curcop); + return c; +} +#define read_char() THX_read_char(aTHX) + +static void THX_skip_opt_ws(pTHX) +{ + while(1) { + switch(peek_char()) { + case '\t': case '\n': case '\v': case '\f': case ' ': + read_char(); + break; + default: + return; + } + } +} +#define skip_opt_ws() THX_skip_opt_ws(aTHX) + +/* RPN parser */ + +static OP *THX_parse_var(pTHX) +{ + SV *varname = sv_2mortal(newSVpvs("$")); + PADOFFSET varpos; + OP *padop; + if(peek_char() != '$') Perl_croak(aTHX_ "RPN syntax error"); + read_char(); + while(1) { + char c = peek_char(); + if(!isALNUM(c)) break; + read_char(); + sv_catpvn_nomg(varname, &c, 1); + } + if(SvCUR(varname) < 2) Perl_croak(aTHX_ "RPN syntax error"); + varpos = pad_findmy(SvPVX(varname)); + if(varpos == NOT_IN_PAD || PAD_COMPNAME_FLAGS_isOUR(varpos)) + Perl_croak(aTHX_ "RPN only supports \"my\" variables"); + padop = newOP(OP_PADSV, 0); + padop->op_targ = varpos; + return padop; +} +#define parse_var() THX_parse_var(aTHX) + +#define push_rpn_item(o) \ + (tmpop = (o), tmpop->op_sibling = stack, stack = tmpop) +#define pop_rpn_item() \ + (!stack ? (Perl_croak(aTHX_ "RPN stack underflow"), (OP*)NULL) : \ + (tmpop = stack, stack = stack->op_sibling, \ + tmpop->op_sibling = NULL, tmpop)) + +static OP *THX_parse_rpn_expr(pTHX) +{ + OP *stack = NULL, *tmpop; + while(1) { + char c; + skip_opt_ws(); + c = peek_char(); + switch(c) { + case /*(*/')': case /*{*/'}': { + OP *result = pop_rpn_item(); + if(stack) + Perl_croak(aTHX_ + "RPN expression must return " + "a single value"); + return result; + } break; + case '0': case '1': case '2': case '3': case '4': + case '5': case '6': case '7': case '8': case '9': { + UV val = 0; + do { + read_char(); + val = 10*val + (c - '0'); + c = peek_char(); + } while(c >= '0' && c <= '9'); + push_rpn_item(newSVOP(OP_CONST, 0, + newSVuv(val))); + } break; + case '$': { + push_rpn_item(parse_var()); + } break; + case '+': { + OP *b = pop_rpn_item(); + OP *a = pop_rpn_item(); + read_char(); + push_rpn_item(newBINOP(OP_I_ADD, 0, a, b)); + } break; + case '-': { + OP *b = pop_rpn_item(); + OP *a = pop_rpn_item(); + read_char(); + push_rpn_item(newBINOP(OP_I_SUBTRACT, 0, a, b)); + } break; + case '*': { + OP *b = pop_rpn_item(); + OP *a = pop_rpn_item(); + read_char(); + push_rpn_item(newBINOP(OP_I_MULTIPLY, 0, a, b)); + } break; + case '/': { + OP *b = pop_rpn_item(); + OP *a = pop_rpn_item(); + read_char(); + push_rpn_item(newBINOP(OP_I_DIVIDE, 0, a, b)); + } break; + case '%': { + OP *b = pop_rpn_item(); + OP *a = pop_rpn_item(); + read_char(); + push_rpn_item(newBINOP(OP_I_MODULO, 0, a, b)); + } break; + default: { + Perl_croak(aTHX_ "RPN syntax error"); + } break; + } + } +} +#define parse_rpn_expr() THX_parse_rpn_expr(aTHX) + +static OP *THX_parse_keyword_rpn(pTHX) +{ + OP *op; + skip_opt_ws(); + if(peek_char() != '('/*)*/) + Perl_croak(aTHX_ "RPN expression must be parenthesised"); + read_char(); + op = parse_rpn_expr(); + if(peek_char() != /*(*/')') + Perl_croak(aTHX_ "RPN expression must be parenthesised"); + read_char(); + return op; +} +#define parse_keyword_rpn() THX_parse_keyword_rpn(aTHX) + +static OP *THX_parse_keyword_calcrpn(pTHX) +{ + OP *varop, *exprop; + skip_opt_ws(); + varop = parse_var(); + skip_opt_ws(); + if(peek_char() != '{'/*}*/) + Perl_croak(aTHX_ "RPN expression must be braced"); + read_char(); + exprop = parse_rpn_expr(); + if(peek_char() != /*{*/'}') + Perl_croak(aTHX_ "RPN expression must be braced"); + read_char(); + return newASSIGNOP(OPf_STACKED, varop, 0, exprop); +} +#define parse_keyword_calcrpn() THX_parse_keyword_calcrpn(aTHX) + +/* plugin glue */ + +static int THX_keyword_active(pTHX_ SV *hintkey_sv) +{ + HE *he; + if(!GvHV(PL_hintgv)) return 0; + he = hv_fetch_ent(GvHV(PL_hintgv), hintkey_sv, 0, + SvSHARED_HASH(hintkey_sv)); + return he && SvTRUE(HeVAL(he)); +} +#define keyword_active(hintkey_sv) THX_keyword_active(aTHX_ hintkey_sv) + +static void THX_keyword_enable(pTHX_ SV *hintkey_sv) +{ + SV *val_sv = newSViv(1); + HE *he; + PL_hints |= HINT_LOCALIZE_HH; + gv_HVadd(PL_hintgv); + he = hv_store_ent(GvHV(PL_hintgv), + hintkey_sv, val_sv, SvSHARED_HASH(hintkey_sv)); + if(he) { + SV *val = HeVAL(he); + SvSETMAGIC(val); + } else { + SvREFCNT_dec(val_sv); + } +} +#define keyword_enable(hintkey_sv) THX_keyword_enable(aTHX_ hintkey_sv) + +static void THX_keyword_disable(pTHX_ SV *hintkey_sv) +{ + if(GvHV(PL_hintgv)) { + PL_hints |= HINT_LOCALIZE_HH; + hv_delete_ent(GvHV(PL_hintgv), + hintkey_sv, G_DISCARD, SvSHARED_HASH(hintkey_sv)); + } +} +#define keyword_disable(hintkey_sv) THX_keyword_disable(aTHX_ hintkey_sv) + +static int my_keyword_plugin(pTHX_ + char *keyword_ptr, STRLEN keyword_len, OP **op_ptr) +{ + if(keyword_len == 3 && strnEQ(keyword_ptr, "rpn", 3) && + keyword_active(hintkey_rpn_sv)) { + *op_ptr = parse_keyword_rpn(); + return KEYWORD_PLUGIN_EXPR; + } else if(keyword_len == 7 && strnEQ(keyword_ptr, "calcrpn", 7) && + keyword_active(hintkey_calcrpn_sv)) { + *op_ptr = parse_keyword_calcrpn(); + return KEYWORD_PLUGIN_STMT; + } else { + return next_keyword_plugin(aTHX_ + keyword_ptr, keyword_len, op_ptr); + } +} + +MODULE = XS::APItest::KeywordRPN PACKAGE = XS::APItest::KeywordRPN + +BOOT: + hintkey_rpn_sv = newSVpvs_share("XS::APItest::KeywordRPN/rpn"); + hintkey_calcrpn_sv = newSVpvs_share("XS::APItest::KeywordRPN/calcrpn"); + next_keyword_plugin = PL_keyword_plugin; + PL_keyword_plugin = my_keyword_plugin; + +void +import(SV *class, ...) +PREINIT: + int i; +PPCODE: + for(i = 1; i != items; i++) { + SV *item = ST(i); + if(sv_is_string(item) && strEQ(SvPVX(item), "rpn")) { + keyword_enable(hintkey_rpn_sv); + } else if(sv_is_string(item) && strEQ(SvPVX(item), "calcrpn")) { + keyword_enable(hintkey_calcrpn_sv); + } else { + Perl_croak(aTHX_ + "\"%s\" is not exported by the %s module", + SvPV_nolen(item), SvPV_nolen(ST(0))); + } + } + +void +unimport(SV *class, ...) +PREINIT: + int i; +PPCODE: + for(i = 1; i != items; i++) { + SV *item = ST(i); + if(sv_is_string(item) && strEQ(SvPVX(item), "rpn")) { + keyword_disable(hintkey_rpn_sv); + } else if(sv_is_string(item) && strEQ(SvPVX(item), "calcrpn")) { + keyword_disable(hintkey_calcrpn_sv); + } else { + Perl_croak(aTHX_ + "\"%s\" is not exported by the %s module", + SvPV_nolen(item), SvPV_nolen(ST(0))); + } + } diff --git a/ext/XS-APItest-KeywordRPN/Makefile.PL b/ext/XS-APItest-KeywordRPN/Makefile.PL new file mode 100644 index 0000000000..ae2c72a40c --- /dev/null +++ b/ext/XS-APItest-KeywordRPN/Makefile.PL @@ -0,0 +1,17 @@ +{ use 5.006; } +use warnings; +use strict; + +use ExtUtils::MakeMaker; + +WriteMakefile( + NAME => "XS::APItest::KeywordRPN", + VERSION_FROM => "KeywordRPN.pm", + PREREQ_PM => {}, + ABSTRACT_FROM => "KeywordRPN.pm", + AUTHOR => "Andrew Main (Zefram) <zefram\@fysh.org>", +); + +sub MY::install { "install ::\n" } + +1; diff --git a/ext/XS-APItest-KeywordRPN/README b/ext/XS-APItest-KeywordRPN/README new file mode 100644 index 0000000000..4caa629af1 --- /dev/null +++ b/ext/XS-APItest-KeywordRPN/README @@ -0,0 +1,25 @@ +NAME + +XS::APItest::KeywordRPN - write arithmetic expressions in RPN + +DESCRIPTION + +This module supplies plugged-in keywords, using the new mechanism in Perl +5.11.2, that allow arithmetic to be expressed in reverse Polish notation, +in an otherwise Perl program. This module has serious limitations and +is not intended for real use: its purpose is only to test the keyword +plugin mechanism. For that purpose it is part of the Perl core source +distribution, and is not meant to be installed. + +AUTHOR + +Andrew Main (Zefram) <zefram@fysh.org> + +COPYRIGHT + +Copyright (C) 2009 Andrew Main (Zefram) <zefram@fysh.org> + +LICENSE + +This module is free software; you can redistribute it and/or modify it +under the same terms as Perl itself. diff --git a/ext/XS-APItest-KeywordRPN/t/keyword_plugin.t b/ext/XS-APItest-KeywordRPN/t/keyword_plugin.t new file mode 100644 index 0000000000..2b705d733a --- /dev/null +++ b/ext/XS-APItest-KeywordRPN/t/keyword_plugin.t @@ -0,0 +1,76 @@ +use warnings; +use strict; + +use Test::More tests => 13; + +BEGIN { $^H |= 0x20000; } +no warnings; + +my($t, $n); +$n = 5; + +$t = undef; +eval q{ + use XS::APItest::KeywordRPN (); + $t = rpn($n $n 1 + * 2 /); +}; +isnt $@, ""; + +$t = undef; +eval q{ + use XS::APItest::KeywordRPN qw(rpn); + $t = rpn($n $n 1 + * 2 /); +}; +is $@, ""; +is $t, 15; + +$t = undef; +eval q{ + use XS::APItest::KeywordRPN qw(rpn); + $t = join(":", "x", rpn($n $n 1 + * 2 /), "y"); +}; +is $@, ""; +is $t, "x:15:y"; + +$t = undef; +eval q{ + use XS::APItest::KeywordRPN qw(rpn); + $t = 1 + rpn($n $n 1 + * 2 /) * 10; +}; +is $@, ""; +is $t, 151; + +$t = undef; +eval q{ + use XS::APItest::KeywordRPN qw(rpn); + $t = rpn($n $n 1 + * 2 /); + $t++; +}; +is $@, ""; +is $t, 16; + +$t = undef; +eval q{ + use XS::APItest::KeywordRPN qw(rpn); + $t = rpn($n $n 1 + * 2 /) + $t++; +}; +isnt $@, ""; + +$t = undef; +eval q{ + use XS::APItest::KeywordRPN qw(calcrpn); + calcrpn $t { $n $n 1 + * 2 / } + $t++; +}; +is $@, ""; +is $t, 16; + +$t = undef; +eval q{ + use XS::APItest::KeywordRPN qw(calcrpn); + 123 + calcrpn $t { $n $n 1 + * 2 / } ; +}; +isnt $@, ""; + +1; @@ -4753,6 +4753,11 @@ typedef void (*XSUBADDR_t) (pTHX_ CV *); typedef OP* (CPERLscope(*Perl_ppaddr_t))(pTHX); typedef OP* (CPERLscope(*Perl_check_t)) (pTHX_ OP*); typedef void(CPERLscope(*Perl_ophook_t))(pTHX_ OP*); +typedef int (CPERLscope(*Perl_keyword_plugin_t))(pTHX_ char*, STRLEN, OP**); + +#define KEYWORD_PLUGIN_DECLINE 0 +#define KEYWORD_PLUGIN_STMT 1 +#define KEYWORD_PLUGIN_EXPR 2 /* Interpreter exitlist entry */ typedef struct exitlistentry { diff --git a/perlvars.h b/perlvars.h index 49f4d5e31d..3639bd6ac0 100644 --- a/perlvars.h +++ b/perlvars.h @@ -8,9 +8,9 @@ * */ -/****************/ -/* Truly global */ -/****************/ +/* +=head1 Global Variables +*/ /* Don't forget to re-run embed.pl to propagate changes! */ @@ -186,3 +186,65 @@ PERLVARI(Gglobal_struct_size, U16, sizeof(struct perl_vars)) PERLVARI(Ginterp_size_5_10_0, U16, PERL_INTERPRETER_SIZE_UPTO_MEMBER(PERL_LAST_5_10_0_INTERP_MEMBER)) #endif + +/* +=for apidoc AmUx|Perl_keyword_plugin_t|PL_keyword_plugin + +Function pointer, pointing at a function used to handle extended keywords. +The function should be declared as + + int keyword_plugin_function(pTHX_ + char *keyword_ptr, STRLEN keyword_len, + OP **op_ptr) + +The function is called from the tokeniser, whenever a possible keyword +is seen. C<keyword_ptr> points at the word in the parser's input +buffer, and C<keyword_len> gives its length; it is not null-terminated. +The function is expected to examine the word, and possibly other state +such as L<%^H|perlvar/%^H>, to decide whether it wants to handle it +as an extended keyword. If it does not, the function should return +C<KEYWORD_PLUGIN_DECLINE>, and the normal parser process will continue. + +If the function wants to handle the keyword, it first must +parse anything following the keyword that is part of the syntax +introduced by the keyword. The lexer interface is poorly documented. +Broadly speaking, parsing needs to look at the buffer that extends +from C<PL_parser-E<gt>bufptr> to C<PL_parser-E<gt>bufend>, and +C<PL_parser-E<gt>bufptr> must be advanced across whatever text is +consumed by the parsing process. The buffer end is not necessarily the +real end of the input text, but refilling the buffer is too complicated +to discuss here. See L<Devel::Declare> for some parsing experience, +and hope for more core support in a future version of Perl. + +When a keyword is being handled, the plugin function must build +a tree of C<OP> structures, representing the code that was parsed. +The root of the tree must be stored in C<*op_ptr>. The function then +returns a contant indicating the syntactic role of the construct that +it has parsed: C<KEYWORD_PLUGIN_STMT> if it is a complete statement, or +C<KEYWORD_PLUGIN_EXPR> if it is an expression. Note that a statement +construct cannot be used inside an expression (except via C<do BLOCK> +and similar), and an expression is not a complete statement (it requires +at least a terminating semicolon). + +When a keyword is handled, the plugin function may also have +(compile-time) side effects. It may modify C<%^H>, define functions, and +so on. Typically, if side effects are the main purpose of a handler, +it does not wish to generate any ops to be included in the normal +compilation. In this case it is still required to supply an op tree, +but it suffices to generate a single null op. + +That's how the C<*PL_keyword_plugin> function needs to behave overall. +Conventionally, however, one does not completely replace the existing +handler function. Instead, take a copy of C<PL_keyword_plugin> before +assigning your own function pointer to it. Your handler function should +look for keywords that it is interested in and handle those. Where it +is not interested, it should call the saved plugin function, passing on +the arguments it received. Thus C<PL_keyword_plugin> actually points +at a chain of handler functions, all of which have an opportunity to +handle keywords, and only the last function in the chain (built into +the Perl core) will normally return C<KEYWORD_PLUGIN_DECLINE>. + +=cut +*/ + +PERLVARI(Gkeyword_plugin, Perl_keyword_plugin_t, MEMBER_TO_FPTR(Perl_keyword_plugin_standard)) @@ -73,6 +73,7 @@ %token <opval> WORD METHOD FUNCMETH THING PMFUNC PRIVATEREF %token <opval> FUNC0SUB UNIOPSUB LSTOPSUB +%token <opval> PLUGEXPR PLUGSTMT %token <p_tkval> LABEL %token <i_tkval> FORMAT SUB ANONSUB PACKAGE USE %token <i_tkval> WHILE UNTIL IF UNLESS ELSE ELSIF CONTINUE FOR @@ -241,6 +242,8 @@ line : label cond } }) } + | label PLUGSTMT + { $$ = newSTATEOP(0, PVAL($1), $2); } ; /* An expression which may have a side-effect */ @@ -1244,6 +1247,7 @@ term : termbinop newSVOP(OP_CONST, 0, newSVpvs("Unimplemented"))); TOKEN_GETMAD($1,$$,'X'); } + | PLUGEXPR ; /* "my" declarations, with optional attributes */ diff --git a/plan9/config_sh.sample b/plan9/config_sh.sample index c11635953a..763f7aaf75 100644 --- a/plan9/config_sh.sample +++ b/plan9/config_sh.sample @@ -733,7 +733,7 @@ issymlink='/bin/test -h' ivdformat='"ld"' ivsize='4' ivtype='long' -known_extensions='B ByteLoader Cwd DB_File Data/Dumper Devel/DProf Devel/PPPort Devel/Peek Digest/MD5 Encode Fcntl File/Glob Filter/Util/Call GDBM_File I18N/Langinfo IO IPC/SysV List/Util MIME/Base64 NDBM_File ODBM_File Opcode POSIX PerlIO/encoding PerlIO/scalar PerlIO/via SDBM_File Socket Storable Sys/Hostname Sys/Syslog Time/HiRes Unicode/Normalize XS/APItest XS/Typemap attributes re threads threads/shared' +known_extensions='B ByteLoader Cwd DB_File Data/Dumper Devel/DProf Devel/PPPort Devel/Peek Digest/MD5 Encode Fcntl File/Glob Filter/Util/Call GDBM_File I18N/Langinfo IO IPC/SysV List/Util MIME/Base64 NDBM_File ODBM_File Opcode POSIX PerlIO/encoding PerlIO/scalar PerlIO/via SDBM_File Socket Storable Sys/Hostname Sys/Syslog Time/HiRes Unicode/Normalize XS/APItest XS/APItest/KeywordRPN XS/Typemap attributes re threads threads/shared' ksh='' ld='ld' lddlflags='' diff --git a/pod/perl5112delta.pod b/pod/perl5112delta.pod index 4d524670b3..ca8c8096ff 100644 --- a/pod/perl5112delta.pod +++ b/pod/perl5112delta.pod @@ -52,6 +52,28 @@ boolean, string or number of objects. It is invoked when an object appears on the right hand side of the C<=~> operator, or when it is interpolated into a regexp. See L<overload>. +=head2 Pluggable keywords + +Extension modules can now cleanly hook into the Perl parser to define new +kinds of keyword-headed expression and compound statement. The syntax +following the keyword is defined entirely by the extension. This allow +a completely non-Perl sublanguage to be parsed inline, with the right +ops cleanly generated. + +This feature is currently considered experimental, and using it to do +anything interesting is difficult. Many necessary supporting facilities, +such as the lexer and the pad system, can only be accessed through +unsupported internal interfaces. It is intended that the Perl 5.13 +development cycle will see the addition of clean, supported interfaces +for many of these functions. In Perl 5.12 most uses of pluggable keywords +will be via L<Devel::Declare>. + +See L<perlapi/PL_keyword_plugin> for the mechanism. The Perl core source +distribution also includes a new module L<XS::APItest::KeywordRPN>, which +implements reverse Polish notation arithmetic via pluggable keywords. +This module is mainly used for test purposes, and is not normally +installed, but also serves as an example of how to use the new mechanism. + =head1 New Platforms XXX List any platforms that this version of perl compiles on, that previous diff --git a/pod/perldiag.pod b/pod/perldiag.pod index 3f0a78a3fe..db9a17c2fb 100644 --- a/pod/perldiag.pod +++ b/pod/perldiag.pod @@ -373,6 +373,11 @@ is not the same as $var = 'myvar'; $sym = "mypack::$var"; +=item Bad plugin affecting keyword '%s' + +(F) An extension using the keyword plugin mechanism violated the +plugin API. + =item Bad realloc() ignored (S malloc) An internal routine called realloc() on something that had diff --git a/pod/perlfunc.pod b/pod/perlfunc.pod index c440faa410..862e0ba73d 100644 --- a/pod/perlfunc.pod +++ b/pod/perlfunc.pod @@ -86,6 +86,14 @@ which return C<-1> on failure. Exceptions to this rule are C<wait>, C<waitpid>, and C<syscall>. System calls also set the special C<$!> variable on failure. Other functions do not, except accidentally. +Extension modules can also hook into the Perl parser to define new +kinds of keyword-headed expression. These may look like functions, but +may also look completely different. The syntax following the keyword +is defined entirely by the extension. If you are an implementor, see +L<perlapi/PL_keyword_plugin> for the mechanism. If you are using such +a module, see the module's documentation for details of the syntax that +it defines. + =head2 Perl Functions by Category X<function> diff --git a/pod/perlsyn.pod b/pod/perlsyn.pod index 5e80901b09..d5fc4a72c1 100644 --- a/pod/perlsyn.pod +++ b/pod/perlsyn.pod @@ -272,6 +272,14 @@ conditional is about to be evaluated again. Thus it can be used to increment a loop variable, even when the loop has been continued via the C<next> statement. +Extension modules can also hook into the Perl parser to define new +kinds of compound statement. These are introduced by a keyword which +the extension recognises, and the syntax following the keyword is +defined entirely by the extension. If you are an implementor, see +L<perlapi/PL_keyword_plugin> for the mechanism. If you are using such +a module, see the module's documentation for details of the syntax that +it defines. + =head2 Loop Control X<loop control> X<loop, control> X<next> X<last> X<redo> X<continue> diff --git a/symbian/install.cfg b/symbian/install.cfg index 4b86b8211e..879b3619e7 100644 --- a/symbian/install.cfg +++ b/symbian/install.cfg @@ -114,5 +114,6 @@ ext XSLoader # ext Unicode/Normalize nonconst # ext Win32 USELESS # ext XS/APItest USELESS +# ext XS/APItest/KeywordRPN USELESS # ext XS/Typemap nonconst USELESS @@ -343,6 +343,8 @@ static struct debug_tokens { { OROP, TOKENTYPE_IVAL, "OROP" }, { OROR, TOKENTYPE_NONE, "OROR" }, { PACKAGE, TOKENTYPE_NONE, "PACKAGE" }, + { PLUGEXPR, TOKENTYPE_OPVAL, "PLUGEXPR" }, + { PLUGSTMT, TOKENTYPE_OPVAL, "PLUGSTMT" }, { PMFUNC, TOKENTYPE_OPVAL, "PMFUNC" }, { POSTDEC, TOKENTYPE_NONE, "POSTDEC" }, { POSTINC, TOKENTYPE_NONE, "POSTINC" }, @@ -5220,6 +5222,7 @@ Perl_yylex(pTHX) case 'z': case 'Z': keylookup: { + bool anydelim; I32 tmp; orig_keyword = 0; @@ -5230,34 +5233,19 @@ Perl_yylex(pTHX) s = scan_word(s, PL_tokenbuf, sizeof PL_tokenbuf, FALSE, &len); /* Some keywords can be followed by any delimiter, including ':' */ - tmp = ((len == 1 && strchr("msyq", PL_tokenbuf[0])) || + anydelim = ((len == 1 && strchr("msyq", PL_tokenbuf[0])) || (len == 2 && ((PL_tokenbuf[0] == 't' && PL_tokenbuf[1] == 'r') || (PL_tokenbuf[0] == 'q' && strchr("qwxr", PL_tokenbuf[1]))))); /* x::* is just a word, unless x is "CORE" */ - if (!tmp && *s == ':' && s[1] == ':' && strNE(PL_tokenbuf, "CORE")) + if (!anydelim && *s == ':' && s[1] == ':' && strNE(PL_tokenbuf, "CORE")) goto just_a_word; d = s; while (d < PL_bufend && isSPACE(*d)) d++; /* no comments skipped here, or s### is misparsed */ - /* Is this a label? */ - if (!tmp && PL_expect == XSTATE - && d < PL_bufend && *d == ':' && *(d + 1) != ':') { - tmp = keyword(PL_tokenbuf, len, 0); - if (tmp) - Perl_croak(aTHX_ "Can't use keyword '%s' as a label", PL_tokenbuf); - s = d + 1; - pl_yylval.pval = CopLABEL_alloc(PL_tokenbuf); - CLINE; - TOKEN(LABEL); - } - else - /* Check for keywords */ - tmp = keyword(PL_tokenbuf, len, 0); - /* Is this a word before a => operator? */ if (*d == '=' && d[1] == '>') { CLINE; @@ -5268,6 +5256,47 @@ Perl_yylex(pTHX) TERM(WORD); } + /* Check for plugged-in keyword */ + { + OP *o; + int result; + char *saved_bufptr = PL_bufptr; + PL_bufptr = s; + result = CALL_FPTR(PL_keyword_plugin)(aTHX_ PL_tokenbuf, len, &o); + s = PL_bufptr; + if (result == KEYWORD_PLUGIN_DECLINE) { + /* not a plugged-in keyword */ + PL_bufptr = saved_bufptr; + } else if (result == KEYWORD_PLUGIN_STMT) { + pl_yylval.opval = o; + CLINE; + PL_expect = XSTATE; + return REPORT(PLUGSTMT); + } else if (result == KEYWORD_PLUGIN_EXPR) { + pl_yylval.opval = o; + CLINE; + PL_expect = XOPERATOR; + return REPORT(PLUGEXPR); + } else { + Perl_croak(aTHX_ "Bad plugin affecting keyword '%s'", + PL_tokenbuf); + } + } + + /* Check for built-in keyword */ + tmp = keyword(PL_tokenbuf, len, 0); + + /* Is this a label? */ + if (!anydelim && PL_expect == XSTATE + && d < PL_bufend && *d == ':' && *(d + 1) != ':') { + if (tmp) + Perl_croak(aTHX_ "Can't use keyword '%s' as a label", PL_tokenbuf); + s = d + 1; + pl_yylval.pval = CopLABEL_alloc(PL_tokenbuf); + CLINE; + TOKEN(LABEL); + } + if (tmp < 0) { /* second-class keyword? */ GV *ogv = NULL; /* override (winner) */ GV *hgv = NULL; /* hidden (loser) */ @@ -13015,6 +13044,18 @@ Perl_scan_vstring(pTHX_ const char *s, const char *const e, SV *sv) return (char *)s; } +int +Perl_keyword_plugin_standard(pTHX_ + char *keyword_ptr, STRLEN keyword_len, OP **op_ptr) +{ + PERL_ARGS_ASSERT_KEYWORD_PLUGIN_STANDARD; + PERL_UNUSED_CONTEXT; + PERL_UNUSED_ARG(keyword_ptr); + PERL_UNUSED_ARG(keyword_len); + PERL_UNUSED_ARG(op_ptr); + return KEYWORD_PLUGIN_DECLINE; +} + /* * Local variables: * c-indentation-style: bsd diff --git a/utils/perlivp.PL b/utils/perlivp.PL index 762b4b3872..59865741e1 100644 --- a/utils/perlivp.PL +++ b/utils/perlivp.PL @@ -213,6 +213,7 @@ if (defined($Config{'extensions'})) { next if $_ eq 'Devel/DProf'; # test modules next if $_ eq 'XS/APItest'; + next if $_ eq 'XS/APItest/KeywordRPN'; next if $_ eq 'XS/Typemap'; # VMS$ perl -e "eval ""require \""Devel/DProf.pm\"";"" print $@" # \NT> perl -e "eval \"require 'Devel/DProf.pm'\"; print $@" |