function interface to parse Perl statement

yyparse() becomes reentrant.  The yacc stack and related resources
are allocated in yyparse(), rather than in lex_start(), and they are
localised to yyparse(), preserving their values from any outer parser.

yyparse() now takes a parameter which determines which production it
will parse at the top level.  New API function parse_fullstmt() uses this
facility to parse just a single statement.  The top-level single-statement
production that is used for this then messes with the parser's head so
that the parsing stops without seeing EOF, and any lookahead token seen
after the statement is pushed back to the lexer.

1 files changed, 59 insertions, 13 deletions

diff --git a/toke.c b/toke.c
index 42f0103281..6d4d01493c 100644
--- a/toke.c
+++ b/toke.c
@@ -45,9 +45,6 @@ Individual members of C<PL_parser> have their own documentation.
 
 #define pl_yylval	(PL_parser->yylval)
 
-/* YYINITDEPTH -- initial size of the parser's stacks.  */
-#define YYINITDEPTH 200
-
 /* XXX temporary backwards compatibility */
 #define PL_lex_brackets		(PL_parser->lex_brackets)
 #define PL_lex_brackstack	(PL_parser->lex_brackstack)
@@ -675,13 +672,9 @@ Perl_lex_start(pTHX_ SV *line, PerlIO *rsfp, bool new_filter)
     parser->old_parser = oparser = PL_parser;
     PL_parser = parser;
 
-    Newx(parser->stack, YYINITDEPTH, yy_stack_frame);
-    parser->ps = parser->stack;
-    parser->stack_size = YYINITDEPTH;
-
-    parser->stack->state = 0;
-    parser->yyerrstatus = 0;
-    parser->yychar = YYEMPTY;		/* Cause a token to be read.  */
+    parser->stack = NULL;
+    parser->ps = NULL;
+    parser->stack_size = 0;
 
     /* on scope exit, free this parser and restore any outer one */
     SAVEPARSER(parser);
@@ -750,7 +743,6 @@ Perl_parser_free(pTHX_  const yy_parser *parser)
 	PerlIO_close(parser->rsfp);
     SvREFCNT_dec(parser->rsfp_filters);
 
-    Safefree(parser->stack);
     Safefree(parser->lex_brackstack);
     Safefree(parser->lex_casestack);
     PL_parser = parser->old_parser;
@@ -1929,6 +1921,17 @@ S_force_next(pTHX_ I32 type)
 #endif
 }
 
+void
+Perl_yyunlex(pTHX)
+{
+    if (PL_parser->yychar != YYEMPTY) {
+	start_force(-1);
+	NEXTVAL_NEXTTOKE = PL_parser->yylval;
+	force_next(PL_parser->yychar);
+	PL_parser->yychar = YYEMPTY;
+    }
+}
+
 STATIC SV *
 S_newSV_maybe_utf8(pTHX_ const char *const start, STRLEN len)
 {
@@ -3953,7 +3956,7 @@ Perl_madlex(pTHX)
     PL_thismad = 0;
 
     /* just do what yylex would do on pending identifier; leave PL_thiswhite alone */
-    if (PL_pending_ident)
+    if (PL_lex_state != LEX_KNOWNEXT && PL_pending_ident)
         return S_pending_ident(aTHX);
 
     /* previous token ate up our whitespace? */
@@ -4212,7 +4215,7 @@ Perl_yylex(pTHX)
 	SvREFCNT_dec(tmp);
     } );
     /* check if there's an identifier for us to look at */
-    if (PL_pending_ident)
+    if (PL_lex_state != LEX_KNOWNEXT && PL_pending_ident)
         return REPORT(S_pending_ident(aTHX));
 
     /* no identifier pending identification */
@@ -13940,6 +13943,49 @@ Perl_keyword_plugin_standard(pTHX_
 }
 
 /*
+=for apidoc Amx|OP *|parse_fullstmt|U32 flags
+
+Parse a single complete Perl statement.  This may be a normal imperative
+statement, including optional label, or a declaration that has
+compile-time effect.  It is up to the caller to ensure that the dynamic
+parser state (L</PL_parser> et al) is correctly set to reflect the source
+of the code to be parsed and the lexical context for the statement.
+
+The op tree representing the statement is returned.  This may be a
+null pointer if the statement is null, for example if it was actually
+a subroutine definition (which has compile-time side effects).  If not
+null, it will be the result of a L</newSTATEOP> call, normally including
+a C<nextstate> or equivalent op.
+
+If an error occurs in parsing or compilation, in most cases a valid op
+tree (most likely null) is returned anyway.  The error is reflected in
+the parser state, normally resulting in a single exception at the top
+level of parsing which covers all the compilation errors that occurred.
+Some compilation errors, however, will throw an exception immediately.
+
+The I<flags> parameter is reserved for future use, and must always
+be zero.
+
+=cut
+*/
+
+OP *
+Perl_parse_fullstmt(pTHX_ U32 flags)
+{
+    OP *fullstmtop;
+    if (flags)
+	Perl_croak(aTHX_ "Parsing code internal error (%s)", "parse_fullstmt");
+    ENTER;
+    SAVEVPTR(PL_eval_root);
+    PL_eval_root = NULL;
+    if(yyparse(GRAMFULLSTMT) && !PL_parser->error_count)
+	qerror(Perl_mess(aTHX_ "Parse error"));
+    fullstmtop = PL_eval_root;
+    LEAVE;
+    return fullstmtop;
+}
+
+/*
  * Local variables:
  * c-indentation-style: bsd
  * c-basic-offset: 4