-/* $Header: perl.y,v 1.0.1.1 88/01/28 10:25:31 root Exp $
+/* $Header: perl.y,v 3.0.1.6 90/03/27 16:13:45 lwall Locked $
+ *
+ * Copyright (c) 1989, Larry Wall
+ *
+ * You may distribute under the terms of the GNU General Public License
+ * as specified in the README file that comes with the perl 3.0 kit.
*
* $Log: perl.y,v $
- * Revision 1.0.1.1 88/01/28 10:25:31 root
- * patch8: added eval operator.
+ * Revision 3.0.1.6 90/03/27 16:13:45 lwall
+ * patch16: formats didn't work inside eval
+ *
+ * Revision 3.0.1.5 90/03/12 16:55:56 lwall
+ * patch13: added list slice operator (LIST)[LIST]
+ * patch13: (LIST,) now legal
+ *
+ * Revision 3.0.1.4 90/02/28 18:03:23 lwall
+ * patch9: line numbers were bogus during certain portions of foreach evaluation
+ *
+ * Revision 3.0.1.3 89/12/21 20:13:41 lwall
+ * patch7: send() didn't allow a TO argument
+ *
+ * Revision 3.0.1.2 89/11/11 04:49:04 lwall
+ * patch2: moved yydebug to where its type doesn't matter
+ * patch2: !$foo++ was unreasonably illegal
+ * patch2: local(@foo) didn't work
+ * patch2: default args to unary operators didn't work
*
- * Revision 1.0 87/12/18 15:48:59 root
- * Initial revision
+ * Revision 3.0.1.1 89/10/26 23:20:41 lwall
+ * patch1: grandfathered "format stdout"
+ * patch1: operator(); is now normally equivalent to operator;
+ *
+ * Revision 3.0 89/10/18 15:22:04 lwall
+ * 3.0 baseline
*
*/
%{
-#include "handy.h"
-#include "EXTERN.h"
-#include "search.h"
-#include "util.h"
#include "INTERN.h"
#include "perl.h"
-char *tokename[] = {
-"256",
-"word",
-"append","open","write","select","close","loopctl",
-"using","format","do","shift","push","pop","chop",
-"while","until","if","unless","else","elsif","continue","split","sprintf",
-"for", "eof", "tell", "seek", "stat",
-"function(no args)","function(1 arg)","function(2 args)","function(3 args)","array function",
-"join", "sub",
-"format lines",
-"register","array_length", "array",
-"s","pattern",
-"string","y",
-"print", "unary operation",
-"..",
-"||",
-"&&",
-"==","!=", "EQ", "NE",
-"<=",">=", "LT", "GT", "LE", "GE",
-"<<",">>",
-"=~","!~",
-"unary -",
-"++", "--",
-"???"
-};
+
+STAB *scrstab;
+ARG *arg4; /* rarely used arguments to make_op() */
+ARG *arg5;
%}
}
%token <cval> WORD
-%token <ival> APPEND OPEN WRITE SELECT CLOSE LOOPEX
-%token <ival> USING FORMAT DO SHIFT PUSH POP CHOP
-%token <ival> WHILE UNTIL IF UNLESS ELSE ELSIF CONTINUE SPLIT SPRINTF
-%token <ival> FOR FEOF TELL SEEK STAT
-%token <ival> FUNC0 FUNC1 FUNC2 FUNC3 STABFUN
-%token <ival> JOIN SUB
+%token <ival> APPEND OPEN SELECT LOOPEX
+%token <ival> USING FORMAT DO SHIFT PUSH POP LVALFUN
+%token <ival> WHILE UNTIL IF UNLESS ELSE ELSIF CONTINUE SPLIT FLIST
+%token <ival> FOR FILOP FILOP2 FILOP3 FILOP4 FILOP22 FILOP25
+%token <ival> FUNC0 FUNC1 FUNC2 FUNC3 HSHFUN HSHFUN3
+%token <ival> FLIST2 SUB FILETEST LOCAL DELETE
+%token <ival> RELOP EQOP MULOP ADDOP PACKAGE AMPER LFUNC4
%token <formval> FORMLIST
-%token <stabval> REG ARYLEN ARY
+%token <stabval> REG ARYLEN ARY HSH STAR
%token <arg> SUBST PATTERN
%token <arg> RSTRING TRANS
-%type <ival> prog decl format
-%type <stabval>
+%type <ival> prog decl format remember
%type <cmdval> block lineseq line loop cond sideff nexpr else
-%type <arg> expr sexpr term
-%type <arg> condmod loopmod cexpr
-%type <arg> texpr print
+%type <arg> expr sexpr cexpr csexpr term handle aryword hshword
+%type <arg> texpr listop
%type <cval> label
%type <compval> compblock
-%nonassoc <ival> PRINT
+%nonassoc <ival> LISTOP
%left ','
-%nonassoc <ival> UNIOP
%right '='
%right '?' ':'
%nonassoc DOTDOT
%left ANDAND
%left '|' '^'
%left '&'
-%nonassoc EQ NE SEQ SNE
-%nonassoc '<' '>' LE GE SLT SGT SLE SGE
+%nonassoc EQOP
+%nonassoc RELOP
+%nonassoc <ival> UNIOP
+%nonassoc FILETEST
%left LS RS
-%left '+' '-' '.'
-%left '*' '/' '%' 'x'
+%left ADDOP
+%left MULOP
%left MATCH NMATCH
%right '!' '~' UMINUS
+%right POW
%nonassoc INC DEC
%left '('
%% /* RULES */
-prog : lineseq
+prog : /* NULL */
+ {
+#if defined(YYDEBUG) && defined(DEBUGGING)
+ yydebug = (debug & 1);
+#endif
+ }
+ /*CONTINUED*/ lineseq
{ if (in_eval)
- eval_root = block_head($1);
+ eval_root = block_head($2);
else
- main_root = block_head($1); }
+ main_root = block_head($2); }
;
compblock: block CONTINUE block
| ELSE block
{ $$ = $2; }
| ELSIF '(' expr ')' compblock
- { $$ = make_ccmd(C_IF,$3,$5); }
+ { cmdline = $1;
+ $$ = make_ccmd(C_ELSIF,$3,$5); }
+ ;
+
+block : '{' remember lineseq '}'
+ { $$ = block_head($3);
+ if (savestack->ary_fill > $2)
+ restorelist($2); }
;
-block : '{' lineseq '}'
- { $$ = block_head($2); }
+remember: /* NULL */ /* in case they push a package name */
+ { $$ = savestack->ary_fill; }
;
lineseq : /* NULL */
| loop /* loops add their own labels */
| label ';'
{ if ($1 != Nullch) {
- $$ = add_label(make_acmd(C_EXPR, Nullstab,
+ $$ = add_label($1, make_acmd(C_EXPR, Nullstab,
Nullarg, Nullarg) );
} else
$$ = Nullcmd; }
{ $$ = add_label($1,$2); }
;
-sideff : expr
+sideff : error
+ { $$ = Nullcmd; }
+ | expr
{ $$ = make_acmd(C_EXPR, Nullstab, $1, Nullarg); }
- | expr condmod
+ | expr IF expr
{ $$ = addcond(
- make_acmd(C_EXPR, Nullstab, Nullarg, $1), $2); }
- | expr loopmod
+ make_acmd(C_EXPR, Nullstab, Nullarg, $1), $3); }
+ | expr UNLESS expr
+ { $$ = addcond(invert(
+ make_acmd(C_EXPR, Nullstab, Nullarg, $1)), $3); }
+ | expr WHILE expr
{ $$ = addloop(
- make_acmd(C_EXPR, Nullstab, Nullarg, $1), $2); }
+ make_acmd(C_EXPR, Nullstab, Nullarg, $1), $3); }
+ | expr UNTIL expr
+ { $$ = addloop(invert(
+ make_acmd(C_EXPR, Nullstab, Nullarg, $1)), $3); }
;
cond : IF '(' expr ')' compblock
- { $$ = make_ccmd(C_IF,$3,$5); }
+ { cmdline = $1;
+ $$ = make_icmd(C_IF,$3,$5); }
| UNLESS '(' expr ')' compblock
- { $$ = invert(make_ccmd(C_IF,$3,$5)); }
+ { cmdline = $1;
+ $$ = invert(make_icmd(C_IF,$3,$5)); }
| IF block compblock
- { $$ = make_ccmd(C_IF,cmd_to_arg($2),$3); }
+ { cmdline = $1;
+ $$ = make_ccmd(C_IF,cmd_to_arg($2),$3); }
| UNLESS block compblock
- { $$ = invert(make_ccmd(C_IF,cmd_to_arg($2),$3)); }
+ { cmdline = $1;
+ $$ = invert(make_ccmd(C_IF,cmd_to_arg($2),$3)); }
;
loop : label WHILE '(' texpr ')' compblock
- { $$ = wopt(add_label($1,
+ { cmdline = $2;
+ $$ = wopt(add_label($1,
make_ccmd(C_WHILE,$4,$6) )); }
| label UNTIL '(' expr ')' compblock
- { $$ = wopt(add_label($1,
+ { cmdline = $2;
+ $$ = wopt(add_label($1,
invert(make_ccmd(C_WHILE,$4,$6)) )); }
| label WHILE block compblock
- { $$ = wopt(add_label($1,
+ { cmdline = $2;
+ $$ = wopt(add_label($1,
make_ccmd(C_WHILE, cmd_to_arg($3),$4) )); }
| label UNTIL block compblock
- { $$ = wopt(add_label($1,
+ { cmdline = $2;
+ $$ = wopt(add_label($1,
invert(make_ccmd(C_WHILE, cmd_to_arg($3),$4)) )); }
+ | label FOR REG '(' expr ')' compblock
+ { cmdline = $2;
+ /*
+ * The following gobbledygook catches EXPRs that
+ * aren't explicit array refs and translates
+ * foreach VAR (EXPR) {
+ * into
+ * @ary = EXPR;
+ * foreach VAR (@ary) {
+ * where @ary is a hidden array made by genstab().
+ * (Note that @ary may become a local array if
+ * it is determined that it might be called
+ * recursively. See cmd_tosave().)
+ */
+ if ($5->arg_type != O_ARRAY) {
+ scrstab = aadd(genstab());
+ $$ = append_line(
+ make_acmd(C_EXPR, Nullstab,
+ l(make_op(O_ASSIGN,2,
+ listish(make_op(O_ARRAY, 1,
+ stab2arg(A_STAB,scrstab),
+ Nullarg,Nullarg, 1)),
+ listish(make_list($5)),
+ Nullarg)),
+ Nullarg),
+ wopt(over($3,add_label($1,
+ make_ccmd(C_WHILE,
+ make_op(O_ARRAY, 1,
+ stab2arg(A_STAB,scrstab),
+ Nullarg,Nullarg ),
+ $7)))));
+ $$->c_line = $2;
+ $$->c_head->c_line = $2;
+ }
+ else {
+ $$ = wopt(over($3,add_label($1,
+ make_ccmd(C_WHILE,$5,$7) )));
+ }
+ }
+ | label FOR '(' expr ')' compblock
+ { cmdline = $2;
+ if ($4->arg_type != O_ARRAY) {
+ scrstab = aadd(genstab());
+ $$ = append_line(
+ make_acmd(C_EXPR, Nullstab,
+ l(make_op(O_ASSIGN,2,
+ listish(make_op(O_ARRAY, 1,
+ stab2arg(A_STAB,scrstab),
+ Nullarg,Nullarg, 1 )),
+ listish(make_list($4)),
+ Nullarg)),
+ Nullarg),
+ wopt(over(defstab,add_label($1,
+ make_ccmd(C_WHILE,
+ make_op(O_ARRAY, 1,
+ stab2arg(A_STAB,scrstab),
+ Nullarg,Nullarg ),
+ $6)))));
+ $$->c_line = $2;
+ $$->c_head->c_line = $2;
+ }
+ else { /* lisp, anyone? */
+ $$ = wopt(over(defstab,add_label($1,
+ make_ccmd(C_WHILE,$4,$6) )));
+ }
+ }
| label FOR '(' nexpr ';' texpr ';' nexpr ')' block
/* basically fake up an initialize-while lineseq */
{ yyval.compval.comp_true = $10;
yyval.compval.comp_alt = $8;
+ cmdline = $2;
$$ = append_line($4,wopt(add_label($1,
make_ccmd(C_WHILE,$6,yyval.compval) ))); }
| label compblock /* a block is a loop that happens once */
;
texpr : /* NULL means true */
- { scanstr("1"); $$ = yylval.arg; }
+ { (void)scanstr("1"); $$ = yylval.arg; }
| expr
;
| WORD ':'
;
-loopmod : WHILE expr
- { $$ = $2; }
- | UNTIL expr
- { $$ = make_op(O_NOT,1,$2,Nullarg,Nullarg,0); }
- ;
-
-condmod : IF expr
- { $$ = $2; }
- | UNLESS expr
- { $$ = make_op(O_NOT,1,$2,Nullarg,Nullarg,0); }
- ;
-
decl : format
{ $$ = 0; }
| subrout
{ $$ = 0; }
+ | package
+ { $$ = 0; }
;
-format : FORMAT WORD '=' FORMLIST '.'
- { stabent($2,TRUE)->stab_form = $4; safefree($2); }
- | FORMAT '=' FORMLIST '.'
- { stabent("stdout",TRUE)->stab_form = $3; }
+format : FORMAT WORD '=' FORMLIST
+ { if (strEQ($2,"stdout"))
+ make_form(stabent("STDOUT",TRUE),$4);
+ else if (strEQ($2,"stderr"))
+ make_form(stabent("STDERR",TRUE),$4);
+ else
+ make_form(stabent($2,TRUE),$4);
+ Safefree($2);}
+ | FORMAT '=' FORMLIST
+ { make_form(stabent("STDOUT",TRUE),$3); }
;
subrout : SUB WORD block
- { stabent($2,TRUE)->stab_sub = $3; }
+ { make_sub($2,$3); }
;
-expr : print
- | cexpr
+package : PACKAGE WORD ';'
+ { char tmpbuf[256];
+
+ savehptr(&curstash);
+ saveitem(curstname);
+ str_set(curstname,$2);
+ sprintf(tmpbuf,"'_%s",$2);
+ curstash = stab_xhash(hadd(stabent(tmpbuf,TRUE)));
+ curstash->tbl_coeffsize = 0;
+ Safefree($2);
+ }
;
-cexpr : sexpr ',' cexpr
- { $$ = make_op(O_COMMA, 2, $1, $3, Nullarg,0); }
+cexpr : ',' expr
+ { $$ = $2; }
+ ;
+
+expr : expr ',' sexpr
+ { $$ = make_op(O_COMMA, 2, $1, $3, Nullarg); }
| sexpr
;
+csexpr : ',' sexpr
+ { $$ = $2; }
+ ;
+
sexpr : sexpr '=' sexpr
{ $1 = listish($1);
+ if ($1->arg_type == O_ASSIGN && $1->arg_len == 1)
+ $1->arg_type = O_ITEM; /* a local() */
if ($1->arg_type == O_LIST)
$3 = listish($3);
- $$ = l(make_op(O_ASSIGN, 2, $1, $3, Nullarg,1)); }
- | sexpr '*' '=' sexpr
- { $$ = l(make_op(O_MULTIPLY, 2, $1, $4, Nullarg,0)); }
- | sexpr '/' '=' sexpr
- { $$ = l(make_op(O_DIVIDE, 2, $1, $4, Nullarg,0)); }
- | sexpr '%' '=' sexpr
- { $$ = l(make_op(O_MODULO, 2, $1, $4, Nullarg,0)); }
- | sexpr 'x' '=' sexpr
- { $$ = l(make_op(O_REPEAT, 2, $1, $4, Nullarg,0)); }
- | sexpr '+' '=' sexpr
- { $$ = l(make_op(O_ADD, 2, $1, $4, Nullarg,0)); }
- | sexpr '-' '=' sexpr
- { $$ = l(make_op(O_SUBTRACT, 2, $1, $4, Nullarg,0)); }
+ $$ = l(make_op(O_ASSIGN, 2, $1, $3, Nullarg)); }
+ | sexpr POW '=' sexpr
+ { $$ = l(make_op(O_POW, 2, $1, $4, Nullarg)); }
+ | sexpr MULOP '=' sexpr
+ { $$ = l(make_op($2, 2, $1, $4, Nullarg)); }
+ | sexpr ADDOP '=' sexpr
+ { $$ = rcatmaybe(l(make_op($2, 2, $1, $4, Nullarg)));}
| sexpr LS '=' sexpr
- { $$ = l(make_op(O_LEFT_SHIFT, 2, $1, $4, Nullarg,0)); }
+ { $$ = l(make_op(O_LEFT_SHIFT, 2, $1, $4, Nullarg)); }
| sexpr RS '=' sexpr
- { $$ = l(make_op(O_RIGHT_SHIFT, 2, $1, $4, Nullarg,0)); }
+ { $$ = l(make_op(O_RIGHT_SHIFT, 2, $1, $4, Nullarg)); }
| sexpr '&' '=' sexpr
- { $$ = l(make_op(O_BIT_AND, 2, $1, $4, Nullarg,0)); }
+ { $$ = l(make_op(O_BIT_AND, 2, $1, $4, Nullarg)); }
| sexpr '^' '=' sexpr
- { $$ = l(make_op(O_XOR, 2, $1, $4, Nullarg,0)); }
+ { $$ = l(make_op(O_XOR, 2, $1, $4, Nullarg)); }
| sexpr '|' '=' sexpr
- { $$ = l(make_op(O_BIT_OR, 2, $1, $4, Nullarg,0)); }
- | sexpr '.' '=' sexpr
- { $$ = l(make_op(O_CONCAT, 2, $1, $4, Nullarg,0)); }
-
-
- | sexpr '*' sexpr
- { $$ = make_op(O_MULTIPLY, 2, $1, $3, Nullarg,0); }
- | sexpr '/' sexpr
- { $$ = make_op(O_DIVIDE, 2, $1, $3, Nullarg,0); }
- | sexpr '%' sexpr
- { $$ = make_op(O_MODULO, 2, $1, $3, Nullarg,0); }
- | sexpr 'x' sexpr
- { $$ = make_op(O_REPEAT, 2, $1, $3, Nullarg,0); }
- | sexpr '+' sexpr
- { $$ = make_op(O_ADD, 2, $1, $3, Nullarg,0); }
- | sexpr '-' sexpr
- { $$ = make_op(O_SUBTRACT, 2, $1, $3, Nullarg,0); }
+ { $$ = l(make_op(O_BIT_OR, 2, $1, $4, Nullarg)); }
+
+
+ | sexpr POW sexpr
+ { $$ = make_op(O_POW, 2, $1, $3, Nullarg); }
+ | sexpr MULOP sexpr
+ { $$ = make_op($2, 2, $1, $3, Nullarg); }
+ | sexpr ADDOP sexpr
+ { $$ = make_op($2, 2, $1, $3, Nullarg); }
| sexpr LS sexpr
- { $$ = make_op(O_LEFT_SHIFT, 2, $1, $3, Nullarg,0); }
+ { $$ = make_op(O_LEFT_SHIFT, 2, $1, $3, Nullarg); }
| sexpr RS sexpr
- { $$ = make_op(O_RIGHT_SHIFT, 2, $1, $3, Nullarg,0); }
- | sexpr '<' sexpr
- { $$ = make_op(O_LT, 2, $1, $3, Nullarg,0); }
- | sexpr '>' sexpr
- { $$ = make_op(O_GT, 2, $1, $3, Nullarg,0); }
- | sexpr LE sexpr
- { $$ = make_op(O_LE, 2, $1, $3, Nullarg,0); }
- | sexpr GE sexpr
- { $$ = make_op(O_GE, 2, $1, $3, Nullarg,0); }
- | sexpr EQ sexpr
- { $$ = make_op(O_EQ, 2, $1, $3, Nullarg,0); }
- | sexpr NE sexpr
- { $$ = make_op(O_NE, 2, $1, $3, Nullarg,0); }
- | sexpr SLT sexpr
- { $$ = make_op(O_SLT, 2, $1, $3, Nullarg,0); }
- | sexpr SGT sexpr
- { $$ = make_op(O_SGT, 2, $1, $3, Nullarg,0); }
- | sexpr SLE sexpr
- { $$ = make_op(O_SLE, 2, $1, $3, Nullarg,0); }
- | sexpr SGE sexpr
- { $$ = make_op(O_SGE, 2, $1, $3, Nullarg,0); }
- | sexpr SEQ sexpr
- { $$ = make_op(O_SEQ, 2, $1, $3, Nullarg,0); }
- | sexpr SNE sexpr
- { $$ = make_op(O_SNE, 2, $1, $3, Nullarg,0); }
+ { $$ = make_op(O_RIGHT_SHIFT, 2, $1, $3, Nullarg); }
+ | sexpr RELOP sexpr
+ { $$ = make_op($2, 2, $1, $3, Nullarg); }
+ | sexpr EQOP sexpr
+ { $$ = make_op($2, 2, $1, $3, Nullarg); }
| sexpr '&' sexpr
- { $$ = make_op(O_BIT_AND, 2, $1, $3, Nullarg,0); }
+ { $$ = make_op(O_BIT_AND, 2, $1, $3, Nullarg); }
| sexpr '^' sexpr
- { $$ = make_op(O_XOR, 2, $1, $3, Nullarg,0); }
+ { $$ = make_op(O_XOR, 2, $1, $3, Nullarg); }
| sexpr '|' sexpr
- { $$ = make_op(O_BIT_OR, 2, $1, $3, Nullarg,0); }
+ { $$ = make_op(O_BIT_OR, 2, $1, $3, Nullarg); }
| sexpr DOTDOT sexpr
- { $$ = make_op(O_FLIP, 4,
- flipflip($1),
- flipflip($3),
- Nullarg,0);}
+ { arg4 = Nullarg;
+ $$ = make_op(O_F_OR_R, 4, $1, $3, Nullarg); }
| sexpr ANDAND sexpr
- { $$ = make_op(O_AND, 2, $1, $3, Nullarg,0); }
+ { $$ = make_op(O_AND, 2, $1, $3, Nullarg); }
| sexpr OROR sexpr
- { $$ = make_op(O_OR, 2, $1, $3, Nullarg,0); }
+ { $$ = make_op(O_OR, 2, $1, $3, Nullarg); }
| sexpr '?' sexpr ':' sexpr
- { $$ = make_op(O_COND_EXPR, 3, $1, $3, $5,0); }
- | sexpr '.' sexpr
- { $$ = make_op(O_CONCAT, 2, $1, $3, Nullarg,0); }
+ { $$ = make_op(O_COND_EXPR, 3, $1, $3, $5); }
| sexpr MATCH sexpr
{ $$ = mod_match(O_MATCH, $1, $3); }
| sexpr NMATCH sexpr
{ $$ = mod_match(O_NMATCH, $1, $3); }
+ | term
+ { $$ = $1; }
+ ;
+
+term : '-' term %prec UMINUS
+ { $$ = make_op(O_NEGATE, 1, $2, Nullarg, Nullarg); }
+ | '+' term %prec UMINUS
+ { $$ = $2; }
+ | '!' term
+ { $$ = make_op(O_NOT, 1, $2, Nullarg, Nullarg); }
+ | '~' term
+ { $$ = make_op(O_COMPLEMENT, 1, $2, Nullarg, Nullarg);}
| term INC
{ $$ = addflags(1, AF_POST|AF_UP,
- l(make_op(O_ITEM,1,$1,Nullarg,Nullarg,0))); }
+ l(make_op(O_ITEM,1,$1,Nullarg,Nullarg))); }
| term DEC
{ $$ = addflags(1, AF_POST,
- l(make_op(O_ITEM,1,$1,Nullarg,Nullarg,0))); }
+ l(make_op(O_ITEM,1,$1,Nullarg,Nullarg))); }
| INC term
{ $$ = addflags(1, AF_PRE|AF_UP,
- l(make_op(O_ITEM,1,$2,Nullarg,Nullarg,0))); }
+ l(make_op(O_ITEM,1,$2,Nullarg,Nullarg))); }
| DEC term
{ $$ = addflags(1, AF_PRE,
- l(make_op(O_ITEM,1,$2,Nullarg,Nullarg,0))); }
- | term
- { $$ = $1; }
- ;
-
-term : '-' term %prec UMINUS
- { $$ = make_op(O_NEGATE, 1, $2, Nullarg, Nullarg,0); }
- | '!' term
- { $$ = make_op(O_NOT, 1, $2, Nullarg, Nullarg,0); }
- | '~' term
- { $$ = make_op(O_COMPLEMENT, 1, $2, Nullarg, Nullarg,0);}
+ l(make_op(O_ITEM,1,$2,Nullarg,Nullarg))); }
+ | FILETEST WORD
+ { opargs[$1] = 0; /* force it special */
+ $$ = make_op($1, 1,
+ stab2arg(A_STAB,stabent($2,TRUE)),
+ Nullarg, Nullarg);
+ }
+ | FILETEST sexpr
+ { opargs[$1] = 1;
+ $$ = make_op($1, 1, $2, Nullarg, Nullarg); }
+ | FILETEST
+ { opargs[$1] = ($1 != O_FTTTY);
+ $$ = make_op($1, 1,
+ stab2arg(A_STAB,
+ $1 == O_FTTTY?stabent("STDIN",TRUE):defstab),
+ Nullarg, Nullarg); }
+ | LOCAL '(' expr ')'
+ { $$ = l(localize(make_op(O_ASSIGN, 1,
+ localize(listish(make_list($3))),
+ Nullarg,Nullarg))); }
+ | '(' expr ',' ')'
+ { $$ = make_list(hide_ary($2)); }
| '(' expr ')'
{ $$ = make_list(hide_ary($2)); }
| '(' ')'
{ $$ = make_list(Nullarg); }
+ | DO sexpr %prec FILETEST
+ { $$ = fixeval(
+ make_op(O_DOFILE,2,$2,Nullarg,Nullarg) );
+ allstabs = TRUE;}
| DO block %prec '('
{ $$ = cmd_to_arg($2); }
| REG %prec '('
- { $$ = stab_to_arg(A_STAB,$1); }
+ { $$ = stab2arg(A_STAB,$1); }
+ | STAR %prec '('
+ { $$ = stab2arg(A_STAR,$1); }
| REG '[' expr ']' %prec '('
- { $$ = make_op(O_ARRAY, 2,
- $3, stab_to_arg(A_STAB,aadd($1)), Nullarg,0); }
+ { $$ = make_op(O_AELEM, 2,
+ stab2arg(A_STAB,aadd($1)), $3, Nullarg); }
+ | HSH %prec '('
+ { $$ = make_op(O_HASH, 1,
+ stab2arg(A_STAB,$1),
+ Nullarg, Nullarg); }
| ARY %prec '('
{ $$ = make_op(O_ARRAY, 1,
- stab_to_arg(A_STAB,$1),
- Nullarg, Nullarg, 1); }
+ stab2arg(A_STAB,$1),
+ Nullarg, Nullarg); }
| REG '{' expr '}' %prec '('
- { $$ = make_op(O_HASH, 2,
- $3, stab_to_arg(A_STAB,hadd($1)), Nullarg,0); }
+ { $$ = make_op(O_HELEM, 2,
+ stab2arg(A_STAB,hadd($1)),
+ jmaybe($3),
+ Nullarg); }
+ | '(' expr ')' '[' expr ']' %prec '('
+ { $$ = make_op(O_LSLICE, 3,
+ Nullarg,
+ listish(make_list($5)),
+ listish(make_list($2))); }
+ | ARY '[' expr ']' %prec '('
+ { $$ = make_op(O_ASLICE, 2,
+ stab2arg(A_STAB,aadd($1)),
+ listish(make_list($3)),
+ Nullarg); }
+ | ARY '{' expr '}' %prec '('
+ { $$ = make_op(O_HSLICE, 2,
+ stab2arg(A_STAB,hadd($1)),
+ listish(make_list($3)),
+ Nullarg); }
+ | DELETE REG '{' expr '}' %prec '('
+ { $$ = make_op(O_DELETE, 2,
+ stab2arg(A_STAB,hadd($2)),
+ jmaybe($4),
+ Nullarg); }
| ARYLEN %prec '('
- { $$ = stab_to_arg(A_ARYLEN,$1); }
+ { $$ = stab2arg(A_ARYLEN,$1); }
| RSTRING %prec '('
{ $$ = $1; }
| PATTERN %prec '('
| TRANS %prec '('
{ $$ = $1; }
| DO WORD '(' expr ')'
- { $$ = make_op(O_SUBR, 2,
+ { $$ = make_op((perldb ? O_DBSUBR : O_SUBR), 2,
+ stab2arg(A_WORD,stabent($2,TRUE)),
make_list($4),
- stab_to_arg(A_STAB,stabent($2,TRUE)),
- Nullarg,1); }
+ Nullarg); Safefree($2); }
+ | AMPER WORD '(' expr ')'
+ { $$ = make_op((perldb ? O_DBSUBR : O_SUBR), 2,
+ stab2arg(A_WORD,stabent($2,TRUE)),
+ make_list($4),
+ Nullarg); Safefree($2); }
| DO WORD '(' ')'
- { $$ = make_op(O_SUBR, 2,
+ { $$ = make_op((perldb ? O_DBSUBR : O_SUBR), 2,
+ stab2arg(A_WORD,stabent($2,TRUE)),
+ make_list(Nullarg),
+ Nullarg); }
+ | AMPER WORD '(' ')'
+ { $$ = make_op((perldb ? O_DBSUBR : O_SUBR), 2,
+ stab2arg(A_WORD,stabent($2,TRUE)),
make_list(Nullarg),
- stab_to_arg(A_STAB,stabent($2,TRUE)),
- Nullarg,1); }
+ Nullarg); }
+ | AMPER WORD
+ { $$ = make_op((perldb ? O_DBSUBR : O_SUBR), 2,
+ stab2arg(A_WORD,stabent($2,TRUE)),
+ Nullarg,
+ Nullarg); }
+ | DO REG '(' expr ')'
+ { $$ = make_op((perldb ? O_DBSUBR : O_SUBR), 2,
+ stab2arg(A_STAB,$2),
+ make_list($4),
+ Nullarg); }
+ | AMPER REG '(' expr ')'
+ { $$ = make_op((perldb ? O_DBSUBR : O_SUBR), 2,
+ stab2arg(A_STAB,$2),
+ make_list($4),
+ Nullarg); }
+ | DO REG '(' ')'
+ { $$ = make_op((perldb ? O_DBSUBR : O_SUBR), 2,
+ stab2arg(A_STAB,$2),
+ make_list(Nullarg),
+ Nullarg); }
+ | AMPER REG '(' ')'
+ { $$ = make_op((perldb ? O_DBSUBR : O_SUBR), 2,
+ stab2arg(A_STAB,$2),
+ make_list(Nullarg),
+ Nullarg); }
+ | AMPER REG
+ { $$ = make_op((perldb ? O_DBSUBR : O_SUBR), 2,
+ stab2arg(A_STAB,$2),
+ Nullarg,
+ Nullarg); }
| LOOPEX
- { $$ = make_op($1,0,Nullarg,Nullarg,Nullarg,0); }
+ { $$ = make_op($1,0,Nullarg,Nullarg,Nullarg); }
| LOOPEX WORD
{ $$ = make_op($1,1,cval_to_arg($2),
- Nullarg,Nullarg,0); }
+ Nullarg,Nullarg); }
| UNIOP
- { $$ = make_op($1,1,Nullarg,Nullarg,Nullarg,0); }
+ { $$ = make_op($1,0,Nullarg,Nullarg,Nullarg);
+ if ($1 == O_EVAL || $1 == O_RESET)
+ $$ = fixeval($$); }
| UNIOP sexpr
- { $$ = make_op($1,1,$2,Nullarg,Nullarg,0); }
- | WRITE
- { $$ = make_op(O_WRITE, 0,
- Nullarg, Nullarg, Nullarg,0); }
- | WRITE '(' ')'
- { $$ = make_op(O_WRITE, 0,
- Nullarg, Nullarg, Nullarg,0); }
- | WRITE '(' WORD ')'
- { $$ = l(make_op(O_WRITE, 1,
- stab_to_arg(A_STAB,stabent($3,TRUE)),
- Nullarg, Nullarg,0)); safefree($3); }
- | WRITE '(' expr ')'
- { $$ = make_op(O_WRITE, 1, $3, Nullarg, Nullarg,0); }
- | SELECT '(' WORD ')'
- { $$ = l(make_op(O_SELECT, 1,
- stab_to_arg(A_STAB,stabent($3,TRUE)),
- Nullarg, Nullarg,0)); safefree($3); }
- | SELECT '(' expr ')'
- { $$ = make_op(O_SELECT, 1, $3, Nullarg, Nullarg,0); }
+ { $$ = make_op($1,1,$2,Nullarg,Nullarg);
+ if ($1 == O_EVAL || $1 == O_RESET)
+ $$ = fixeval($$); }
+ | SELECT
+ { $$ = make_op(O_SELECT, 0, Nullarg, Nullarg, Nullarg);}
+ | SELECT '(' handle ')'
+ { $$ = make_op(O_SELECT, 1, $3, Nullarg, Nullarg); }
+ | SELECT '(' sexpr csexpr csexpr csexpr ')'
+ { arg4 = $6;
+ $$ = make_op(O_SSELECT, 4, $3, $4, $5); }
| OPEN WORD %prec '('
{ $$ = make_op(O_OPEN, 2,
- stab_to_arg(A_STAB,stabent($2,TRUE)),
- stab_to_arg(A_STAB,stabent($2,TRUE)),
- Nullarg,0); }
+ stab2arg(A_WORD,stabent($2,TRUE)),
+ stab2arg(A_STAB,stabent($2,TRUE)),
+ Nullarg); }
| OPEN '(' WORD ')'
{ $$ = make_op(O_OPEN, 2,
- stab_to_arg(A_STAB,stabent($3,TRUE)),
- stab_to_arg(A_STAB,stabent($3,TRUE)),
- Nullarg,0); }
- | OPEN '(' WORD ',' expr ')'
+ stab2arg(A_WORD,stabent($3,TRUE)),
+ stab2arg(A_STAB,stabent($3,TRUE)),
+ Nullarg); }
+ | OPEN '(' handle cexpr ')'
{ $$ = make_op(O_OPEN, 2,
- stab_to_arg(A_STAB,stabent($3,TRUE)),
- $5, Nullarg,0); }
- | CLOSE '(' WORD ')'
- { $$ = make_op(O_CLOSE, 1,
- stab_to_arg(A_STAB,stabent($3,TRUE)),
- Nullarg, Nullarg,0); }
- | CLOSE WORD %prec '('
- { $$ = make_op(O_CLOSE, 1,
- stab_to_arg(A_STAB,stabent($2,TRUE)),
- Nullarg, Nullarg,0); }
- | FEOF '(' WORD ')'
- { $$ = make_op(O_EOF, 1,
- stab_to_arg(A_STAB,stabent($3,TRUE)),
- Nullarg, Nullarg,0); }
- | FEOF '(' ')'
- { $$ = make_op(O_EOF, 0,
- stab_to_arg(A_STAB,stabent("ARGV",TRUE)),
- Nullarg, Nullarg,0); }
- | FEOF
- { $$ = make_op(O_EOF, 0,
- Nullarg, Nullarg, Nullarg,0); }
- | TELL '(' WORD ')'
- { $$ = make_op(O_TELL, 1,
- stab_to_arg(A_STAB,stabent($3,TRUE)),
- Nullarg, Nullarg,0); }
- | TELL
- { $$ = make_op(O_TELL, 0,
- Nullarg, Nullarg, Nullarg,0); }
- | SEEK '(' WORD ',' sexpr ',' expr ')'
- { $$ = make_op(O_SEEK, 3,
- stab_to_arg(A_STAB,stabent($3,TRUE)),
- $5, $7,1); }
- | PUSH '(' WORD ',' expr ')'
- { $$ = make_op($1, 2,
- make_list($5),
- stab_to_arg(A_STAB,aadd(stabent($3,TRUE))),
- Nullarg,1); }
- | PUSH '(' ARY ',' expr ')'
+ $3,
+ $4, Nullarg); }
+ | FILOP '(' handle ')'
+ { $$ = make_op($1, 1,
+ $3,
+ Nullarg, Nullarg); }
+ | FILOP WORD
+ { $$ = make_op($1, 1,
+ stab2arg(A_WORD,stabent($2,TRUE)),
+ Nullarg, Nullarg);
+ Safefree($2); }
+ | FILOP REG
+ { $$ = make_op($1, 1,
+ stab2arg(A_STAB,$2),
+ Nullarg, Nullarg); }
+ | FILOP '(' ')'
+ { $$ = make_op($1, 1,
+ stab2arg(A_WORD,Nullstab),
+ Nullarg, Nullarg); }
+ | FILOP %prec '('
+ { $$ = make_op($1, 0,
+ Nullarg, Nullarg, Nullarg); }
+ | FILOP2 '(' handle cexpr ')'
+ { $$ = make_op($1, 2, $3, $4, Nullarg); }
+ | FILOP3 '(' handle csexpr cexpr ')'
+ { $$ = make_op($1, 3, $3, $4, make_list($5)); }
+ | FILOP22 '(' handle ',' handle ')'
+ { $$ = make_op($1, 2, $3, $5, Nullarg); }
+ | FILOP4 '(' handle csexpr csexpr cexpr ')'
+ { arg4 = $6; $$ = make_op($1, 4, $3, $4, $5); }
+ | FILOP25 '(' handle ',' handle csexpr csexpr cexpr ')'
+ { arg4 = $7; arg5 = $8;
+ $$ = make_op($1, 5, $3, $5, $6); }
+ | PUSH '(' aryword cexpr ')'
{ $$ = make_op($1, 2,
- make_list($5),
- stab_to_arg(A_STAB,$3),
- Nullarg,1); }
- | POP WORD %prec '('
- { $$ = make_op(O_POP, 1,
- stab_to_arg(A_STAB,aadd(stabent($2,TRUE))),
- Nullarg, Nullarg,0); }
- | POP '(' WORD ')'
- { $$ = make_op(O_POP, 1,
- stab_to_arg(A_STAB,aadd(stabent($3,TRUE))),
- Nullarg, Nullarg,0); }
- | POP ARY %prec '('
- { $$ = make_op(O_POP, 1,
- stab_to_arg(A_STAB,$2),
- Nullarg,
- Nullarg,
- 0); }
- | POP '(' ARY ')'
- { $$ = make_op(O_POP, 1,
- stab_to_arg(A_STAB,$3),
- Nullarg,
- Nullarg,
- 0); }
- | SHIFT WORD %prec '('
- { $$ = make_op(O_SHIFT, 1,
- stab_to_arg(A_STAB,aadd(stabent($2,TRUE))),
- Nullarg, Nullarg,0); }
- | SHIFT '(' WORD ')'
- { $$ = make_op(O_SHIFT, 1,
- stab_to_arg(A_STAB,aadd(stabent($3,TRUE))),
- Nullarg, Nullarg,0); }
- | SHIFT ARY %prec '('
- { $$ = make_op(O_SHIFT, 1,
- stab_to_arg(A_STAB,$2), Nullarg, Nullarg,0); }
- | SHIFT '(' ARY ')'
- { $$ = make_op(O_SHIFT, 1,
- stab_to_arg(A_STAB,$3), Nullarg, Nullarg,0); }
+ $3,
+ make_list($4),
+ Nullarg); }
+ | POP aryword %prec '('
+ { $$ = make_op(O_POP, 1, $2, Nullarg, Nullarg); }
+ | POP '(' aryword ')'
+ { $$ = make_op(O_POP, 1, $3, Nullarg, Nullarg); }
+ | SHIFT aryword %prec '('
+ { $$ = make_op(O_SHIFT, 1, $2, Nullarg, Nullarg); }
+ | SHIFT '(' aryword ')'
+ { $$ = make_op(O_SHIFT, 1, $3, Nullarg, Nullarg); }
| SHIFT %prec '('
{ $$ = make_op(O_SHIFT, 1,
- stab_to_arg(A_STAB,aadd(stabent("ARGV",TRUE))),
- Nullarg, Nullarg,0); }
+ stab2arg(A_STAB,
+ aadd(stabent(subline ? "_" : "ARGV", TRUE))),
+ Nullarg, Nullarg); }
| SPLIT %prec '('
- { scanpat("/[ \t\n]+/");
- $$ = make_split(defstab,yylval.arg); }
- | SPLIT '(' WORD ')'
- { scanpat("/[ \t\n]+/");
- $$ = make_split(stabent($3,TRUE),yylval.arg); }
- | SPLIT '(' WORD ',' PATTERN ')'
- { $$ = make_split(stabent($3,TRUE),$5); }
- | SPLIT '(' WORD ',' PATTERN ',' sexpr ')'
- { $$ = mod_match(O_MATCH,
- $7,
- make_split(stabent($3,TRUE),$5) ); }
- | SPLIT '(' sexpr ',' sexpr ')'
- { $$ = mod_match(O_MATCH, $5, make_split(defstab,$3) ); }
+ { (void)scanpat("/\\s+/");
+ $$ = make_split(defstab,yylval.arg,Nullarg); }
+ | SPLIT '(' sexpr csexpr csexpr ')'
+ { $$ = mod_match(O_MATCH, $4,
+ make_split(defstab,$3,$5));}
+ | SPLIT '(' sexpr csexpr ')'
+ { $$ = mod_match(O_MATCH, $4,
+ make_split(defstab,$3,Nullarg) ); }
| SPLIT '(' sexpr ')'
{ $$ = mod_match(O_MATCH,
- stab_to_arg(A_STAB,defstab),
- make_split(defstab,$3) ); }
- | JOIN '(' WORD ',' expr ')'
- { $$ = make_op(O_JOIN, 2,
- $5,
- stab_to_arg(A_STAB,aadd(stabent($3,TRUE))),
- Nullarg,0); }
- | JOIN '(' sexpr ',' expr ')'
- { $$ = make_op(O_JOIN, 2,
+ stab2arg(A_STAB,defstab),
+ make_split(defstab,$3,Nullarg) ); }
+ | FLIST2 '(' sexpr cexpr ')'
+ { $$ = make_op($1, 2,
$3,
- make_list($5),
- Nullarg,2); }
- | SPRINTF '(' expr ')'
- { $$ = make_op(O_SPRINTF, 1,
+ listish(make_list($4)),
+ Nullarg); }
+ | FLIST '(' expr ')'
+ { $$ = make_op($1, 1,
make_list($3),
Nullarg,
- Nullarg,1); }
- | STAT '(' WORD ')'
- { $$ = l(make_op(O_STAT, 1,
- stab_to_arg(A_STAB,stabent($3,TRUE)),
- Nullarg, Nullarg,0)); }
- | STAT '(' expr ')'
- { $$ = make_op(O_STAT, 1, $3, Nullarg, Nullarg,0); }
- | CHOP
- { $$ = l(make_op(O_CHOP, 1,
- stab_to_arg(A_STAB,defstab),
- Nullarg, Nullarg,0)); }
- | CHOP '(' expr ')'
- { $$ = l(make_op(O_CHOP, 1, $3, Nullarg, Nullarg,0)); }
+ Nullarg); }
+ | LVALFUN sexpr %prec '('
+ { $$ = l(make_op($1, 1, fixl($1,$2),
+ Nullarg, Nullarg)); }
+ | LVALFUN
+ { $$ = l(make_op($1, 1,
+ stab2arg(A_STAB,defstab),
+ Nullarg, Nullarg)); }
| FUNC0
- { $$ = make_op($1, 0, Nullarg, Nullarg, Nullarg,0); }
+ { $$ = make_op($1, 0, Nullarg, Nullarg, Nullarg); }
+ | FUNC0 '(' ')'
+ { $$ = make_op($1, 0, Nullarg, Nullarg, Nullarg); }
+ | FUNC1 '(' ')'
+ { $$ = make_op($1, 0, Nullarg, Nullarg, Nullarg);
+ if ($1 == O_EVAL || $1 == O_RESET)
+ $$ = fixeval($$); }
| FUNC1 '(' expr ')'
- { $$ = make_op($1, 1, $3, Nullarg, Nullarg,0); }
- | FUNC2 '(' sexpr ',' expr ')'
- { $$ = make_op($1, 2, $3, $5, Nullarg, 0); }
- | FUNC3 '(' sexpr ',' sexpr ',' expr ')'
- { $$ = make_op($1, 3, $3, $5, $7, 0); }
- | STABFUN '(' WORD ')'
+ { $$ = make_op($1, 1, $3, Nullarg, Nullarg);
+ if ($1 == O_EVAL || $1 == O_RESET)
+ $$ = fixeval($$); }
+ | FUNC2 '(' sexpr cexpr ')'
+ { $$ = make_op($1, 2, $3, $4, Nullarg);
+ if ($1 == O_INDEX && $$[2].arg_type == A_SINGLE)
+ fbmcompile($$[2].arg_ptr.arg_str,0); }
+ | FUNC3 '(' sexpr csexpr cexpr ')'
+ { $$ = make_op($1, 3, $3, $4, $5); }
+ | LFUNC4 '(' sexpr csexpr csexpr cexpr ')'
+ { arg4 = $6; $$ = make_op($1, 4, l($3), $4, $5); }
+ | HSHFUN '(' hshword ')'
+ { $$ = make_op($1, 1,
+ $3,
+ Nullarg,
+ Nullarg); }
+ | HSHFUN hshword
{ $$ = make_op($1, 1,
- stab_to_arg(A_STAB,hadd(stabent($3,TRUE))),
+ $2,
Nullarg,
- Nullarg, 0); }
+ Nullarg); }
+ | HSHFUN3 '(' hshword csexpr cexpr ')'
+ { $$ = make_op($1, 3, $3, $4, $5); }
+ | listop
;
-print : PRINT
+listop : LISTOP
{ $$ = make_op($1,2,
- stab_to_arg(A_STAB,defstab),
- stab_to_arg(A_STAB,Nullstab),
- Nullarg,0); }
- | PRINT expr
- { $$ = make_op($1,2,make_list($2),
- stab_to_arg(A_STAB,Nullstab),
- Nullarg,1); }
- | PRINT WORD
+ stab2arg(A_WORD,Nullstab),
+ stab2arg(A_STAB,defstab),
+ Nullarg); }
+ | LISTOP expr
{ $$ = make_op($1,2,
- stab_to_arg(A_STAB,defstab),
- stab_to_arg(A_STAB,stabent($2,TRUE)),
- Nullarg,1); }
- | PRINT WORD expr
- { $$ = make_op($1,2,make_list($3),
- stab_to_arg(A_STAB,stabent($2,TRUE)),
- Nullarg,1); }
+ stab2arg(A_WORD,Nullstab),
+ maybelistish($1,make_list($2)),
+ Nullarg); }
+ | LISTOP WORD
+ { $$ = make_op($1,2,
+ stab2arg(A_WORD,stabent($2,TRUE)),
+ stab2arg(A_STAB,defstab),
+ Nullarg); }
+ | LISTOP WORD expr
+ { $$ = make_op($1,2,
+ stab2arg(A_WORD,stabent($2,TRUE)),
+ maybelistish($1,make_list($3)),
+ Nullarg); Safefree($2); }
+ | LISTOP REG expr
+ { $$ = make_op($1,2,
+ stab2arg(A_STAB,$2),
+ maybelistish($1,make_list($3)),
+ Nullarg); }
+ ;
+
+handle : WORD
+ { $$ = stab2arg(A_WORD,stabent($1,TRUE)); Safefree($1);}
+ | sexpr
+ ;
+
+aryword : WORD
+ { $$ = stab2arg(A_WORD,aadd(stabent($1,TRUE)));
+ Safefree($1); }
+ | ARY
+ { $$ = stab2arg(A_STAB,$1); }
+ ;
+
+hshword : WORD
+ { $$ = stab2arg(A_WORD,hadd(stabent($1,TRUE)));
+ Safefree($1); }
+ | HSH
+ { $$ = stab2arg(A_STAB,$1); }
;
%% /* PROGRAM */
-#include "perly.c"