/* perly.y
*
- * Copyright (c) 1991-1997, Larry Wall
+ * Copyright (c) 1991-2001, Larry Wall
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
#include "EXTERN.h"
#define PERL_IN_PERLY_C
#include "perl.h"
-
+#ifdef EBCDIC
+#undef YYDEBUG
+#endif
#define dep() deprecate("\"do\" to call subroutines")
+/* stuff included here to make perly_c.diff apply better */
+
+#define yydebug PL_yydebug
+#define yynerrs PL_yynerrs
+#define yyerrflag PL_yyerrflag
+#define yychar PL_yychar
+#define yyval PL_yyval
+#define yylval PL_yylval
+
+struct ysv {
+ short* yyss;
+ YYSTYPE* yyvs;
+ int oldyydebug;
+ int oldyynerrs;
+ int oldyyerrflag;
+ int oldyychar;
+ YYSTYPE oldyyval;
+ YYSTYPE oldyylval;
+};
+
+static void yydestruct(pTHXo_ void *ptr);
+
%}
%start prog
%{
-/* I sense a Big Blue pattern here... */
-#if !defined(OEMVS) && !defined(__OPEN_VM) && !defined(POSIX_BC)
+#if 0 /* get this from perly.h instead */
%}
%union {
}
%{
-#endif /* !OEMVS && !__OPEN_VM && !POSIX_BC */
+#endif /* 0 */
#ifdef USE_PURE_BISON
#define YYLEX_PARAM (&yychar)
+#define yylex yylex_r
#endif
+
%}
%token <ival> '{'
%token <ival> FUNC0 FUNC1 FUNC UNIOP LSTOP
%token <ival> RELOP EQOP MULOP ADDOP
%token <ival> DOLSHARP DO HASHBRACK NOAMP
-%token LOCAL MY
+%token <ival> LOCAL MY MYSUB
+%token COLONATTR
-%type <ival> prog decl local format startsub startanonsub startformsub
+%type <ival> prog decl format startsub startanonsub startformsub
%type <ival> remember mremember '&'
%type <opval> block mblock lineseq line loop cond else
%type <opval> expr term subscripted scalar ary hsh arylen star amper sideff
%type <opval> argexpr nexpr texpr iexpr mexpr mnexpr mtexpr miexpr
%type <opval> listexpr listexprcom indirob listop method
%type <opval> formname subname proto subbody cont my_scalar
+%type <opval> subattrlist myattrlist mysubrout myattrterm myterm
%type <pval> label
%nonassoc PREC_LOW
prog : /* NULL */
{
#if defined(YYDEBUG) && defined(DEBUGGING)
- yydebug = (PL_debug & 1);
+ yydebug = (DEBUG_p_TEST);
#endif
PL_expect = XSTATE;
}
else : /* NULL */
{ $$ = Nullop; }
| ELSE mblock
- { $$ = scope($2); }
+ { ($2)->op_flags |= OPf_PARENS; $$ = scope($2); }
| ELSIF '(' mexpr ')' mblock else
{ PL_copline = $1;
$$ = newCONDOP(0, $3, scope($5), $6);
newFOROP(0, $1, $2, Nullop, $5, $7, $8)); }
| label FOR '(' remember mnexpr ';' mtexpr ';' mnexpr ')' mblock
/* basically fake up an initialize-while lineseq */
- { OP *forop = append_elem(OP_LINESEQ,
- scalar($5),
- newWHILEOP(0, 1, (LOOP*)Nullop,
- $2, scalar($7),
- $11, scalar($9)));
+ { OP *forop;
PL_copline = $2;
- $$ = block_end($4, newSTATEOP(0, $1, forop)); }
+ forop = newSTATEOP(0, $1,
+ newWHILEOP(0, 1, (LOOP*)Nullop,
+ $2, scalar($7),
+ $11, $9));
+ if ($5) {
+ forop = append_elem(OP_LINESEQ,
+ newSTATEOP(0, ($1?savepv($1):Nullch),
+ $5),
+ forop);
+ }
+
+ $$ = block_end($4, forop); }
| label block cont /* a block is a loop that happens once */
{ $$ = newSTATEOP(0, $1,
newWHILEOP(0, 1, (LOOP*)Nullop,
;
texpr : /* NULL means true */
- { (void)scan_num("1"); $$ = yylval.opval; }
+ { (void)scan_num("1", &yylval); $$ = yylval.opval; }
| expr
;
{ $$ = 0; }
| subrout
{ $$ = 0; }
+ | mysubrout
+ { $$ = 0; }
| package
{ $$ = 0; }
| use
| /* NULL */ { $$ = Nullop; }
;
-subrout : SUB startsub subname proto subbody
- { newSUB($2, $3, $4, $5); }
+mysubrout: MYSUB startsub subname proto subattrlist subbody
+ { newMYSUB($2, $3, $4, $5, $6); }
+ ;
+
+subrout : SUB startsub subname proto subattrlist subbody
+ { newATTRSUB($2, $3, $4, $5, $6); }
;
startsub: /* NULL */ /* start a regular subroutine scope */
subname : WORD { STRLEN n_a; char *name = SvPV(((SVOP*)$1)->op_sv,n_a);
if (strEQ(name, "BEGIN") || strEQ(name, "END")
- || strEQ(name, "INIT"))
+ || strEQ(name, "INIT") || strEQ(name, "CHECK"))
CvSPECIAL_on(PL_compcv);
$$ = $1; }
;
| THING
;
+subattrlist: /* NULL */
+ { $$ = Nullop; }
+ | COLONATTR THING
+ { $$ = $2; }
+ | COLONATTR
+ { $$ = Nullop; }
+ ;
+
+myattrlist: COLONATTR THING
+ { $$ = $2; }
+ | COLONATTR
+ { $$ = Nullop; }
+ ;
+
subbody : block { $$ = $1; }
| ';' { $$ = Nullop; PL_expect = XSTATE; }
;
| FUNC '(' listexprcom ')'
{ $$ = convert($1, 0, $3); }
| LSTOPSUB startanonsub block
- { $3 = newANONSUB($2, 0, $3); }
+ { $3 = newANONATTRSUB($2, 0, Nullop, $3); }
listexpr %prec LSTOP
{ $$ = newUNOP(OP_ENTERSUB, OPf_STACKED,
append_elem(OP_LIST,
| PREDEC term
{ $$ = newUNOP(OP_PREDEC, 0,
mod(scalar($2), OP_PREDEC)); }
- | local term %prec UNIOP
+ | myattrterm %prec UNIOP
+ { $$ = $1; }
+ | LOCAL term %prec UNIOP
{ $$ = localize($2,$1); }
| '(' expr ')'
{ $$ = sawparens($2); }
{ $$ = newANONHASH($2); }
| HASHBRACK ';' '}' %prec '('
{ $$ = newANONHASH(Nullop); }
- | ANONSUB startanonsub proto block %prec '('
- { $$ = newANONSUB($2, $3, $4); }
+ | ANONSUB startanonsub proto subattrlist block %prec '('
+ { $$ = newANONATTRSUB($2, $3, $4, $5); }
| scalar %prec '('
{ $$ = $1; }
| star %prec '('
| listop
;
+myattrterm: MY myterm myattrlist
+ { $$ = my_attrs($2,$3); }
+ | MY myterm
+ { $$ = localize($2,$1); }
+ ;
+
+myterm : '(' expr ')'
+ { $$ = sawparens($2); }
+ | '(' ')'
+ { $$ = sawparens(newNULLLIST()); }
+ | scalar %prec '('
+ { $$ = $1; }
+ | hsh %prec '('
+ { $$ = $1; }
+ | ary %prec '('
+ { $$ = $1; }
+ ;
+
listexpr: /* NULL */ %prec PREC_LOW
{ $$ = Nullop; }
| argexpr %prec PREC_LOW
{ $$ = $1; }
;
-local : LOCAL { $$ = 0; }
- | MY { $$ = 1; }
- ;
-
my_scalar: scalar
{ PL_in_my = 0; $$ = my($1); }
;
;
%% /* PROGRAM */
+
+/* more stuff added to make perly_c.diff easier to apply */
+
+#ifdef yyparse
+#undef yyparse
+#endif
+#define yyparse() Perl_yyparse(pTHX)
+
projects / p5sagit/p5-mst-13.2.git / blobdiff