1 /* $RCSfile: perly.y,v $$Revision: 4.0.1.1 $$Date: 91/06/07 11:42:34 $
3 * Copyright (c) 1991, Larry Wall
5 * You may distribute under the terms of either the GNU General Public
6 * License or the Artistic License, as specified in the README file.
9 * Revision 4.0.1.1 91/06/07 11:42:34 lwall
10 * patch4: new copyright notice
12 * Revision 4.0 91/03/20 01:38:40 lwall
22 ARG *arg4; /* rarely used arguments to make_op() */
34 struct compcmd compval;
40 %token <ival> APPEND OPEN SSELECT LOOPEX
41 %token <ival> USING FORMAT DO SHIFT PUSH POP LVALFUN
42 %token <ival> WHILE UNTIL IF UNLESS ELSE ELSIF CONTINUE SPLIT FLIST
43 %token <ival> FOR FILOP FILOP2 FILOP3 FILOP4 FILOP22 FILOP25
44 %token <ival> FUNC0 FUNC1 FUNC2 FUNC2x FUNC3 FUNC4 FUNC5 HSHFUN HSHFUN3
45 %token <ival> FLIST2 SUB FILETEST LOCAL DELETE
46 %token <ival> RELOP EQOP MULOP ADDOP PACKAGE AMPER
47 %token <formval> FORMLIST
48 %token <stabval> REG ARYLEN ARY HSH STAR
49 %token <arg> SUBST PATTERN
50 %token <arg> RSTRING TRANS
52 %type <ival> prog decl format remember
53 %type <cmdval> block lineseq line loop cond sideff nexpr else
54 %type <arg> expr sexpr cexpr csexpr term handle aryword hshword
55 %type <arg> texpr listop bareword
57 %type <compval> compblock
59 %nonassoc <ival> LISTOP
70 %nonassoc <ival> UNIOP
85 #if defined(YYDEBUG) && defined(DEBUGGING)
86 yydebug = (debug & 1);
91 eval_root = block_head($2);
93 main_root = block_head($2); }
96 compblock: block CONTINUE block
97 { $$.comp_true = $1; $$.comp_alt = $3; }
99 { $$.comp_true = $1; $$.comp_alt = $2; }
106 | ELSIF '(' expr ')' compblock
108 $$ = make_ccmd(C_ELSIF,$3,$5); }
111 block : '{' remember lineseq '}'
112 { $$ = block_head($3);
113 if (savestack->ary_fill > $2)
117 remember: /* NULL */ /* in case they push a package name */
118 { $$ = savestack->ary_fill; }
124 { $$ = append_line($1,$2); }
130 { $$ = add_label($1,$2); }
131 | loop /* loops add their own labels */
133 { if ($1 != Nullch) {
134 $$ = add_label($1, make_acmd(C_EXPR, Nullstab,
142 { $$ = add_label($1,$2); }
148 { $$ = make_acmd(C_EXPR, Nullstab, $1, Nullarg); }
151 make_acmd(C_EXPR, Nullstab, Nullarg, $1), $3); }
153 { $$ = addcond(invert(
154 make_acmd(C_EXPR, Nullstab, Nullarg, $1)), $3); }
157 make_acmd(C_EXPR, Nullstab, Nullarg, $1), $3); }
159 { $$ = addloop(invert(
160 make_acmd(C_EXPR, Nullstab, Nullarg, $1)), $3); }
163 cond : IF '(' expr ')' compblock
165 $$ = make_icmd(C_IF,$3,$5); }
166 | UNLESS '(' expr ')' compblock
168 $$ = invert(make_icmd(C_IF,$3,$5)); }
171 $$ = make_ccmd(C_IF,cmd_to_arg($2),$3); }
172 | UNLESS block compblock
174 $$ = invert(make_ccmd(C_IF,cmd_to_arg($2),$3)); }
177 loop : label WHILE '(' texpr ')' compblock
179 $$ = wopt(add_label($1,
180 make_ccmd(C_WHILE,$4,$6) )); }
181 | label UNTIL '(' expr ')' compblock
183 $$ = wopt(add_label($1,
184 invert(make_ccmd(C_WHILE,$4,$6)) )); }
185 | label WHILE block compblock
187 $$ = wopt(add_label($1,
188 make_ccmd(C_WHILE, cmd_to_arg($3),$4) )); }
189 | label UNTIL block compblock
191 $$ = wopt(add_label($1,
192 invert(make_ccmd(C_WHILE, cmd_to_arg($3),$4)) )); }
193 | label FOR REG '(' expr ')' compblock
196 * The following gobbledygook catches EXPRs that
197 * aren't explicit array refs and translates
198 * foreach VAR (EXPR) {
201 * foreach VAR (@ary) {
202 * where @ary is a hidden array made by genstab().
203 * (Note that @ary may become a local array if
204 * it is determined that it might be called
205 * recursively. See cmd_tosave().)
207 if ($5->arg_type != O_ARRAY) {
208 scrstab = aadd(genstab());
210 make_acmd(C_EXPR, Nullstab,
211 l(make_op(O_ASSIGN,2,
212 listish(make_op(O_ARRAY, 1,
213 stab2arg(A_STAB,scrstab),
215 listish(make_list($5)),
218 wopt(over($3,add_label($1,
221 stab2arg(A_STAB,scrstab),
225 $$->c_head->c_line = $2;
228 $$ = wopt(over($3,add_label($1,
229 make_ccmd(C_WHILE,$5,$7) )));
232 | label FOR '(' expr ')' compblock
234 if ($4->arg_type != O_ARRAY) {
235 scrstab = aadd(genstab());
237 make_acmd(C_EXPR, Nullstab,
238 l(make_op(O_ASSIGN,2,
239 listish(make_op(O_ARRAY, 1,
240 stab2arg(A_STAB,scrstab),
242 listish(make_list($4)),
245 wopt(over(defstab,add_label($1,
248 stab2arg(A_STAB,scrstab),
252 $$->c_head->c_line = $2;
254 else { /* lisp, anyone? */
255 $$ = wopt(over(defstab,add_label($1,
256 make_ccmd(C_WHILE,$4,$6) )));
259 | label FOR '(' nexpr ';' texpr ';' nexpr ')' block
260 /* basically fake up an initialize-while lineseq */
261 { yyval.compval.comp_true = $10;
262 yyval.compval.comp_alt = $8;
264 $$ = append_line($4,wopt(add_label($1,
265 make_ccmd(C_WHILE,$6,yyval.compval) ))); }
266 | label compblock /* a block is a loop that happens once */
267 { $$ = add_label($1,make_ccmd(C_BLOCK,Nullarg,$2)); }
275 texpr : /* NULL means true */
276 { (void)scanstr("1"); $$ = yylval.arg; }
293 format : FORMAT WORD '=' FORMLIST
294 { if (strEQ($2,"stdout"))
295 make_form(stabent("STDOUT",TRUE),$4);
296 else if (strEQ($2,"stderr"))
297 make_form(stabent("STDERR",TRUE),$4);
299 make_form(stabent($2,TRUE),$4);
300 Safefree($2); $2 = Nullch; }
301 | FORMAT '=' FORMLIST
302 { make_form(stabent("STDOUT",TRUE),$3); }
305 subrout : SUB WORD block
309 package : PACKAGE WORD ';'
315 str_set(curstname,$2);
316 sprintf(tmpbuf,"'_%s",$2);
317 tmpstab = stabent(tmpbuf,TRUE);
318 if (!stab_xhash(tmpstab))
319 stab_xhash(tmpstab) = hnew(0);
320 curstash = stab_xhash(tmpstab);
321 if (!curstash->tbl_name)
322 curstash->tbl_name = savestr($2);
323 curstash->tbl_coeffsize = 0;
324 Safefree($2); $2 = Nullch;
333 expr : expr ',' sexpr
334 { $$ = make_op(O_COMMA, 2, $1, $3, Nullarg); }
342 sexpr : sexpr '=' sexpr
344 if ($1->arg_type == O_ASSIGN && $1->arg_len == 1)
345 $1->arg_type = O_ITEM; /* a local() */
346 if ($1->arg_type == O_LIST)
348 $$ = l(make_op(O_ASSIGN, 2, $1, $3, Nullarg)); }
349 | sexpr POW '=' sexpr
350 { $$ = l(make_op(O_POW, 2, $1, $4, Nullarg)); }
351 | sexpr MULOP '=' sexpr
352 { $$ = l(make_op($2, 2, $1, $4, Nullarg)); }
353 | sexpr ADDOP '=' sexpr
354 { $$ = rcatmaybe(l(make_op($2, 2, $1, $4, Nullarg)));}
356 { $$ = l(make_op(O_LEFT_SHIFT, 2, $1, $4, Nullarg)); }
358 { $$ = l(make_op(O_RIGHT_SHIFT, 2, $1, $4, Nullarg)); }
359 | sexpr '&' '=' sexpr
360 { $$ = l(make_op(O_BIT_AND, 2, $1, $4, Nullarg)); }
361 | sexpr '^' '=' sexpr
362 { $$ = l(make_op(O_XOR, 2, $1, $4, Nullarg)); }
363 | sexpr '|' '=' sexpr
364 { $$ = l(make_op(O_BIT_OR, 2, $1, $4, Nullarg)); }
368 { $$ = make_op(O_POW, 2, $1, $3, Nullarg); }
370 { if ($2 == O_REPEAT)
372 $$ = make_op($2, 2, $1, $3, Nullarg);
373 if ($2 == O_REPEAT) {
374 if ($$[1].arg_type != A_EXPR ||
375 $$[1].arg_ptr.arg_arg->arg_type != O_LIST)
376 $$[1].arg_flags &= ~AF_ARYOK;
379 { $$ = make_op($2, 2, $1, $3, Nullarg); }
381 { $$ = make_op(O_LEFT_SHIFT, 2, $1, $3, Nullarg); }
383 { $$ = make_op(O_RIGHT_SHIFT, 2, $1, $3, Nullarg); }
385 { $$ = make_op($2, 2, $1, $3, Nullarg); }
387 { $$ = make_op($2, 2, $1, $3, Nullarg); }
389 { $$ = make_op(O_BIT_AND, 2, $1, $3, Nullarg); }
391 { $$ = make_op(O_XOR, 2, $1, $3, Nullarg); }
393 { $$ = make_op(O_BIT_OR, 2, $1, $3, Nullarg); }
396 $$ = make_op(O_F_OR_R, 4, $1, $3, Nullarg); }
398 { $$ = make_op(O_AND, 2, $1, $3, Nullarg); }
400 { $$ = make_op(O_OR, 2, $1, $3, Nullarg); }
401 | sexpr '?' sexpr ':' sexpr
402 { $$ = make_op(O_COND_EXPR, 3, $1, $3, $5); }
404 { $$ = mod_match(O_MATCH, $1, $3); }
406 { $$ = mod_match(O_NMATCH, $1, $3); }
411 term : '-' term %prec UMINUS
412 { $$ = make_op(O_NEGATE, 1, $2, Nullarg, Nullarg); }
413 | '+' term %prec UMINUS
416 { $$ = make_op(O_NOT, 1, $2, Nullarg, Nullarg); }
418 { $$ = make_op(O_COMPLEMENT, 1, $2, Nullarg, Nullarg);}
420 { $$ = addflags(1, AF_POST|AF_UP,
421 l(make_op(O_ITEM,1,$1,Nullarg,Nullarg))); }
423 { $$ = addflags(1, AF_POST,
424 l(make_op(O_ITEM,1,$1,Nullarg,Nullarg))); }
426 { $$ = addflags(1, AF_PRE|AF_UP,
427 l(make_op(O_ITEM,1,$2,Nullarg,Nullarg))); }
429 { $$ = addflags(1, AF_PRE,
430 l(make_op(O_ITEM,1,$2,Nullarg,Nullarg))); }
432 { opargs[$1] = 0; /* force it special */
434 stab2arg(A_STAB,stabent($2,TRUE)),
439 $$ = make_op($1, 1, $2, Nullarg, Nullarg); }
441 { opargs[$1] = ($1 != O_FTTTY);
444 $1 == O_FTTTY?stabent("STDIN",TRUE):defstab),
447 { $$ = l(localize(make_op(O_ASSIGN, 1,
448 localize(listish(make_list($3))),
449 Nullarg,Nullarg))); }
451 { $$ = make_list($2); }
453 { $$ = make_list($2); }
455 { $$ = make_list(Nullarg); }
456 | DO sexpr %prec FILETEST
457 { $$ = make_op(O_DOFILE,2,$2,Nullarg,Nullarg);
460 { $$ = cmd_to_arg($2); }
462 { $$ = stab2arg(A_STAB,$1); }
464 { $$ = stab2arg(A_STAR,$1); }
465 | REG '[' expr ']' %prec '('
466 { $$ = make_op(O_AELEM, 2,
467 stab2arg(A_STAB,aadd($1)), $3, Nullarg); }
469 { $$ = make_op(O_HASH, 1,
473 { $$ = make_op(O_ARRAY, 1,
476 | REG '{' expr '}' %prec '('
477 { $$ = make_op(O_HELEM, 2,
478 stab2arg(A_STAB,hadd($1)),
481 | '(' expr ')' '[' expr ']' %prec '('
482 { $$ = make_op(O_LSLICE, 3,
484 listish(make_list($5)),
485 listish(make_list($2))); }
486 | '(' ')' '[' expr ']' %prec '('
487 { $$ = make_op(O_LSLICE, 3,
489 listish(make_list($4)),
491 | ARY '[' expr ']' %prec '('
492 { $$ = make_op(O_ASLICE, 2,
493 stab2arg(A_STAB,aadd($1)),
494 listish(make_list($3)),
496 | ARY '{' expr '}' %prec '('
497 { $$ = make_op(O_HSLICE, 2,
498 stab2arg(A_STAB,hadd($1)),
499 listish(make_list($3)),
501 | DELETE REG '{' expr '}' %prec '('
502 { $$ = make_op(O_DELETE, 2,
503 stab2arg(A_STAB,hadd($2)),
507 { $$ = stab2arg(A_ARYLEN,$1); }
516 | DO WORD '(' expr ')'
517 { $$ = make_op((perldb ? O_DBSUBR : O_SUBR), 2,
518 stab2arg(A_WORD,stabent($2,TRUE)),
520 Nullarg); Safefree($2); $2 = Nullch;
521 $$->arg_flags |= AF_DEPR; }
522 | AMPER WORD '(' expr ')'
523 { $$ = make_op((perldb ? O_DBSUBR : O_SUBR), 2,
524 stab2arg(A_WORD,stabent($2,TRUE)),
526 Nullarg); Safefree($2); $2 = Nullch; }
528 { $$ = make_op((perldb ? O_DBSUBR : O_SUBR), 2,
529 stab2arg(A_WORD,stabent($2,TRUE)),
532 $$->arg_flags |= AF_DEPR; }
534 { $$ = make_op((perldb ? O_DBSUBR : O_SUBR), 2,
535 stab2arg(A_WORD,stabent($2,TRUE)),
539 { $$ = make_op((perldb ? O_DBSUBR : O_SUBR), 2,
540 stab2arg(A_WORD,stabent($2,TRUE)),
543 | DO REG '(' expr ')'
544 { $$ = make_op((perldb ? O_DBSUBR : O_SUBR), 2,
548 $$->arg_flags |= AF_DEPR; }
549 | AMPER REG '(' expr ')'
550 { $$ = make_op((perldb ? O_DBSUBR : O_SUBR), 2,
555 { $$ = make_op((perldb ? O_DBSUBR : O_SUBR), 2,
559 $$->arg_flags |= AF_DEPR; }
561 { $$ = make_op((perldb ? O_DBSUBR : O_SUBR), 2,
566 { $$ = make_op((perldb ? O_DBSUBR : O_SUBR), 2,
571 { $$ = make_op($1,0,Nullarg,Nullarg,Nullarg); }
573 { $$ = make_op($1,1,cval_to_arg($2),
576 { $$ = make_op($1,0,Nullarg,Nullarg,Nullarg); }
578 { $$ = make_op($1,1,$2,Nullarg,Nullarg); }
580 { $$ = make_op(O_SELECT, 0, Nullarg, Nullarg, Nullarg);}
581 | SSELECT '(' handle ')'
582 { $$ = make_op(O_SELECT, 1, $3, Nullarg, Nullarg); }
583 | SSELECT '(' sexpr csexpr csexpr csexpr ')'
585 $$ = make_op(O_SSELECT, 4, $3, $4, $5); }
586 | OPEN WORD %prec '('
587 { $$ = make_op(O_OPEN, 2,
588 stab2arg(A_WORD,stabent($2,TRUE)),
589 stab2arg(A_STAB,stabent($2,TRUE)),
592 { $$ = make_op(O_OPEN, 2,
593 stab2arg(A_WORD,stabent($3,TRUE)),
594 stab2arg(A_STAB,stabent($3,TRUE)),
596 | OPEN '(' handle cexpr ')'
597 { $$ = make_op(O_OPEN, 2,
600 | FILOP '(' handle ')'
601 { $$ = make_op($1, 1,
605 { $$ = make_op($1, 1,
606 stab2arg(A_WORD,stabent($2,TRUE)),
608 Safefree($2); $2 = Nullch; }
610 { $$ = make_op($1, 1,
614 { $$ = make_op($1, 1,
615 stab2arg(A_WORD,Nullstab),
618 { $$ = make_op($1, 0,
619 Nullarg, Nullarg, Nullarg); }
620 | FILOP2 '(' handle cexpr ')'
621 { $$ = make_op($1, 2, $3, $4, Nullarg); }
622 | FILOP3 '(' handle csexpr cexpr ')'
623 { $$ = make_op($1, 3, $3, $4, make_list($5)); }
624 | FILOP22 '(' handle ',' handle ')'
625 { $$ = make_op($1, 2, $3, $5, Nullarg); }
626 | FILOP4 '(' handle csexpr csexpr cexpr ')'
627 { arg4 = $6; $$ = make_op($1, 4, $3, $4, $5); }
628 | FILOP25 '(' handle ',' handle csexpr csexpr cexpr ')'
629 { arg4 = $7; arg5 = $8;
630 $$ = make_op($1, 5, $3, $5, $6); }
631 | PUSH '(' aryword cexpr ')'
632 { $$ = make_op($1, 2,
636 | POP aryword %prec '('
637 { $$ = make_op(O_POP, 1, $2, Nullarg, Nullarg); }
638 | POP '(' aryword ')'
639 { $$ = make_op(O_POP, 1, $3, Nullarg, Nullarg); }
640 | SHIFT aryword %prec '('
641 { $$ = make_op(O_SHIFT, 1, $2, Nullarg, Nullarg); }
642 | SHIFT '(' aryword ')'
643 { $$ = make_op(O_SHIFT, 1, $3, Nullarg, Nullarg); }
645 { $$ = make_op(O_SHIFT, 1,
647 aadd(stabent(subline ? "_" : "ARGV", TRUE))),
650 { static char p[]="/\\s+/";
651 char *oldend = bufend;
652 ARG *oldarg = yylval.arg;
657 $$ = make_split(defstab,yylval.arg,Nullarg);
658 yylval.arg = oldarg; }
659 | SPLIT '(' sexpr csexpr csexpr ')'
660 { $$ = mod_match(O_MATCH, $4,
661 make_split(defstab,$3,$5));}
662 | SPLIT '(' sexpr csexpr ')'
663 { $$ = mod_match(O_MATCH, $4,
664 make_split(defstab,$3,Nullarg) ); }
665 | SPLIT '(' sexpr ')'
666 { $$ = mod_match(O_MATCH,
667 stab2arg(A_STAB,defstab),
668 make_split(defstab,$3,Nullarg) ); }
669 | FLIST2 '(' sexpr cexpr ')'
670 { $$ = make_op($1, 2,
672 listish(make_list($4)),
675 { $$ = make_op($1, 1,
679 | LVALFUN sexpr %prec '('
680 { $$ = l(make_op($1, 1, fixl($1,$2),
681 Nullarg, Nullarg)); }
683 { $$ = l(make_op($1, 1,
684 stab2arg(A_STAB,defstab),
685 Nullarg, Nullarg)); }
687 { $$ = make_op($1, 0, Nullarg, Nullarg, Nullarg); }
689 { $$ = make_op($1, 0, Nullarg, Nullarg, Nullarg); }
691 { $$ = make_op($1, 0, Nullarg, Nullarg, Nullarg); }
693 { $$ = make_op($1, 1, $3, Nullarg, Nullarg); }
694 | FUNC2 '(' sexpr cexpr ')'
695 { $$ = make_op($1, 2, $3, $4, Nullarg);
696 if ($1 == O_INDEX && $$[2].arg_type == A_SINGLE)
697 fbmcompile($$[2].arg_ptr.arg_str,0); }
698 | FUNC2x '(' sexpr csexpr ')'
699 { $$ = make_op($1, 2, $3, $4, Nullarg);
700 if ($1 == O_INDEX && $$[2].arg_type == A_SINGLE)
701 fbmcompile($$[2].arg_ptr.arg_str,0); }
702 | FUNC2x '(' sexpr csexpr cexpr ')'
703 { $$ = make_op($1, 3, $3, $4, $5);
704 if ($1 == O_INDEX && $$[2].arg_type == A_SINGLE)
705 fbmcompile($$[2].arg_ptr.arg_str,0); }
706 | FUNC3 '(' sexpr csexpr cexpr ')'
707 { $$ = make_op($1, 3, $3, $4, $5); }
708 | FUNC4 '(' sexpr csexpr csexpr cexpr ')'
710 $$ = make_op($1, 4, $3, $4, $5); }
711 | FUNC5 '(' sexpr csexpr csexpr csexpr cexpr ')'
712 { arg4 = $6; arg5 = $7;
713 $$ = make_op($1, 5, $3, $4, $5); }
714 | HSHFUN '(' hshword ')'
715 { $$ = make_op($1, 1,
720 { $$ = make_op($1, 1,
724 | HSHFUN3 '(' hshword csexpr cexpr ')'
725 { $$ = make_op($1, 3, $3, $4, $5); }
732 stab2arg(A_WORD,Nullstab),
733 stab2arg(A_STAB,defstab),
737 stab2arg(A_WORD,Nullstab),
738 maybelistish($1,make_list($2)),
742 stab2arg(A_WORD,stabent($2,TRUE)),
743 stab2arg(A_STAB,defstab),
747 stab2arg(A_WORD,stabent($2,TRUE)),
748 maybelistish($1,make_list($3)),
749 Nullarg); Safefree($2); $2 = Nullch; }
753 maybelistish($1,make_list($3)),
758 { $$ = stab2arg(A_WORD,stabent($1,TRUE));
759 Safefree($1); $1 = Nullch;}
764 { $$ = stab2arg(A_WORD,aadd(stabent($1,TRUE)));
765 Safefree($1); $1 = Nullch; }
767 { $$ = stab2arg(A_STAB,$1); }
771 { $$ = stab2arg(A_WORD,hadd(stabent($1,TRUE)));
772 Safefree($1); $1 = Nullch; }
774 { $$ = stab2arg(A_STAB,$1); }
778 * NOTE: The following entry must stay at the end of the file so that
779 * reduce/reduce conflicts resolve to it only if it's the only option.
785 $$->arg_type = O_ITEM;
786 $$[1].arg_type = A_SINGLE;
787 $$[1].arg_ptr.arg_str = str_make($1,0);
788 for (s = $1; *s && islower(*s); s++) ;
791 "\"%s\" may clash with future reserved word",