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