aboutsummaryrefslogtreecommitdiff
path: root/contrib/perl5/perly.y
diff options
context:
space:
mode:
Diffstat (limited to 'contrib/perl5/perly.y')
-rw-r--r--contrib/perl5/perly.y643
1 files changed, 643 insertions, 0 deletions
diff --git a/contrib/perl5/perly.y b/contrib/perl5/perly.y
new file mode 100644
index 000000000000..e016cf431d0b
--- /dev/null
+++ b/contrib/perl5/perly.y
@@ -0,0 +1,643 @@
+/* perly.y
+ *
+ * Copyright (c) 1991-1997, 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.
+ *
+ */
+
+/*
+ * 'I see,' laughed Strider. 'I look foul and feel fair. Is that it?
+ * All that is gold does not glitter, not all those who wander are lost.'
+ */
+
+%{
+#include "EXTERN.h"
+#include "perl.h"
+
+static void
+dep(void)
+{
+ deprecate("\"do\" to call subroutines");
+}
+
+%}
+
+%start prog
+
+%{
+#ifndef OEMVS
+%}
+
+%union {
+ I32 ival;
+ char *pval;
+ OP *opval;
+ GV *gvval;
+}
+
+%{
+#endif /* OEMVS */
+%}
+
+%token <ival> '{' ')'
+
+%token <opval> WORD METHOD FUNCMETH THING PMFUNC PRIVATEREF
+%token <opval> FUNC0SUB UNIOPSUB LSTOPSUB
+%token <pval> LABEL
+%token <ival> FORMAT SUB ANONSUB PACKAGE USE
+%token <ival> WHILE UNTIL IF UNLESS ELSE ELSIF CONTINUE FOR
+%token <ival> LOOPEX DOTDOT
+%token <ival> FUNC0 FUNC1 FUNC UNIOP LSTOP
+%token <ival> RELOP EQOP MULOP ADDOP
+%token <ival> DOLSHARP DO HASHBRACK NOAMP
+%token LOCAL MY
+
+%type <ival> prog decl local format startsub startanonsub startformsub
+%type <ival> remember mremember '&'
+%type <opval> block mblock lineseq line loop cond else
+%type <opval> expr term 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 <pval> label
+
+%left <ival> OROP
+%left ANDOP
+%right NOTOP
+%nonassoc LSTOP LSTOPSUB
+%left ','
+%right <ival> ASSIGNOP
+%right '?' ':'
+%nonassoc DOTDOT
+%left OROR
+%left ANDAND
+%left <ival> BITOROP
+%left <ival> BITANDOP
+%nonassoc EQOP
+%nonassoc RELOP
+%nonassoc UNIOP UNIOPSUB
+%left <ival> SHIFTOP
+%left ADDOP
+%left MULOP
+%left <ival> MATCHOP
+%right '!' '~' UMINUS REFGEN
+%right <ival> POWOP
+%nonassoc PREINC PREDEC POSTINC POSTDEC
+%left ARROW
+%left '('
+
+%% /* RULES */
+
+prog : /* NULL */
+ {
+#if defined(YYDEBUG) && defined(DEBUGGING)
+ yydebug = (PL_debug & 1);
+#endif
+ PL_expect = XSTATE;
+ }
+ /*CONTINUED*/ lineseq
+ { newPROG($2); }
+ ;
+
+block : '{' remember lineseq '}'
+ { if (PL_copline > (line_t)$1)
+ PL_copline = $1;
+ $$ = block_end($2, $3); }
+ ;
+
+remember: /* NULL */ /* start a full lexical scope */
+ { $$ = block_start(TRUE); }
+ ;
+
+mblock : '{' mremember lineseq '}'
+ { if (PL_copline > (line_t)$1)
+ PL_copline = $1;
+ $$ = block_end($2, $3); }
+ ;
+
+mremember: /* NULL */ /* start a partial lexical scope */
+ { $$ = block_start(FALSE); }
+ ;
+
+lineseq : /* NULL */
+ { $$ = Nullop; }
+ | lineseq decl
+ { $$ = $1; }
+ | lineseq line
+ { $$ = append_list(OP_LINESEQ,
+ (LISTOP*)$1, (LISTOP*)$2);
+ PL_pad_reset_pending = TRUE;
+ if ($1 && $2) PL_hints |= HINT_BLOCK_SCOPE; }
+ ;
+
+line : label cond
+ { $$ = newSTATEOP(0, $1, $2); }
+ | loop /* loops add their own labels */
+ | label ';'
+ { if ($1 != Nullch) {
+ $$ = newSTATEOP(0, $1, newOP(OP_NULL, 0));
+ }
+ else {
+ $$ = Nullop;
+ PL_copline = NOLINE;
+ }
+ PL_expect = XSTATE; }
+ | label sideff ';'
+ { $$ = newSTATEOP(0, $1, $2);
+ PL_expect = XSTATE; }
+ ;
+
+sideff : error
+ { $$ = Nullop; }
+ | expr
+ { $$ = $1; }
+ | expr IF expr
+ { $$ = newLOGOP(OP_AND, 0, $3, $1); }
+ | expr UNLESS expr
+ { $$ = newLOGOP(OP_OR, 0, $3, $1); }
+ | expr WHILE expr
+ { $$ = newLOOPOP(OPf_PARENS, 1, scalar($3), $1); }
+ | expr UNTIL iexpr
+ { $$ = newLOOPOP(OPf_PARENS, 1, $3, $1);}
+ | expr FOR expr
+ { $$ = newFOROP(0, Nullch, $2,
+ Nullop, $3, $1, Nullop); }
+ ;
+
+else : /* NULL */
+ { $$ = Nullop; }
+ | ELSE mblock
+ { $$ = scope($2); }
+ | ELSIF '(' mexpr ')' mblock else
+ { PL_copline = $1;
+ $$ = newSTATEOP(0, Nullch,
+ newCONDOP(0, $3, scope($5), $6));
+ PL_hints |= HINT_BLOCK_SCOPE; }
+ ;
+
+cond : IF '(' remember mexpr ')' mblock else
+ { PL_copline = $1;
+ $$ = block_end($3,
+ newCONDOP(0, $4, scope($6), $7)); }
+ | UNLESS '(' remember miexpr ')' mblock else
+ { PL_copline = $1;
+ $$ = block_end($3,
+ newCONDOP(0, $4, scope($6), $7)); }
+ ;
+
+cont : /* NULL */
+ { $$ = Nullop; }
+ | CONTINUE block
+ { $$ = scope($2); }
+ ;
+
+loop : label WHILE '(' remember mtexpr ')' mblock cont
+ { PL_copline = $2;
+ $$ = block_end($4,
+ newSTATEOP(0, $1,
+ newWHILEOP(0, 1, (LOOP*)Nullop,
+ $2, $5, $7, $8))); }
+ | label UNTIL '(' remember miexpr ')' mblock cont
+ { PL_copline = $2;
+ $$ = block_end($4,
+ newSTATEOP(0, $1,
+ newWHILEOP(0, 1, (LOOP*)Nullop,
+ $2, $5, $7, $8))); }
+ | label FOR MY remember my_scalar '(' mexpr ')' mblock cont
+ { $$ = block_end($4,
+ newFOROP(0, $1, $2, $5, $7, $9, $10)); }
+ | label FOR scalar '(' remember mexpr ')' mblock cont
+ { $$ = block_end($5,
+ newFOROP(0, $1, $2, mod($3, OP_ENTERLOOP),
+ $6, $8, $9)); }
+ | label FOR '(' remember mexpr ')' mblock cont
+ { $$ = block_end($4,
+ 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)));
+ PL_copline = $2;
+ $$ = block_end($4, newSTATEOP(0, $1, forop)); }
+ | label block cont /* a block is a loop that happens once */
+ { $$ = newSTATEOP(0, $1,
+ newWHILEOP(0, 1, (LOOP*)Nullop,
+ NOLINE, Nullop, $2, $3)); }
+ ;
+
+nexpr : /* NULL */
+ { $$ = Nullop; }
+ | sideff
+ ;
+
+texpr : /* NULL means true */
+ { (void)scan_num("1"); $$ = yylval.opval; }
+ | expr
+ ;
+
+iexpr : expr
+ { $$ = invert(scalar($1)); }
+ ;
+
+mexpr : expr
+ { $$ = $1; intro_my(); }
+ ;
+
+mnexpr : nexpr
+ { $$ = $1; intro_my(); }
+ ;
+
+mtexpr : texpr
+ { $$ = $1; intro_my(); }
+ ;
+
+miexpr : iexpr
+ { $$ = $1; intro_my(); }
+ ;
+
+label : /* empty */
+ { $$ = Nullch; }
+ | LABEL
+ ;
+
+decl : format
+ { $$ = 0; }
+ | subrout
+ { $$ = 0; }
+ | package
+ { $$ = 0; }
+ | use
+ { $$ = 0; }
+ ;
+
+format : FORMAT startformsub formname block
+ { newFORM($2, $3, $4); }
+ ;
+
+formname: WORD { $$ = $1; }
+ | /* NULL */ { $$ = Nullop; }
+ ;
+
+subrout : SUB startsub subname proto subbody
+ { newSUB($2, $3, $4, $5); }
+ ;
+
+startsub: /* NULL */ /* start a regular subroutine scope */
+ { $$ = start_subparse(FALSE, 0); }
+ ;
+
+startanonsub: /* NULL */ /* start an anonymous subroutine scope */
+ { $$ = start_subparse(FALSE, CVf_ANON); }
+ ;
+
+startformsub: /* NULL */ /* start a format subroutine scope */
+ { $$ = start_subparse(TRUE, 0); }
+ ;
+
+subname : WORD { char *name = SvPV(((SVOP*)$1)->op_sv, PL_na);
+ if (strEQ(name, "BEGIN") || strEQ(name, "END")
+ || strEQ(name, "INIT"))
+ CvUNIQUE_on(PL_compcv);
+ $$ = $1; }
+ ;
+
+proto : /* NULL */
+ { $$ = Nullop; }
+ | THING
+ ;
+
+subbody : block { $$ = $1; }
+ | ';' { $$ = Nullop; PL_expect = XSTATE; }
+ ;
+
+package : PACKAGE WORD ';'
+ { package($2); }
+ | PACKAGE ';'
+ { package(Nullop); }
+ ;
+
+use : USE startsub
+ { CvUNIQUE_on(PL_compcv); /* It's a BEGIN {} */ }
+ WORD WORD listexpr ';'
+ { utilize($1, $2, $4, $5, $6); }
+ ;
+
+expr : expr ANDOP expr
+ { $$ = newLOGOP(OP_AND, 0, $1, $3); }
+ | expr OROP expr
+ { $$ = newLOGOP($2, 0, $1, $3); }
+ | argexpr
+ ;
+
+argexpr : argexpr ','
+ { $$ = $1; }
+ | argexpr ',' term
+ { $$ = append_elem(OP_LIST, $1, $3); }
+ | term
+ ;
+
+listop : LSTOP indirob argexpr
+ { $$ = convert($1, OPf_STACKED,
+ prepend_elem(OP_LIST, newGVREF($1,$2), $3) ); }
+ | FUNC '(' indirob expr ')'
+ { $$ = convert($1, OPf_STACKED,
+ prepend_elem(OP_LIST, newGVREF($1,$3), $4) ); }
+ | term ARROW method '(' listexprcom ')'
+ { $$ = convert(OP_ENTERSUB, OPf_STACKED,
+ append_elem(OP_LIST,
+ prepend_elem(OP_LIST, scalar($1), $5),
+ newUNOP(OP_METHOD, 0, $3))); }
+ | METHOD indirob listexpr
+ { $$ = convert(OP_ENTERSUB, OPf_STACKED,
+ append_elem(OP_LIST,
+ prepend_elem(OP_LIST, $2, $3),
+ newUNOP(OP_METHOD, 0, $1))); }
+ | FUNCMETH indirob '(' listexprcom ')'
+ { $$ = convert(OP_ENTERSUB, OPf_STACKED,
+ append_elem(OP_LIST,
+ prepend_elem(OP_LIST, $2, $4),
+ newUNOP(OP_METHOD, 0, $1))); }
+ | LSTOP listexpr
+ { $$ = convert($1, 0, $2); }
+ | FUNC '(' listexprcom ')'
+ { $$ = convert($1, 0, $3); }
+ | LSTOPSUB startanonsub block
+ { $3 = newANONSUB($2, 0, $3); }
+ listexpr %prec LSTOP
+ { $$ = newUNOP(OP_ENTERSUB, OPf_STACKED,
+ append_elem(OP_LIST,
+ prepend_elem(OP_LIST, $3, $5), $1)); }
+ ;
+
+method : METHOD
+ | scalar
+ ;
+
+term : term ASSIGNOP term
+ { $$ = newASSIGNOP(OPf_STACKED, $1, $2, $3); }
+ | term POWOP term
+ { $$ = newBINOP($2, 0, scalar($1), scalar($3)); }
+ | term MULOP term
+ { if ($2 != OP_REPEAT)
+ scalar($1);
+ $$ = newBINOP($2, 0, $1, scalar($3)); }
+ | term ADDOP term
+ { $$ = newBINOP($2, 0, scalar($1), scalar($3)); }
+ | term SHIFTOP term
+ { $$ = newBINOP($2, 0, scalar($1), scalar($3)); }
+ | term RELOP term
+ { $$ = newBINOP($2, 0, scalar($1), scalar($3)); }
+ | term EQOP term
+ { $$ = newBINOP($2, 0, scalar($1), scalar($3)); }
+ | term BITANDOP term
+ { $$ = newBINOP($2, 0, scalar($1), scalar($3)); }
+ | term BITOROP term
+ { $$ = newBINOP($2, 0, scalar($1), scalar($3)); }
+ | term DOTDOT term
+ { $$ = newRANGE($2, scalar($1), scalar($3));}
+ | term ANDAND term
+ { $$ = newLOGOP(OP_AND, 0, $1, $3); }
+ | term OROR term
+ { $$ = newLOGOP(OP_OR, 0, $1, $3); }
+ | term '?' term ':' term
+ { $$ = newCONDOP(0, $1, $3, $5); }
+ | term MATCHOP term
+ { $$ = bind_match($2, $1, $3); }
+
+ | '-' term %prec UMINUS
+ { $$ = newUNOP(OP_NEGATE, 0, scalar($2)); }
+ | '+' term %prec UMINUS
+ { $$ = $2; }
+ | '!' term
+ { $$ = newUNOP(OP_NOT, 0, scalar($2)); }
+ | '~' term
+ { $$ = newUNOP(OP_COMPLEMENT, 0, scalar($2));}
+ | REFGEN term
+ { $$ = newUNOP(OP_REFGEN, 0, mod($2,OP_REFGEN)); }
+ | term POSTINC
+ { $$ = newUNOP(OP_POSTINC, 0,
+ mod(scalar($1), OP_POSTINC)); }
+ | term POSTDEC
+ { $$ = newUNOP(OP_POSTDEC, 0,
+ mod(scalar($1), OP_POSTDEC)); }
+ | PREINC term
+ { $$ = newUNOP(OP_PREINC, 0,
+ mod(scalar($2), OP_PREINC)); }
+ | PREDEC term
+ { $$ = newUNOP(OP_PREDEC, 0,
+ mod(scalar($2), OP_PREDEC)); }
+ | local term %prec UNIOP
+ { $$ = localize($2,$1); }
+ | '(' expr ')'
+ { $$ = sawparens($2); }
+ | '(' ')'
+ { $$ = sawparens(newNULLLIST()); }
+ | '[' expr ']' %prec '('
+ { $$ = newANONLIST($2); }
+ | '[' ']' %prec '('
+ { $$ = newANONLIST(Nullop); }
+ | HASHBRACK expr ';' '}' %prec '('
+ { $$ = newANONHASH($2); }
+ | HASHBRACK ';' '}' %prec '('
+ { $$ = newANONHASH(Nullop); }
+ | ANONSUB startanonsub proto block %prec '('
+ { $$ = newANONSUB($2, $3, $4); }
+ | scalar %prec '('
+ { $$ = $1; }
+ | star '{' expr ';' '}'
+ { $$ = newBINOP(OP_GELEM, 0, $1, scalar($3)); }
+ | star %prec '('
+ { $$ = $1; }
+ | scalar '[' expr ']' %prec '('
+ { $$ = newBINOP(OP_AELEM, 0, oopsAV($1), scalar($3)); }
+ | term ARROW '[' expr ']' %prec '('
+ { $$ = newBINOP(OP_AELEM, 0,
+ ref(newAVREF($1),OP_RV2AV),
+ scalar($4));}
+ | term '[' expr ']' %prec '('
+ { assertref($1); $$ = newBINOP(OP_AELEM, 0,
+ ref(newAVREF($1),OP_RV2AV),
+ scalar($3));}
+ | hsh %prec '('
+ { $$ = $1; }
+ | ary %prec '('
+ { $$ = $1; }
+ | arylen %prec '('
+ { $$ = newUNOP(OP_AV2ARYLEN, 0, ref($1, OP_AV2ARYLEN));}
+ | scalar '{' expr ';' '}' %prec '('
+ { $$ = newBINOP(OP_HELEM, 0, oopsHV($1), jmaybe($3));
+ PL_expect = XOPERATOR; }
+ | term ARROW '{' expr ';' '}' %prec '('
+ { $$ = newBINOP(OP_HELEM, 0,
+ ref(newHVREF($1),OP_RV2HV),
+ jmaybe($4));
+ PL_expect = XOPERATOR; }
+ | term '{' expr ';' '}' %prec '('
+ { assertref($1); $$ = newBINOP(OP_HELEM, 0,
+ ref(newHVREF($1),OP_RV2HV),
+ jmaybe($3));
+ PL_expect = XOPERATOR; }
+ | '(' expr ')' '[' expr ']' %prec '('
+ { $$ = newSLICEOP(0, $5, $2); }
+ | '(' ')' '[' expr ']' %prec '('
+ { $$ = newSLICEOP(0, $4, Nullop); }
+ | ary '[' expr ']' %prec '('
+ { $$ = prepend_elem(OP_ASLICE,
+ newOP(OP_PUSHMARK, 0),
+ newLISTOP(OP_ASLICE, 0,
+ list($3),
+ ref($1, OP_ASLICE))); }
+ | ary '{' expr ';' '}' %prec '('
+ { $$ = prepend_elem(OP_HSLICE,
+ newOP(OP_PUSHMARK, 0),
+ newLISTOP(OP_HSLICE, 0,
+ list($3),
+ ref(oopsHV($1), OP_HSLICE)));
+ PL_expect = XOPERATOR; }
+ | THING %prec '('
+ { $$ = $1; }
+ | amper
+ { $$ = newUNOP(OP_ENTERSUB, 0, scalar($1)); }
+ | amper '(' ')'
+ { $$ = newUNOP(OP_ENTERSUB, OPf_STACKED, scalar($1)); }
+ | amper '(' expr ')'
+ { $$ = newUNOP(OP_ENTERSUB, OPf_STACKED,
+ append_elem(OP_LIST, $3, scalar($1))); }
+ | NOAMP WORD listexpr
+ { $$ = newUNOP(OP_ENTERSUB, OPf_STACKED,
+ append_elem(OP_LIST, $3, scalar($2))); }
+ | DO term %prec UNIOP
+ { $$ = newUNOP(OP_DOFILE, 0, scalar($2)); }
+ | DO block %prec '('
+ { $$ = newUNOP(OP_NULL, OPf_SPECIAL, scope($2)); }
+ | DO WORD '(' ')'
+ { $$ = newUNOP(OP_ENTERSUB,
+ OPf_SPECIAL|OPf_STACKED,
+ prepend_elem(OP_LIST,
+ scalar(newCVREF(
+ (OPpENTERSUB_AMPER<<8),
+ scalar($2)
+ )),Nullop)); dep();}
+ | DO WORD '(' expr ')'
+ { $$ = newUNOP(OP_ENTERSUB,
+ OPf_SPECIAL|OPf_STACKED,
+ append_elem(OP_LIST,
+ $4,
+ scalar(newCVREF(
+ (OPpENTERSUB_AMPER<<8),
+ scalar($2)
+ )))); dep();}
+ | DO scalar '(' ')'
+ { $$ = newUNOP(OP_ENTERSUB, OPf_SPECIAL|OPf_STACKED,
+ prepend_elem(OP_LIST,
+ scalar(newCVREF(0,scalar($2))), Nullop)); dep();}
+ | DO scalar '(' expr ')'
+ { $$ = newUNOP(OP_ENTERSUB, OPf_SPECIAL|OPf_STACKED,
+ prepend_elem(OP_LIST,
+ $4,
+ scalar(newCVREF(0,scalar($2))))); dep();}
+ | term ARROW '(' ')' %prec '('
+ { $$ = newUNOP(OP_ENTERSUB, OPf_STACKED,
+ newCVREF(0, scalar($1))); }
+ | term ARROW '(' expr ')' %prec '('
+ { $$ = newUNOP(OP_ENTERSUB, OPf_STACKED,
+ append_elem(OP_LIST, $4,
+ newCVREF(0, scalar($1)))); }
+ | LOOPEX
+ { $$ = newOP($1, OPf_SPECIAL);
+ PL_hints |= HINT_BLOCK_SCOPE; }
+ | LOOPEX term
+ { $$ = newLOOPEX($1,$2); }
+ | NOTOP argexpr
+ { $$ = newUNOP(OP_NOT, 0, scalar($2)); }
+ | UNIOP
+ { $$ = newOP($1, 0); }
+ | UNIOP block
+ { $$ = newUNOP($1, 0, $2); }
+ | UNIOP term
+ { $$ = newUNOP($1, 0, $2); }
+ | UNIOPSUB term
+ { $$ = newUNOP(OP_ENTERSUB, OPf_STACKED,
+ append_elem(OP_LIST, $2, scalar($1))); }
+ | FUNC0
+ { $$ = newOP($1, 0); }
+ | FUNC0 '(' ')'
+ { $$ = newOP($1, 0); }
+ | FUNC0SUB
+ { $$ = newUNOP(OP_ENTERSUB, OPf_STACKED,
+ scalar($1)); }
+ | FUNC1 '(' ')'
+ { $$ = newOP($1, OPf_SPECIAL); }
+ | FUNC1 '(' expr ')'
+ { $$ = newUNOP($1, 0, $3); }
+ | PMFUNC '(' term ')'
+ { $$ = pmruntime($1, $3, Nullop); }
+ | PMFUNC '(' term ',' term ')'
+ { $$ = pmruntime($1, $3, $5); }
+ | WORD
+ | listop
+ ;
+
+listexpr: /* NULL */
+ { $$ = Nullop; }
+ | argexpr
+ { $$ = $1; }
+ ;
+
+listexprcom: /* NULL */
+ { $$ = Nullop; }
+ | expr
+ { $$ = $1; }
+ | expr ','
+ { $$ = $1; }
+ ;
+
+local : LOCAL { $$ = 0; }
+ | MY { $$ = 1; }
+ ;
+
+my_scalar: scalar
+ { PL_in_my = 0; $$ = my($1); }
+ ;
+
+amper : '&' indirob
+ { $$ = newCVREF($1,$2); }
+ ;
+
+scalar : '$' indirob
+ { $$ = newSVREF($2); }
+ ;
+
+ary : '@' indirob
+ { $$ = newAVREF($2); }
+ ;
+
+hsh : '%' indirob
+ { $$ = newHVREF($2); }
+ ;
+
+arylen : DOLSHARP indirob
+ { $$ = newAVREF($2); }
+ ;
+
+star : '*' indirob
+ { $$ = newGVREF(0,$2); }
+ ;
+
+indirob : WORD
+ { $$ = scalar($1); }
+ | scalar
+ { $$ = scalar($1); }
+ | block
+ { $$ = scope($1); }
+
+ | PRIVATEREF
+ { $$ = $1; }
+ ;
+
+%% /* PROGRAM */
generated by cgit v1.2.3 (git 2.25.1) at 2024-06-28 08:47:58 +0000