1 /* $Header: perly.y,v 4.0 91/03/20 01:38:40 lwall Locked $
3 * Copyright (c) 1989, Larry Wall
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.
9 * Revision 4.0 91/03/20 01:38:40 lwall
19 ARG *arg4; /* rarely used arguments to make_op() */
31 struct compcmd compval;
37 %token <ival> APPEND OPEN SSELECT LOOPEX
38 %token <ival> USING FORMAT DO SHIFT PUSH POP LVALFUN
39 %token <ival> WHILE UNTIL IF UNLESS ELSE ELSIF CONTINUE SPLIT FLIST
40 %token <ival> FOR FILOP FILOP2 FILOP3 FILOP4 FILOP22 FILOP25
41 %token <ival> FUNC0 FUNC1 FUNC2 FUNC2x FUNC3 FUNC4 FUNC5 HSHFUN HSHFUN3
42 %token <ival> FLIST2 SUB FILETEST LOCAL DELETE
43 %token <ival> RELOP EQOP MULOP ADDOP PACKAGE AMPER
44 %token <formval> FORMLIST
45 %token <stabval> REG ARYLEN ARY HSH STAR
46 %token <arg> SUBST PATTERN
47 %token <arg> RSTRING TRANS
49 %type <ival> prog decl format remember
50 %type <cmdval> block lineseq line loop cond sideff nexpr else
51 %type <arg> expr sexpr cexpr csexpr term handle aryword hshword
52 %type <arg> texpr listop bareword
54 %type <compval> compblock
56 %nonassoc <ival> LISTOP
67 %nonassoc <ival> UNIOP
82 #if defined(YYDEBUG) && defined(DEBUGGING)
83 yydebug = (debug & 1);
88 eval_root = block_head($2);
90 main_root = block_head($2); }
93 compblock: block CONTINUE block
94 { $$.comp_true = $1; $$.comp_alt = $3; }
96 { $$.comp_true = $1; $$.comp_alt = $2; }
103 | ELSIF '(' expr ')' compblock
105 $$ = make_ccmd(C_ELSIF,$3,$5); }
108 block : '{' remember lineseq '}'
109 { $$ = block_head($3);
110 if (savestack->ary_fill > $2)
114 remember: /* NULL */ /* in case they push a package name */
115 { $$ = savestack->ary_fill; }
121 { $$ = append_line($1,$2); }
127 { $$ = add_label($1,$2); }
128 | loop /* loops add their own labels */
130 { if ($1 != Nullch) {
131 $$ = add_label($1, make_acmd(C_EXPR, Nullstab,
139 { $$ = add_label($1,$2); }
145 { $$ = make_acmd(C_EXPR, Nullstab, $1, Nullarg); }
148 make_acmd(C_EXPR, Nullstab, Nullarg, $1), $3); }
150 { $$ = addcond(invert(
151 make_acmd(C_EXPR, Nullstab, Nullarg, $1)), $3); }
154 make_acmd(C_EXPR, Nullstab, Nullarg, $1), $3); }
156 { $$ = addloop(invert(
157 make_acmd(C_EXPR, Nullstab, Nullarg, $1)), $3); }
160 cond : IF '(' expr ')' compblock
162 $$ = make_icmd(C_IF,$3,$5); }
163 | UNLESS '(' expr ')' compblock
165 $$ = invert(make_icmd(C_IF,$3,$5)); }
168 $$ = make_ccmd(C_IF,cmd_to_arg($2),$3); }
169 | UNLESS block compblock
171 $$ = invert(make_ccmd(C_IF,cmd_to_arg($2),$3)); }
174 loop : label WHILE '(' texpr ')' compblock
176 $$ = wopt(add_label($1,
177 make_ccmd(C_WHILE,$4,$6) )); }
178 | label UNTIL '(' expr ')' compblock
180 $$ = wopt(add_label($1,
181 invert(make_ccmd(C_WHILE,$4,$6)) )); }
182 | label WHILE block compblock
184 $$ = wopt(add_label($1,
185 make_ccmd(C_WHILE, cmd_to_arg($3),$4) )); }
186 | label UNTIL block compblock
188 $$ = wopt(add_label($1,
189 invert(make_ccmd(C_WHILE, cmd_to_arg($3),$4)) )); }
190 | label FOR REG '(' expr ')' compblock
193 * The following gobbledygook catches EXPRs that
194 * aren't explicit array refs and translates
195 * foreach VAR (EXPR) {
198 * foreach VAR (@ary) {
199 * where @ary is a hidden array made by genstab().
200 * (Note that @ary may become a local array if
201 * it is determined that it might be called
202 * recursively. See cmd_tosave().)
204 if ($5->arg_type != O_ARRAY) {
205 scrstab = aadd(genstab());
207 make_acmd(C_EXPR, Nullstab,
208 l(make_op(O_ASSIGN,2,
209 listish(make_op(O_ARRAY, 1,
210 stab2arg(A_STAB,scrstab),
212 listish(make_list($5)),
215 wopt(over($3,add_label($1,
218 stab2arg(A_STAB,scrstab),
222 $$->c_head->c_line = $2;
225 $$ = wopt(over($3,add_label($1,
226 make_ccmd(C_WHILE,$5,$7) )));
229 | label FOR '(' expr ')' compblock
231 if ($4->arg_type != O_ARRAY) {
232 scrstab = aadd(genstab());
234 make_acmd(C_EXPR, Nullstab,
235 l(make_op(O_ASSIGN,2,
236 listish(make_op(O_ARRAY, 1,
237 stab2arg(A_STAB,scrstab),
239 listish(make_list($4)),
242 wopt(over(defstab,add_label($1,
245 stab2arg(A_STAB,scrstab),
249 $$->c_head->c_line = $2;
251 else { /* lisp, anyone? */
252 $$ = wopt(over(defstab,add_label($1,
253 make_ccmd(C_WHILE,$4,$6) )));
256 | label FOR '(' nexpr ';' texpr ';' nexpr ')' block
257 /* basically fake up an initialize-while lineseq */
258 { yyval.compval.comp_true = $10;
259 yyval.compval.comp_alt = $8;
261 $$ = append_line($4,wopt(add_label($1,
262 make_ccmd(C_WHILE,$6,yyval.compval) ))); }
263 | label compblock /* a block is a loop that happens once */
264 { $$ = add_label($1,make_ccmd(C_BLOCK,Nullarg,$2)); }
272 texpr : /* NULL means true */
273 { (void)scanstr("1"); $$ = yylval.arg; }
290 format : FORMAT WORD '=' FORMLIST
291 { if (strEQ($2,"stdout"))
292 make_form(stabent("STDOUT",TRUE),$4);
293 else if (strEQ($2,"stderr"))
294 make_form(stabent("STDERR",TRUE),$4);
296 make_form(stabent($2,TRUE),$4);
297 Safefree($2); $2 = Nullch; }
298 | FORMAT '=' FORMLIST
299 { make_form(stabent("STDOUT",TRUE),$3); }
302 subrout : SUB WORD block
306 package : PACKAGE WORD ';'
312 str_set(curstname,$2);
313 sprintf(tmpbuf,"'_%s",$2);
314 tmpstab = stabent(tmpbuf,TRUE);
315 if (!stab_xhash(tmpstab))
316 stab_xhash(tmpstab) = hnew(0);
317 curstash = stab_xhash(tmpstab);
318 if (!curstash->tbl_name)
319 curstash->tbl_name = savestr($2);
320 curstash->tbl_coeffsize = 0;
321 Safefree($2); $2 = Nullch;
330 expr : expr ',' sexpr
331 { $$ = make_op(O_COMMA, 2, $1, $3, Nullarg); }
339 sexpr : sexpr '=' sexpr
341 if ($1->arg_type == O_ASSIGN && $1->arg_len == 1)
342 $1->arg_type = O_ITEM; /* a local() */
343 if ($1->arg_type == O_LIST)
345 $$ = l(make_op(O_ASSIGN, 2, $1, $3, Nullarg)); }
346 | sexpr POW '=' sexpr
347 { $$ = l(make_op(O_POW, 2, $1, $4, Nullarg)); }
348 | sexpr MULOP '=' sexpr
349 { $$ = l(make_op($2, 2, $1, $4, Nullarg)); }
350 | sexpr ADDOP '=' sexpr
351 { $$ = rcatmaybe(l(make_op($2, 2, $1, $4, Nullarg)));}
353 { $$ = l(make_op(O_LEFT_SHIFT, 2, $1, $4, Nullarg)); }
355 { $$ = l(make_op(O_RIGHT_SHIFT, 2, $1, $4, Nullarg)); }
356 | sexpr '&' '=' sexpr
357 { $$ = l(make_op(O_BIT_AND, 2, $1, $4, Nullarg)); }
358 | sexpr '^' '=' sexpr
359 { $$ = l(make_op(O_XOR, 2, $1, $4, Nullarg)); }
360 | sexpr '|' '=' sexpr
361 { $$ = l(make_op(O_BIT_OR, 2, $1, $4, Nullarg)); }
365 { $$ = make_op(O_POW, 2, $1, $3, Nullarg); }
367 { if ($2 == O_REPEAT)
369 $$ = make_op($2, 2, $1, $3, Nullarg);
370 if ($2 == O_REPEAT) {
371 if ($$[1].arg_type != A_EXPR ||
372 $$[1].arg_ptr.arg_arg->arg_type != O_LIST)
373 $$[1].arg_flags &= ~AF_ARYOK;
376 { $$ = make_op($2, 2, $1, $3, Nullarg); }
378 { $$ = make_op(O_LEFT_SHIFT, 2, $1, $3, Nullarg); }
380 { $$ = make_op(O_RIGHT_SHIFT, 2, $1, $3, Nullarg); }
382 { $$ = make_op($2, 2, $1, $3, Nullarg); }
384 { $$ = make_op($2, 2, $1, $3, Nullarg); }
386 { $$ = make_op(O_BIT_AND, 2, $1, $3, Nullarg); }
388 { $$ = make_op(O_XOR, 2, $1, $3, Nullarg); }
390 { $$ = make_op(O_BIT_OR, 2, $1, $3, Nullarg); }
393 $$ = make_op(O_F_OR_R, 4, $1, $3, Nullarg); }
395 { $$ = make_op(O_AND, 2, $1, $3, Nullarg); }
397 { $$ = make_op(O_OR, 2, $1, $3, Nullarg); }
398 | sexpr '?' sexpr ':' sexpr
399 { $$ = make_op(O_COND_EXPR, 3, $1, $3, $5); }
401 { $$ = mod_match(O_MATCH, $1, $3); }
403 { $$ = mod_match(O_NMATCH, $1, $3); }
408 term : '-' term %prec UMINUS
409 { $$ = make_op(O_NEGATE, 1, $2, Nullarg, Nullarg); }
410 | '+' term %prec UMINUS
413 { $$ = make_op(O_NOT, 1, $2, Nullarg, Nullarg); }
415 { $$ = make_op(O_COMPLEMENT, 1, $2, Nullarg, Nullarg);}
417 { $$ = addflags(1, AF_POST|AF_UP,
418 l(make_op(O_ITEM,1,$1,Nullarg,Nullarg))); }
420 { $$ = addflags(1, AF_POST,
421 l(make_op(O_ITEM,1,$1,Nullarg,Nullarg))); }
423 { $$ = addflags(1, AF_PRE|AF_UP,
424 l(make_op(O_ITEM,1,$2,Nullarg,Nullarg))); }
426 { $$ = addflags(1, AF_PRE,
427 l(make_op(O_ITEM,1,$2,Nullarg,Nullarg))); }
429 { opargs[$1] = 0; /* force it special */
431 stab2arg(A_STAB,stabent($2,TRUE)),
436 $$ = make_op($1, 1, $2, Nullarg, Nullarg); }
438 { opargs[$1] = ($1 != O_FTTTY);
441 $1 == O_FTTTY?stabent("STDIN",TRUE):defstab),
444 { $$ = l(localize(make_op(O_ASSIGN, 1,
445 localize(listish(make_list($3))),
446 Nullarg,Nullarg))); }
448 { $$ = make_list($2); }
450 { $$ = make_list($2); }
452 { $$ = make_list(Nullarg); }
453 | DO sexpr %prec FILETEST
454 { $$ = make_op(O_DOFILE,2,$2,Nullarg,Nullarg);
457 { $$ = cmd_to_arg($2); }
459 { $$ = stab2arg(A_STAB,$1); }
461 { $$ = stab2arg(A_STAR,$1); }
462 | REG '[' expr ']' %prec '('
463 { $$ = make_op(O_AELEM, 2,
464 stab2arg(A_STAB,aadd($1)), $3, Nullarg); }
466 { $$ = make_op(O_HASH, 1,
470 { $$ = make_op(O_ARRAY, 1,
473 | REG '{' expr '}' %prec '('
474 { $$ = make_op(O_HELEM, 2,
475 stab2arg(A_STAB,hadd($1)),
478 | '(' expr ')' '[' expr ']' %prec '('
479 { $$ = make_op(O_LSLICE, 3,
481 listish(make_list($5)),
482 listish(make_list($2))); }
483 | '(' ')' '[' expr ']' %prec '('
484 { $$ = make_op(O_LSLICE, 3,
486 listish(make_list($4)),
488 | ARY '[' expr ']' %prec '('
489 { $$ = make_op(O_ASLICE, 2,
490 stab2arg(A_STAB,aadd($1)),
491 listish(make_list($3)),
493 | ARY '{' expr '}' %prec '('
494 { $$ = make_op(O_HSLICE, 2,
495 stab2arg(A_STAB,hadd($1)),
496 listish(make_list($3)),
498 | DELETE REG '{' expr '}' %prec '('
499 { $$ = make_op(O_DELETE, 2,
500 stab2arg(A_STAB,hadd($2)),
504 { $$ = stab2arg(A_ARYLEN,$1); }
513 | DO WORD '(' expr ')'
514 { $$ = make_op((perldb ? O_DBSUBR : O_SUBR), 2,
515 stab2arg(A_WORD,stabent($2,TRUE)),
517 Nullarg); Safefree($2); $2 = Nullch;
518 $$->arg_flags |= AF_DEPR; }
519 | AMPER WORD '(' expr ')'
520 { $$ = make_op((perldb ? O_DBSUBR : O_SUBR), 2,
521 stab2arg(A_WORD,stabent($2,TRUE)),
523 Nullarg); Safefree($2); $2 = Nullch; }
525 { $$ = make_op((perldb ? O_DBSUBR : O_SUBR), 2,
526 stab2arg(A_WORD,stabent($2,TRUE)),
529 $$->arg_flags |= AF_DEPR; }
531 { $$ = make_op((perldb ? O_DBSUBR : O_SUBR), 2,
532 stab2arg(A_WORD,stabent($2,TRUE)),
536 { $$ = make_op((perldb ? O_DBSUBR : O_SUBR), 2,
537 stab2arg(A_WORD,stabent($2,TRUE)),
540 | DO REG '(' expr ')'
541 { $$ = make_op((perldb ? O_DBSUBR : O_SUBR), 2,
545 $$->arg_flags |= AF_DEPR; }
546 | AMPER REG '(' expr ')'
547 { $$ = make_op((perldb ? O_DBSUBR : O_SUBR), 2,
552 { $$ = make_op((perldb ? O_DBSUBR : O_SUBR), 2,
556 $$->arg_flags |= AF_DEPR; }
558 { $$ = make_op((perldb ? O_DBSUBR : O_SUBR), 2,
563 { $$ = make_op((perldb ? O_DBSUBR : O_SUBR), 2,
568 { $$ = make_op($1,0,Nullarg,Nullarg,Nullarg); }
570 { $$ = make_op($1,1,cval_to_arg($2),
573 { $$ = make_op($1,0,Nullarg,Nullarg,Nullarg); }
575 { $$ = make_op($1,1,$2,Nullarg,Nullarg); }
577 { $$ = make_op(O_SELECT, 0, Nullarg, Nullarg, Nullarg);}
578 | SSELECT '(' handle ')'
579 { $$ = make_op(O_SELECT, 1, $3, Nullarg, Nullarg); }
580 | SSELECT '(' sexpr csexpr csexpr csexpr ')'
582 $$ = make_op(O_SSELECT, 4, $3, $4, $5); }
583 | OPEN WORD %prec '('
584 { $$ = make_op(O_OPEN, 2,
585 stab2arg(A_WORD,stabent($2,TRUE)),
586 stab2arg(A_STAB,stabent($2,TRUE)),
589 { $$ = make_op(O_OPEN, 2,
590 stab2arg(A_WORD,stabent($3,TRUE)),
591 stab2arg(A_STAB,stabent($3,TRUE)),
593 | OPEN '(' handle cexpr ')'
594 { $$ = make_op(O_OPEN, 2,
597 | FILOP '(' handle ')'
598 { $$ = make_op($1, 1,
602 { $$ = make_op($1, 1,
603 stab2arg(A_WORD,stabent($2,TRUE)),
605 Safefree($2); $2 = Nullch; }
607 { $$ = make_op($1, 1,
611 { $$ = make_op($1, 1,
612 stab2arg(A_WORD,Nullstab),
615 { $$ = make_op($1, 0,
616 Nullarg, Nullarg, Nullarg); }
617 | FILOP2 '(' handle cexpr ')'
618 { $$ = make_op($1, 2, $3, $4, Nullarg); }
619 | FILOP3 '(' handle csexpr cexpr ')'
620 { $$ = make_op($1, 3, $3, $4, make_list($5)); }
621 | FILOP22 '(' handle ',' handle ')'
622 { $$ = make_op($1, 2, $3, $5, Nullarg); }
623 | FILOP4 '(' handle csexpr csexpr cexpr ')'
624 { arg4 = $6; $$ = make_op($1, 4, $3, $4, $5); }
625 | FILOP25 '(' handle ',' handle csexpr csexpr cexpr ')'
626 { arg4 = $7; arg5 = $8;
627 $$ = make_op($1, 5, $3, $5, $6); }
628 | PUSH '(' aryword cexpr ')'
629 { $$ = make_op($1, 2,
633 | POP aryword %prec '('
634 { $$ = make_op(O_POP, 1, $2, Nullarg, Nullarg); }
635 | POP '(' aryword ')'
636 { $$ = make_op(O_POP, 1, $3, Nullarg, Nullarg); }
637 | SHIFT aryword %prec '('
638 { $$ = make_op(O_SHIFT, 1, $2, Nullarg, Nullarg); }
639 | SHIFT '(' aryword ')'
640 { $$ = make_op(O_SHIFT, 1, $3, Nullarg, Nullarg); }
642 { $$ = make_op(O_SHIFT, 1,
644 aadd(stabent(subline ? "_" : "ARGV", TRUE))),
647 { static char p[]="/\\s+/";
648 char *oldend = bufend;
649 ARG *oldarg = yylval.arg;
654 $$ = make_split(defstab,yylval.arg,Nullarg);
655 yylval.arg = oldarg; }
656 | SPLIT '(' sexpr csexpr csexpr ')'
657 { $$ = mod_match(O_MATCH, $4,
658 make_split(defstab,$3,$5));}
659 | SPLIT '(' sexpr csexpr ')'
660 { $$ = mod_match(O_MATCH, $4,
661 make_split(defstab,$3,Nullarg) ); }
662 | SPLIT '(' sexpr ')'
663 { $$ = mod_match(O_MATCH,
664 stab2arg(A_STAB,defstab),
665 make_split(defstab,$3,Nullarg) ); }
666 | FLIST2 '(' sexpr cexpr ')'
667 { $$ = make_op($1, 2,
669 listish(make_list($4)),
672 { $$ = make_op($1, 1,
676 | LVALFUN sexpr %prec '('
677 { $$ = l(make_op($1, 1, fixl($1,$2),
678 Nullarg, Nullarg)); }
680 { $$ = l(make_op($1, 1,
681 stab2arg(A_STAB,defstab),
682 Nullarg, Nullarg)); }
684 { $$ = make_op($1, 0, Nullarg, Nullarg, Nullarg); }
686 { $$ = make_op($1, 0, Nullarg, Nullarg, Nullarg); }
688 { $$ = make_op($1, 0, Nullarg, Nullarg, Nullarg); }
690 { $$ = make_op($1, 1, $3, Nullarg, Nullarg); }
691 | FUNC2 '(' sexpr cexpr ')'
692 { $$ = make_op($1, 2, $3, $4, Nullarg);
693 if ($1 == O_INDEX && $$[2].arg_type == A_SINGLE)
694 fbmcompile($$[2].arg_ptr.arg_str,0); }
695 | FUNC2x '(' sexpr csexpr ')'
696 { $$ = make_op($1, 2, $3, $4, Nullarg);
697 if ($1 == O_INDEX && $$[2].arg_type == A_SINGLE)
698 fbmcompile($$[2].arg_ptr.arg_str,0); }
699 | FUNC2x '(' sexpr csexpr cexpr ')'
700 { $$ = make_op($1, 3, $3, $4, $5);
701 if ($1 == O_INDEX && $$[2].arg_type == A_SINGLE)
702 fbmcompile($$[2].arg_ptr.arg_str,0); }
703 | FUNC3 '(' sexpr csexpr cexpr ')'
704 { $$ = make_op($1, 3, $3, $4, $5); }
705 | FUNC4 '(' sexpr csexpr csexpr cexpr ')'
707 $$ = make_op($1, 4, $3, $4, $5); }
708 | FUNC5 '(' sexpr csexpr csexpr csexpr cexpr ')'
709 { arg4 = $6; arg5 = $7;
710 $$ = make_op($1, 5, $3, $4, $5); }
711 | HSHFUN '(' hshword ')'
712 { $$ = make_op($1, 1,
717 { $$ = make_op($1, 1,
721 | HSHFUN3 '(' hshword csexpr cexpr ')'
722 { $$ = make_op($1, 3, $3, $4, $5); }
729 stab2arg(A_WORD,Nullstab),
730 stab2arg(A_STAB,defstab),
734 stab2arg(A_WORD,Nullstab),
735 maybelistish($1,make_list($2)),
739 stab2arg(A_WORD,stabent($2,TRUE)),
740 stab2arg(A_STAB,defstab),
744 stab2arg(A_WORD,stabent($2,TRUE)),
745 maybelistish($1,make_list($3)),
746 Nullarg); Safefree($2); $2 = Nullch; }
750 maybelistish($1,make_list($3)),
755 { $$ = stab2arg(A_WORD,stabent($1,TRUE));
756 Safefree($1); $1 = Nullch;}
761 { $$ = stab2arg(A_WORD,aadd(stabent($1,TRUE)));
762 Safefree($1); $1 = Nullch; }
764 { $$ = stab2arg(A_STAB,$1); }
768 { $$ = stab2arg(A_WORD,hadd(stabent($1,TRUE)));
769 Safefree($1); $1 = Nullch; }
771 { $$ = stab2arg(A_STAB,$1); }
775 * NOTE: The following entry must stay at the end of the file so that
776 * reduce/reduce conflicts resolve to it only if it's the only option.
782 $$->arg_type = O_ITEM;
783 $$[1].arg_type = A_SINGLE;
784 $$[1].arg_ptr.arg_str = str_make($1,0);
785 for (s = $1; *s && islower(*s); s++) ;
788 "\"%s\" may clash with future reserved word",