perl.y

   1 /* $Header: perl.y,v 3.0.1.9 90/10/15 18:01:45 lwall Locked $
   2  *
   3  *    Copyright (c) 1989, Larry Wall
   4  *
   5  *    You may distribute under the terms of the GNU General Public License
   6  *    as specified in the README file that comes with the perl 3.0 kit.
   7  *
   8  * $Log:        perl.y,v $
   9  * Revision 3.0.1.9  90/10/15  18:01:45  lwall
  10  * patch29: added SysV IPC
  11  * patch29: package behavior is now more consistent
  12  * patch29: index and substr now have optional 3rd args
  13  *
  14  * Revision 3.0.1.8  90/08/13  22:19:55  lwall
  15  * patch28: lowercase unquoted strings caused infinite loop
  16  *
  17  * Revision 3.0.1.7  90/08/09  04:17:44  lwall
  18  * patch19: did preliminary work toward debugging packages and evals
  19  * patch19: added require operator
  20  * patch19: bare identifiers are now strings if no other interpretation possible
  21  * patch19: null-label lines threw off line number of next statement
  22  * patch19: split; didn't pass correct bufend to scanpat
  23  *
  24  * Revision 3.0.1.6  90/03/27  16:13:45  lwall
  25  * patch16: formats didn't work inside eval
  26  *
  27  * Revision 3.0.1.5  90/03/12  16:55:56  lwall
  28  * patch13: added list slice operator (LIST)[LIST]
  29  * patch13: (LIST,) now legal
  30  *
  31  * Revision 3.0.1.4  90/02/28  18:03:23  lwall
  32  * patch9: line numbers were bogus during certain portions of foreach evaluation
  33  *
  34  * Revision 3.0.1.3  89/12/21  20:13:41  lwall
  35  * patch7: send() didn't allow a TO argument
  36  *
  37  * Revision 3.0.1.2  89/11/11  04:49:04  lwall
  38  * patch2: moved yydebug to where its type doesn't matter
  39  * patch2: !$foo++ was unreasonably illegal
  40  * patch2: local(@foo) didn't work
  41  * patch2: default args to unary operators didn't work
  42  *
  43  * Revision 3.0.1.1  89/10/26  23:20:41  lwall
  44  * patch1: grandfathered "format stdout"
  45  * patch1: operator(); is now normally equivalent to operator;
  46  *
  47  * Revision 3.0  89/10/18  15:22:04  lwall
  48  * 3.0 baseline
  49  *
  50  */
  51
  52 %{
  53 #include "INTERN.h"
  54 #include "perl.h"
  55
  56 STAB *scrstab;
  57 ARG *arg4;      /* rarely used arguments to make_op() */
  58 ARG *arg5;
  59
  60 %}
  61
  62 %start prog
  63
  64 %union {
  65     int ival;
  66     char *cval;
  67     ARG *arg;
  68     CMD *cmdval;
  69     struct compcmd compval;
  70     STAB *stabval;
  71     FCMD *formval;
  72 }
  73
  74 %token <cval> WORD
  75 %token <ival> APPEND OPEN SSELECT LOOPEX
  76 %token <ival> USING FORMAT DO SHIFT PUSH POP LVALFUN
  77 %token <ival> WHILE UNTIL IF UNLESS ELSE ELSIF CONTINUE SPLIT FLIST
  78 %token <ival> FOR FILOP FILOP2 FILOP3 FILOP4 FILOP22 FILOP25
  79 %token <ival> FUNC0 FUNC1 FUNC2 FUNC2x FUNC3 FUNC4 FUNC5 HSHFUN HSHFUN3
  80 %token <ival> FLIST2 SUB FILETEST LOCAL DELETE
  81 %token <ival> RELOP EQOP MULOP ADDOP PACKAGE AMPER
  82 %token <formval> FORMLIST
  83 %token <stabval> REG ARYLEN ARY HSH STAR
  84 %token <arg> SUBST PATTERN
  85 %token <arg> RSTRING TRANS
  86
  87 %type <ival> prog decl format remember
  88 %type <cmdval> block lineseq line loop cond sideff nexpr else
  89 %type <arg> expr sexpr cexpr csexpr term handle aryword hshword
  90 %type <arg> texpr listop bareword
  91 %type <cval> label
  92 %type <compval> compblock
  93
  94 %nonassoc <ival> LISTOP
  95 %left ','
  96 %right '='
  97 %right '?' ':'
  98 %nonassoc DOTDOT
  99 %left OROR
 100 %left ANDAND
 101 %left '|' '^'
 102 %left '&'
 103 %nonassoc EQOP
 104 %nonassoc RELOP
 105 %nonassoc <ival> UNIOP
 106 %nonassoc FILETEST
 107 %left LS RS
 108 %left ADDOP
 109 %left MULOP
 110 %left MATCH NMATCH
 111 %right '!' '~' UMINUS
 112 %right POW
 113 %nonassoc INC DEC
 114 %left '('
 115
 116 %% /* RULES */
 117
 118 prog    :       /* NULL */
 119                 {
 120 #if defined(YYDEBUG) && defined(DEBUGGING)
 121                     yydebug = (debug & 1);
 122 #endif
 123                 }
 124         /*CONTINUED*/   lineseq
 125                         { if (in_eval)
 126                                 eval_root = block_head($2);
 127                             else
 128                                 main_root = block_head($2); }
 129         ;
 130
 131 compblock:      block CONTINUE block
 132                         { $$.comp_true = $1; $$.comp_alt = $3; }
 133         |       block else
 134                         { $$.comp_true = $1; $$.comp_alt = $2; }
 135         ;
 136
 137 else    :       /* NULL */
 138                         { $$ = Nullcmd; }
 139         |       ELSE block
 140                         { $$ = $2; }
 141         |       ELSIF '(' expr ')' compblock
 142                         { cmdline = $1;
 143                             $$ = make_ccmd(C_ELSIF,$3,$5); }
 144         ;
 145
 146 block   :       '{' remember lineseq '}'
 147                         { $$ = block_head($3);
 148                           if (savestack->ary_fill > $2)
 149                             restorelist($2); }
 150         ;
 151
 152 remember:       /* NULL */      /* in case they push a package name */
 153                         { $$ = savestack->ary_fill; }
 154         ;
 155
 156 lineseq :       /* NULL */
 157                         { $$ = Nullcmd; }
 158         |       lineseq line
 159                         { $$ = append_line($1,$2); }
 160         ;
 161
 162 line    :       decl
 163                         { $$ = Nullcmd; }
 164         |       label cond
 165                         { $$ = add_label($1,$2); }
 166         |       loop    /* loops add their own labels */
 167         |       label ';'
 168                         { if ($1 != Nullch) {
 169                               $$ = add_label($1, make_acmd(C_EXPR, Nullstab,
 170                                   Nullarg, Nullarg) );
 171                             }
 172                             else {
 173                               $$ = Nullcmd;
 174                               cmdline = NOLINE;
 175                             } }
 176         |       label sideff ';'
 177                         { $$ = add_label($1,$2); }
 178         ;
 179
 180 sideff  :       error
 181                         { $$ = Nullcmd; }
 182         |       expr
 183                         { $$ = make_acmd(C_EXPR, Nullstab, $1, Nullarg); }
 184         |       expr IF expr
 185                         { $$ = addcond(
 186                                make_acmd(C_EXPR, Nullstab, Nullarg, $1), $3); }
 187         |       expr UNLESS expr
 188                         { $$ = addcond(invert(
 189                                make_acmd(C_EXPR, Nullstab, Nullarg, $1)), $3); }
 190         |       expr WHILE expr
 191                         { $$ = addloop(
 192                                make_acmd(C_EXPR, Nullstab, Nullarg, $1), $3); }
 193         |       expr UNTIL expr
 194                         { $$ = addloop(invert(
 195                                make_acmd(C_EXPR, Nullstab, Nullarg, $1)), $3); }
 196         ;
 197
 198 cond    :       IF '(' expr ')' compblock
 199                         { cmdline = $1;
 200                             $$ = make_icmd(C_IF,$3,$5); }
 201         |       UNLESS '(' expr ')' compblock
 202                         { cmdline = $1;
 203                             $$ = invert(make_icmd(C_IF,$3,$5)); }
 204         |       IF block compblock
 205                         { cmdline = $1;
 206                             $$ = make_ccmd(C_IF,cmd_to_arg($2),$3); }
 207         |       UNLESS block compblock
 208                         { cmdline = $1;
 209                             $$ = invert(make_ccmd(C_IF,cmd_to_arg($2),$3)); }
 210         ;
 211
 212 loop    :       label WHILE '(' texpr ')' compblock
 213                         { cmdline = $2;
 214                             $$ = wopt(add_label($1,
 215                             make_ccmd(C_WHILE,$4,$6) )); }
 216         |       label UNTIL '(' expr ')' compblock
 217                         { cmdline = $2;
 218                             $$ = wopt(add_label($1,
 219                             invert(make_ccmd(C_WHILE,$4,$6)) )); }
 220         |       label WHILE block compblock
 221                         { cmdline = $2;
 222                             $$ = wopt(add_label($1,
 223                             make_ccmd(C_WHILE, cmd_to_arg($3),$4) )); }
 224         |       label UNTIL block compblock
 225                         { cmdline = $2;
 226                             $$ = wopt(add_label($1,
 227                             invert(make_ccmd(C_WHILE, cmd_to_arg($3),$4)) )); }
 228         |       label FOR REG '(' expr ')' compblock
 229                         { cmdline = $2;
 230                             /*
 231                              * The following gobbledygook catches EXPRs that
 232                              * aren't explicit array refs and translates
 233                              *          foreach VAR (EXPR) {
 234                              * into
 235                              *          @ary = EXPR;
 236                              *          foreach VAR (@ary) {
 237                              * where @ary is a hidden array made by genstab().
 238                              * (Note that @ary may become a local array if
 239                              * it is determined that it might be called
 240                              * recursively.  See cmd_tosave().)
 241                              */
 242                             if ($5->arg_type != O_ARRAY) {
 243                                 scrstab = aadd(genstab());
 244                                 $$ = append_line(
 245                                     make_acmd(C_EXPR, Nullstab,
 246                                       l(make_op(O_ASSIGN,2,
 247                                         listish(make_op(O_ARRAY, 1,
 248                                           stab2arg(A_STAB,scrstab),
 249                                           Nullarg,Nullarg )),
 250                                         listish(make_list($5)),
 251                                         Nullarg)),
 252                                       Nullarg),
 253                                     wopt(over($3,add_label($1,
 254                                       make_ccmd(C_WHILE,
 255                                         make_op(O_ARRAY, 1,
 256                                           stab2arg(A_STAB,scrstab),
 257                                           Nullarg,Nullarg ),
 258                                         $7)))));
 259                                 $$->c_line = $2;
 260                                 $$->c_head->c_line = $2;
 261                             }
 262                             else {
 263                                 $$ = wopt(over($3,add_label($1,
 264                                 make_ccmd(C_WHILE,$5,$7) )));
 265                             }
 266                         }
 267         |       label FOR '(' expr ')' compblock
 268                         { cmdline = $2;
 269                             if ($4->arg_type != O_ARRAY) {
 270                                 scrstab = aadd(genstab());
 271                                 $$ = append_line(
 272                                     make_acmd(C_EXPR, Nullstab,
 273                                       l(make_op(O_ASSIGN,2,
 274                                         listish(make_op(O_ARRAY, 1,
 275                                           stab2arg(A_STAB,scrstab),
 276                                           Nullarg,Nullarg )),
 277                                         listish(make_list($4)),
 278                                         Nullarg)),
 279                                       Nullarg),
 280                                     wopt(over(defstab,add_label($1,
 281                                       make_ccmd(C_WHILE,
 282                                         make_op(O_ARRAY, 1,
 283                                           stab2arg(A_STAB,scrstab),
 284                                           Nullarg,Nullarg ),
 285                                         $6)))));
 286                                 $$->c_line = $2;
 287                                 $$->c_head->c_line = $2;
 288                             }
 289                             else {      /* lisp, anyone? */
 290                                 $$ = wopt(over(defstab,add_label($1,
 291                                 make_ccmd(C_WHILE,$4,$6) )));
 292                             }
 293                         }
 294         |       label FOR '(' nexpr ';' texpr ';' nexpr ')' block
 295                         /* basically fake up an initialize-while lineseq */
 296                         {   yyval.compval.comp_true = $10;
 297                             yyval.compval.comp_alt = $8;
 298                             cmdline = $2;
 299                             $$ = append_line($4,wopt(add_label($1,
 300                                 make_ccmd(C_WHILE,$6,yyval.compval) ))); }
 301         |       label compblock /* a block is a loop that happens once */
 302                         { $$ = add_label($1,make_ccmd(C_BLOCK,Nullarg,$2)); }
 303         ;
 304
 305 nexpr   :       /* NULL */
 306                         { $$ = Nullcmd; }
 307         |       sideff
 308         ;
 309
 310 texpr   :       /* NULL means true */
 311                         { (void)scanstr("1"); $$ = yylval.arg; }
 312         |       expr
 313         ;
 314
 315 label   :       /* empty */
 316                         { $$ = Nullch; }
 317         |       WORD ':'
 318         ;
 319
 320 decl    :       format
 321                         { $$ = 0; }
 322         |       subrout
 323                         { $$ = 0; }
 324         |       package
 325                         { $$ = 0; }
 326         ;
 327
 328 format  :       FORMAT WORD '=' FORMLIST
 329                         { if (strEQ($2,"stdout"))
 330                             make_form(stabent("STDOUT",TRUE),$4);
 331                           else if (strEQ($2,"stderr"))
 332                             make_form(stabent("STDERR",TRUE),$4);
 333                           else
 334                             make_form(stabent($2,TRUE),$4);
 335                           Safefree($2);}
 336         |       FORMAT '=' FORMLIST
 337                         { make_form(stabent("STDOUT",TRUE),$3); }
 338         ;
 339
 340 subrout :       SUB WORD block
 341                         { make_sub($2,$3); }
 342         ;
 343
 344 package :       PACKAGE WORD ';'
 345                         { char tmpbuf[256];
 346                           STAB *tmpstab;
 347
 348                           savehptr(&curstash);
 349                           saveitem(curstname);
 350                           str_set(curstname,$2);
 351                           sprintf(tmpbuf,"'_%s",$2);
 352                           tmpstab = hadd(stabent(tmpbuf,TRUE));
 353                           curstash = stab_xhash(tmpstab);
 354                           if (!curstash->tbl_name)
 355                               curstash->tbl_name = savestr($2);
 356                           curstash->tbl_coeffsize = 0;
 357                           Safefree($2);
 358                           cmdline = NOLINE;
 359                         }
 360         ;
 361
 362 cexpr   :       ',' expr
 363                         { $$ = $2; }
 364         ;
 365
 366 expr    :       expr ',' sexpr
 367                         { $$ = make_op(O_COMMA, 2, $1, $3, Nullarg); }
 368         |       sexpr
 369         ;
 370
 371 csexpr  :       ',' sexpr
 372                         { $$ = $2; }
 373         ;
 374
 375 sexpr   :       sexpr '=' sexpr
 376                         {   $1 = listish($1);
 377                             if ($1->arg_type == O_ASSIGN && $1->arg_len == 1)
 378                                 $1->arg_type = O_ITEM;  /* a local() */
 379                             if ($1->arg_type == O_LIST)
 380                                 $3 = listish($3);
 381                             $$ = l(make_op(O_ASSIGN, 2, $1, $3, Nullarg)); }
 382         |       sexpr POW '=' sexpr
 383                         { $$ = l(make_op(O_POW, 2, $1, $4, Nullarg)); }
 384         |       sexpr MULOP '=' sexpr
 385                         { $$ = l(make_op($2, 2, $1, $4, Nullarg)); }
 386         |       sexpr ADDOP '=' sexpr
 387                         { $$ = rcatmaybe(l(make_op($2, 2, $1, $4, Nullarg)));}
 388         |       sexpr LS '=' sexpr
 389                         { $$ = l(make_op(O_LEFT_SHIFT, 2, $1, $4, Nullarg)); }
 390         |       sexpr RS '=' sexpr
 391                         { $$ = l(make_op(O_RIGHT_SHIFT, 2, $1, $4, Nullarg)); }
 392         |       sexpr '&' '=' sexpr
 393                         { $$ = l(make_op(O_BIT_AND, 2, $1, $4, Nullarg)); }
 394         |       sexpr '^' '=' sexpr
 395                         { $$ = l(make_op(O_XOR, 2, $1, $4, Nullarg)); }
 396         |       sexpr '|' '=' sexpr
 397                         { $$ = l(make_op(O_BIT_OR, 2, $1, $4, Nullarg)); }
 398
 399
 400         |       sexpr POW sexpr
 401                         { $$ = make_op(O_POW, 2, $1, $3, Nullarg); }
 402         |       sexpr MULOP sexpr
 403                         { $$ = make_op($2, 2, $1, $3, Nullarg); }
 404         |       sexpr ADDOP sexpr
 405                         { $$ = make_op($2, 2, $1, $3, Nullarg); }
 406         |       sexpr LS sexpr
 407                         { $$ = make_op(O_LEFT_SHIFT, 2, $1, $3, Nullarg); }
 408         |       sexpr RS sexpr
 409                         { $$ = make_op(O_RIGHT_SHIFT, 2, $1, $3, Nullarg); }
 410         |       sexpr RELOP sexpr
 411                         { $$ = make_op($2, 2, $1, $3, Nullarg); }
 412         |       sexpr EQOP sexpr
 413                         { $$ = make_op($2, 2, $1, $3, Nullarg); }
 414         |       sexpr '&' sexpr
 415                         { $$ = make_op(O_BIT_AND, 2, $1, $3, Nullarg); }
 416         |       sexpr '^' sexpr
 417                         { $$ = make_op(O_XOR, 2, $1, $3, Nullarg); }
 418         |       sexpr '|' sexpr
 419                         { $$ = make_op(O_BIT_OR, 2, $1, $3, Nullarg); }
 420         |       sexpr DOTDOT sexpr
 421                         { arg4 = Nullarg;
 422                           $$ = make_op(O_F_OR_R, 4, $1, $3, Nullarg); }
 423         |       sexpr ANDAND sexpr
 424                         { $$ = make_op(O_AND, 2, $1, $3, Nullarg); }
 425         |       sexpr OROR sexpr
 426                         { $$ = make_op(O_OR, 2, $1, $3, Nullarg); }
 427         |       sexpr '?' sexpr ':' sexpr
 428                         { $$ = make_op(O_COND_EXPR, 3, $1, $3, $5); }
 429         |       sexpr MATCH sexpr
 430                         { $$ = mod_match(O_MATCH, $1, $3); }
 431         |       sexpr NMATCH sexpr
 432                         { $$ = mod_match(O_NMATCH, $1, $3); }
 433         |       term
 434                         { $$ = $1; }
 435         ;
 436
 437 term    :       '-' term %prec UMINUS
 438                         { $$ = make_op(O_NEGATE, 1, $2, Nullarg, Nullarg); }
 439         |       '+' term %prec UMINUS
 440                         { $$ = $2; }
 441         |       '!' term
 442                         { $$ = make_op(O_NOT, 1, $2, Nullarg, Nullarg); }
 443         |       '~' term
 444                         { $$ = make_op(O_COMPLEMENT, 1, $2, Nullarg, Nullarg);}
 445         |       term INC
 446                         { $$ = addflags(1, AF_POST|AF_UP,
 447                             l(make_op(O_ITEM,1,$1,Nullarg,Nullarg))); }
 448         |       term DEC
 449                         { $$ = addflags(1, AF_POST,
 450                             l(make_op(O_ITEM,1,$1,Nullarg,Nullarg))); }
 451         |       INC term
 452                         { $$ = addflags(1, AF_PRE|AF_UP,
 453                             l(make_op(O_ITEM,1,$2,Nullarg,Nullarg))); }
 454         |       DEC term
 455                         { $$ = addflags(1, AF_PRE,
 456                             l(make_op(O_ITEM,1,$2,Nullarg,Nullarg))); }
 457         |       FILETEST WORD
 458                         { opargs[$1] = 0;       /* force it special */
 459                             $$ = make_op($1, 1,
 460                                 stab2arg(A_STAB,stabent($2,TRUE)),
 461                                 Nullarg, Nullarg);
 462                         }
 463         |       FILETEST sexpr
 464                         { opargs[$1] = 1;
 465                             $$ = make_op($1, 1, $2, Nullarg, Nullarg); }
 466         |       FILETEST
 467                         { opargs[$1] = ($1 != O_FTTTY);
 468                             $$ = make_op($1, 1,
 469                                 stab2arg(A_STAB,
 470                                   $1 == O_FTTTY?stabent("STDIN",TRUE):defstab),
 471                                 Nullarg, Nullarg); }
 472         |       LOCAL '(' expr ')'
 473                         { $$ = l(localize(make_op(O_ASSIGN, 1,
 474                                 localize(listish(make_list($3))),
 475                                 Nullarg,Nullarg))); }
 476         |       '(' expr ',' ')'
 477                         { $$ = make_list(hide_ary($2)); }
 478         |       '(' expr ')'
 479                         { $$ = make_list(hide_ary($2)); }
 480         |       '(' ')'
 481                         { $$ = make_list(Nullarg); }
 482         |       DO sexpr        %prec FILETEST
 483                         { $$ = make_op(O_DOFILE,2,$2,Nullarg,Nullarg);
 484                           allstabs = TRUE;}
 485         |       DO block        %prec '('
 486                         { $$ = cmd_to_arg($2); }
 487         |       REG     %prec '('
 488                         { $$ = stab2arg(A_STAB,$1); }
 489         |       STAR    %prec '('
 490                         { $$ = stab2arg(A_STAR,$1); }
 491         |       REG '[' expr ']'        %prec '('
 492                         { $$ = make_op(O_AELEM, 2,
 493                                 stab2arg(A_STAB,aadd($1)), $3, Nullarg); }
 494         |       HSH     %prec '('
 495                         { $$ = make_op(O_HASH, 1,
 496                                 stab2arg(A_STAB,$1),
 497                                 Nullarg, Nullarg); }
 498         |       ARY     %prec '('
 499                         { $$ = make_op(O_ARRAY, 1,
 500                                 stab2arg(A_STAB,$1),
 501                                 Nullarg, Nullarg); }
 502         |       REG '{' expr '}'        %prec '('
 503                         { $$ = make_op(O_HELEM, 2,
 504                                 stab2arg(A_STAB,hadd($1)),
 505                                 jmaybe($3),
 506                                 Nullarg); }
 507         |       '(' expr ')' '[' expr ']'       %prec '('
 508                         { $$ = make_op(O_LSLICE, 3,
 509                                 Nullarg,
 510                                 listish(make_list($5)),
 511                                 listish(make_list($2))); }
 512         |       ARY '[' expr ']'        %prec '('
 513                         { $$ = make_op(O_ASLICE, 2,
 514                                 stab2arg(A_STAB,aadd($1)),
 515                                 listish(make_list($3)),
 516                                 Nullarg); }
 517         |       ARY '{' expr '}'        %prec '('
 518                         { $$ = make_op(O_HSLICE, 2,
 519                                 stab2arg(A_STAB,hadd($1)),
 520                                 listish(make_list($3)),
 521                                 Nullarg); }
 522         |       DELETE REG '{' expr '}' %prec '('
 523                         { $$ = make_op(O_DELETE, 2,
 524                                 stab2arg(A_STAB,hadd($2)),
 525                                 jmaybe($4),
 526                                 Nullarg); }
 527         |       ARYLEN  %prec '('
 528                         { $$ = stab2arg(A_ARYLEN,$1); }
 529         |       RSTRING %prec '('
 530                         { $$ = $1; }
 531         |       PATTERN %prec '('
 532                         { $$ = $1; }
 533         |       SUBST   %prec '('
 534                         { $$ = $1; }
 535         |       TRANS   %prec '('
 536                         { $$ = $1; }
 537         |       DO WORD '(' expr ')'
 538                         { $$ = make_op((perldb ? O_DBSUBR : O_SUBR), 2,
 539                                 stab2arg(A_WORD,stabent($2,TRUE)),
 540                                 make_list($4),
 541                                 Nullarg); Safefree($2); }
 542         |       AMPER WORD '(' expr ')'
 543                         { $$ = make_op((perldb ? O_DBSUBR : O_SUBR), 2,
 544                                 stab2arg(A_WORD,stabent($2,TRUE)),
 545                                 make_list($4),
 546                                 Nullarg); Safefree($2); }
 547         |       DO WORD '(' ')'
 548                         { $$ = make_op((perldb ? O_DBSUBR : O_SUBR), 2,
 549                                 stab2arg(A_WORD,stabent($2,TRUE)),
 550                                 make_list(Nullarg),
 551                                 Nullarg); }
 552         |       AMPER WORD '(' ')'
 553                         { $$ = make_op((perldb ? O_DBSUBR : O_SUBR), 2,
 554                                 stab2arg(A_WORD,stabent($2,TRUE)),
 555                                 make_list(Nullarg),
 556                                 Nullarg); }
 557         |       AMPER WORD
 558                         { $$ = make_op((perldb ? O_DBSUBR : O_SUBR), 2,
 559                                 stab2arg(A_WORD,stabent($2,TRUE)),
 560                                 Nullarg,
 561                                 Nullarg); }
 562         |       DO REG '(' expr ')'
 563                         { $$ = make_op((perldb ? O_DBSUBR : O_SUBR), 2,
 564                                 stab2arg(A_STAB,$2),
 565                                 make_list($4),
 566                                 Nullarg); }
 567         |       AMPER REG '(' expr ')'
 568                         { $$ = make_op((perldb ? O_DBSUBR : O_SUBR), 2,
 569                                 stab2arg(A_STAB,$2),
 570                                 make_list($4),
 571                                 Nullarg); }
 572         |       DO REG '(' ')'
 573                         { $$ = make_op((perldb ? O_DBSUBR : O_SUBR), 2,
 574                                 stab2arg(A_STAB,$2),
 575                                 make_list(Nullarg),
 576                                 Nullarg); }
 577         |       AMPER REG '(' ')'
 578                         { $$ = make_op((perldb ? O_DBSUBR : O_SUBR), 2,
 579                                 stab2arg(A_STAB,$2),
 580                                 make_list(Nullarg),
 581                                 Nullarg); }
 582         |       AMPER REG
 583                         { $$ = make_op((perldb ? O_DBSUBR : O_SUBR), 2,
 584                                 stab2arg(A_STAB,$2),
 585                                 Nullarg,
 586                                 Nullarg); }
 587         |       LOOPEX
 588                         { $$ = make_op($1,0,Nullarg,Nullarg,Nullarg); }
 589         |       LOOPEX WORD
 590                         { $$ = make_op($1,1,cval_to_arg($2),
 591                             Nullarg,Nullarg); }
 592         |       UNIOP
 593                         { $$ = make_op($1,0,Nullarg,Nullarg,Nullarg); }
 594         |       UNIOP sexpr
 595                         { $$ = make_op($1,1,$2,Nullarg,Nullarg); }
 596         |       SSELECT
 597                         { $$ = make_op(O_SELECT, 0, Nullarg, Nullarg, Nullarg);}
 598         |       SSELECT '(' handle ')'
 599                         { $$ = make_op(O_SELECT, 1, $3, Nullarg, Nullarg); }
 600         |       SSELECT '(' sexpr csexpr csexpr csexpr ')'
 601                         { arg4 = $6;
 602                           $$ = make_op(O_SSELECT, 4, $3, $4, $5); }
 603         |       OPEN WORD       %prec '('
 604                         { $$ = make_op(O_OPEN, 2,
 605                             stab2arg(A_WORD,stabent($2,TRUE)),
 606                             stab2arg(A_STAB,stabent($2,TRUE)),
 607                             Nullarg); }
 608         |       OPEN '(' WORD ')'
 609                         { $$ = make_op(O_OPEN, 2,
 610                             stab2arg(A_WORD,stabent($3,TRUE)),
 611                             stab2arg(A_STAB,stabent($3,TRUE)),
 612                             Nullarg); }
 613         |       OPEN '(' handle cexpr ')'
 614                         { $$ = make_op(O_OPEN, 2,
 615                             $3,
 616                             $4, Nullarg); }
 617         |       FILOP '(' handle ')'
 618                         { $$ = make_op($1, 1,
 619                             $3,
 620                             Nullarg, Nullarg); }
 621         |       FILOP WORD
 622                         { $$ = make_op($1, 1,
 623                             stab2arg(A_WORD,stabent($2,TRUE)),
 624                             Nullarg, Nullarg);
 625                           Safefree($2); }
 626         |       FILOP REG
 627                         { $$ = make_op($1, 1,
 628                             stab2arg(A_STAB,$2),
 629                             Nullarg, Nullarg); }
 630         |       FILOP '(' ')'
 631                         { $$ = make_op($1, 1,
 632                             stab2arg(A_WORD,Nullstab),
 633                             Nullarg, Nullarg); }
 634         |       FILOP   %prec '('
 635                         { $$ = make_op($1, 0,
 636                             Nullarg, Nullarg, Nullarg); }
 637         |       FILOP2 '(' handle cexpr ')'
 638                         { $$ = make_op($1, 2, $3, $4, Nullarg); }
 639         |       FILOP3 '(' handle csexpr cexpr ')'
 640                         { $$ = make_op($1, 3, $3, $4, make_list($5)); }
 641         |       FILOP22 '(' handle ',' handle ')'
 642                         { $$ = make_op($1, 2, $3, $5, Nullarg); }
 643         |       FILOP4 '(' handle csexpr csexpr cexpr ')'
 644                         { arg4 = $6; $$ = make_op($1, 4, $3, $4, $5); }
 645         |       FILOP25 '(' handle ',' handle csexpr csexpr cexpr ')'
 646                         { arg4 = $7; arg5 = $8;
 647                           $$ = make_op($1, 5, $3, $5, $6); }
 648         |       PUSH '(' aryword cexpr ')'
 649                         { $$ = make_op($1, 2,
 650                             $3,
 651                             make_list($4),
 652                             Nullarg); }
 653         |       POP aryword     %prec '('
 654                         { $$ = make_op(O_POP, 1, $2, Nullarg, Nullarg); }
 655         |       POP '(' aryword ')'
 656                         { $$ = make_op(O_POP, 1, $3, Nullarg, Nullarg); }
 657         |       SHIFT aryword   %prec '('
 658                         { $$ = make_op(O_SHIFT, 1, $2, Nullarg, Nullarg); }
 659         |       SHIFT '(' aryword ')'
 660                         { $$ = make_op(O_SHIFT, 1, $3, Nullarg, Nullarg); }
 661         |       SHIFT   %prec '('
 662                         { $$ = make_op(O_SHIFT, 1,
 663                             stab2arg(A_STAB,
 664                               aadd(stabent(subline ? "_" : "ARGV", TRUE))),
 665                             Nullarg, Nullarg); }
 666         |       SPLIT   %prec '('
 667 {static char p[]="/\\s+/";char*o=bufend;bufend=p+5;(void)scanpat(p);bufend=o;
 668                             $$ = make_split(defstab,yylval.arg,Nullarg); }
 669         |       SPLIT '(' sexpr csexpr csexpr ')'
 670                         { $$ = mod_match(O_MATCH, $4,
 671                           make_split(defstab,$3,$5));}
 672         |       SPLIT '(' sexpr csexpr ')'
 673                         { $$ = mod_match(O_MATCH, $4,
 674                           make_split(defstab,$3,Nullarg) ); }
 675         |       SPLIT '(' sexpr ')'
 676                         { $$ = mod_match(O_MATCH,
 677                             stab2arg(A_STAB,defstab),
 678                             make_split(defstab,$3,Nullarg) ); }
 679         |       FLIST2 '(' sexpr cexpr ')'
 680                         { $$ = make_op($1, 2,
 681                             $3,
 682                             listish(make_list($4)),
 683                             Nullarg); }
 684         |       FLIST '(' expr ')'
 685                         { $$ = make_op($1, 1,
 686                             make_list($3),
 687                             Nullarg,
 688                             Nullarg); }
 689         |       LVALFUN sexpr   %prec '('
 690                         { $$ = l(make_op($1, 1, fixl($1,$2),
 691                             Nullarg, Nullarg)); }
 692         |       LVALFUN
 693                         { $$ = l(make_op($1, 1,
 694                             stab2arg(A_STAB,defstab),
 695                             Nullarg, Nullarg)); }
 696         |       FUNC0
 697                         { $$ = make_op($1, 0, Nullarg, Nullarg, Nullarg); }
 698         |       FUNC0 '(' ')'
 699                         { $$ = make_op($1, 0, Nullarg, Nullarg, Nullarg); }
 700         |       FUNC1 '(' ')'
 701                         { $$ = make_op($1, 0, Nullarg, Nullarg, Nullarg); }
 702         |       FUNC1 '(' expr ')'
 703                         { $$ = make_op($1, 1, $3, Nullarg, Nullarg); }
 704         |       FUNC2 '(' sexpr cexpr ')'
 705                         { $$ = make_op($1, 2, $3, $4, Nullarg);
 706                             if ($1 == O_INDEX && $$[2].arg_type == A_SINGLE)
 707                                 fbmcompile($$[2].arg_ptr.arg_str,0); }
 708         |       FUNC2x '(' sexpr csexpr ')'
 709                         { $$ = make_op($1, 2, $3, $4, Nullarg);
 710                             if ($1 == O_INDEX && $$[2].arg_type == A_SINGLE)
 711                                 fbmcompile($$[2].arg_ptr.arg_str,0); }
 712         |       FUNC2x '(' sexpr csexpr cexpr ')'
 713                         { $$ = make_op($1, 3, $3, $4, $5);
 714                             if ($1 == O_INDEX && $$[2].arg_type == A_SINGLE)
 715                                 fbmcompile($$[2].arg_ptr.arg_str,0); }
 716         |       FUNC3 '(' sexpr csexpr cexpr ')'
 717                         { $$ = make_op($1, 3, $3, $4, $5); }
 718         |       FUNC4 '(' sexpr csexpr csexpr cexpr ')'
 719                         { arg4 = $6;
 720                           $$ = make_op($1, 4, $3, $4, $5); }
 721         |       FUNC5 '(' sexpr csexpr csexpr csexpr cexpr ')'
 722                         { arg4 = $6; arg5 = $7;
 723                           $$ = make_op($1, 5, $3, $4, $5); }
 724         |       HSHFUN '(' hshword ')'
 725                         { $$ = make_op($1, 1,
 726                                 $3,
 727                                 Nullarg,
 728                                 Nullarg); }
 729         |       HSHFUN hshword
 730                         { $$ = make_op($1, 1,
 731                                 $2,
 732                                 Nullarg,
 733                                 Nullarg); }
 734         |       HSHFUN3 '(' hshword csexpr cexpr ')'
 735                         { $$ = make_op($1, 3, $3, $4, $5); }
 736         |       bareword
 737         |       listop
 738         ;
 739
 740 listop  :       LISTOP
 741                         { $$ = make_op($1,2,
 742                                 stab2arg(A_WORD,Nullstab),
 743                                 stab2arg(A_STAB,defstab),
 744                                 Nullarg); }
 745         |       LISTOP expr
 746                         { $$ = make_op($1,2,
 747                                 stab2arg(A_WORD,Nullstab),
 748                                 maybelistish($1,make_list($2)),
 749                                 Nullarg); }
 750         |       LISTOP WORD
 751                         { $$ = make_op($1,2,
 752                                 stab2arg(A_WORD,stabent($2,TRUE)),
 753                                 stab2arg(A_STAB,defstab),
 754                                 Nullarg); }
 755         |       LISTOP WORD expr
 756                         { $$ = make_op($1,2,
 757                                 stab2arg(A_WORD,stabent($2,TRUE)),
 758                                 maybelistish($1,make_list($3)),
 759                                 Nullarg); Safefree($2); }
 760         |       LISTOP REG expr
 761                         { $$ = make_op($1,2,
 762                                 stab2arg(A_STAB,$2),
 763                                 maybelistish($1,make_list($3)),
 764                                 Nullarg); }
 765         ;
 766
 767 handle  :       WORD
 768                         { $$ = stab2arg(A_WORD,stabent($1,TRUE)); Safefree($1);}
 769         |       sexpr
 770         ;
 771
 772 aryword :       WORD
 773                         { $$ = stab2arg(A_WORD,aadd(stabent($1,TRUE)));
 774                             Safefree($1); }
 775         |       ARY
 776                         { $$ = stab2arg(A_STAB,$1); }
 777         ;
 778
 779 hshword :       WORD
 780                         { $$ = stab2arg(A_WORD,hadd(stabent($1,TRUE)));
 781                             Safefree($1); }
 782         |       HSH
 783                         { $$ = stab2arg(A_STAB,$1); }
 784         ;
 785
 786 /*
 787  * NOTE:  The following entry must stay at the end of the file so that
 788  * reduce/reduce conflicts resolve to it only if it's the only option.
 789  */
 790
 791 bareword:       WORD
 792                         { char *s;
 793                             $$ = op_new(1);
 794                             $$->arg_type = O_ITEM;
 795                             $$[1].arg_type = A_SINGLE;
 796                             $$[1].arg_ptr.arg_str = str_make($1,0);
 797                             for (s = $1; *s && islower(*s); s++) ;
 798                             if (dowarn && !*s)
 799                                 warn(
 800                                   "\"%s\" may clash with future reserved word",
 801                                   $1 );
 802                         }
 803
 804 %% /* PROGRAM */