1 /* $Header: perl.y,v 3.0.1.2 89/11/11 04:49:04 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 3.0.1.2 89/11/11 04:49:04 lwall
10 * patch2: moved yydebug to where its type doesn't matter
11 * patch2: !$foo++ was unreasonably illegal
12 * patch2: local(@foo) didn't work
13 * patch2: default args to unary operators didn't work
15 * Revision 3.0.1.1 89/10/26 23:20:41 lwall
16 * patch1: grandfathered "format stdout"
17 * patch1: operator(); is now normally equivalent to operator;
19 * Revision 3.0 89/10/18 15:22:04 lwall
29 ARG *arg4; /* rarely used arguments to make_op() */
41 struct compcmd compval;
47 %token <ival> APPEND OPEN SELECT LOOPEX
48 %token <ival> USING FORMAT DO SHIFT PUSH POP LVALFUN
49 %token <ival> WHILE UNTIL IF UNLESS ELSE ELSIF CONTINUE SPLIT FLIST
50 %token <ival> FOR FILOP FILOP2 FILOP3 FILOP4 FILOP22 FILOP25
51 %token <ival> FUNC0 FUNC1 FUNC2 FUNC3 HSHFUN HSHFUN3
52 %token <ival> FLIST2 SUB FILETEST LOCAL DELETE
53 %token <ival> RELOP EQOP MULOP ADDOP PACKAGE AMPER LFUNC4
54 %token <formval> FORMLIST
55 %token <stabval> REG ARYLEN ARY HSH STAR
56 %token <arg> SUBST PATTERN
57 %token <arg> RSTRING TRANS
59 %type <ival> prog decl format remember
61 %type <cmdval> block lineseq line loop cond sideff nexpr else
62 %type <arg> expr sexpr cexpr csexpr term handle aryword hshword
63 %type <arg> texpr listop
65 %type <compval> compblock
67 %nonassoc <ival> LISTOP
78 %nonassoc <ival> UNIOP
93 #if defined(YYDEBUG) && defined(DEBUGGING)
94 yydebug = (debug & 1);
99 eval_root = block_head($2);
101 main_root = block_head($2); }
104 compblock: block CONTINUE block
105 { $$.comp_true = $1; $$.comp_alt = $3; }
107 { $$.comp_true = $1; $$.comp_alt = $2; }
114 | ELSIF '(' expr ')' compblock
116 $$ = make_ccmd(C_ELSIF,$3,$5); }
119 block : '{' remember lineseq '}'
120 { $$ = block_head($3);
121 if (savestack->ary_fill > $2)
125 remember: /* NULL */ /* in case they push a package name */
126 { $$ = savestack->ary_fill; }
132 { $$ = append_line($1,$2); }
138 { $$ = add_label($1,$2); }
139 | loop /* loops add their own labels */
141 { if ($1 != Nullch) {
142 $$ = add_label($1, make_acmd(C_EXPR, Nullstab,
147 { $$ = add_label($1,$2); }
153 { $$ = make_acmd(C_EXPR, Nullstab, $1, Nullarg); }
156 make_acmd(C_EXPR, Nullstab, Nullarg, $1), $3); }
158 { $$ = addcond(invert(
159 make_acmd(C_EXPR, Nullstab, Nullarg, $1)), $3); }
162 make_acmd(C_EXPR, Nullstab, Nullarg, $1), $3); }
164 { $$ = addloop(invert(
165 make_acmd(C_EXPR, Nullstab, Nullarg, $1)), $3); }
168 cond : IF '(' expr ')' compblock
170 $$ = make_icmd(C_IF,$3,$5); }
171 | UNLESS '(' expr ')' compblock
173 $$ = invert(make_icmd(C_IF,$3,$5)); }
176 $$ = make_ccmd(C_IF,cmd_to_arg($2),$3); }
177 | UNLESS block compblock
179 $$ = invert(make_ccmd(C_IF,cmd_to_arg($2),$3)); }
182 loop : label WHILE '(' texpr ')' compblock
184 $$ = wopt(add_label($1,
185 make_ccmd(C_WHILE,$4,$6) )); }
186 | label UNTIL '(' expr ')' compblock
188 $$ = wopt(add_label($1,
189 invert(make_ccmd(C_WHILE,$4,$6)) )); }
190 | label WHILE block compblock
192 $$ = wopt(add_label($1,
193 make_ccmd(C_WHILE, cmd_to_arg($3),$4) )); }
194 | label UNTIL block compblock
196 $$ = wopt(add_label($1,
197 invert(make_ccmd(C_WHILE, cmd_to_arg($3),$4)) )); }
198 | label FOR REG '(' expr ')' compblock
201 * The following gobbledygook catches EXPRs that
202 * aren't explicit array refs and translates
203 * foreach VAR (EXPR) {
206 * foreach VAR (@ary) {
207 * where @ary is a hidden array made by genstab().
208 * (Note that @ary may become a local array if
209 * it is determined that it might be called
210 * recursively. See cmd_tosave().)
212 if ($5->arg_type != O_ARRAY) {
213 scrstab = aadd(genstab());
215 make_acmd(C_EXPR, Nullstab,
216 l(make_op(O_ASSIGN,2,
217 listish(make_op(O_ARRAY, 1,
218 stab2arg(A_STAB,scrstab),
219 Nullarg,Nullarg, 1)),
220 listish(make_list($5)),
223 wopt(over($3,add_label($1,
226 stab2arg(A_STAB,scrstab),
231 $$ = wopt(over($3,add_label($1,
232 make_ccmd(C_WHILE,$5,$7) )));
235 | label FOR '(' expr ')' compblock
237 if ($4->arg_type != O_ARRAY) {
238 scrstab = aadd(genstab());
240 make_acmd(C_EXPR, Nullstab,
241 l(make_op(O_ASSIGN,2,
242 listish(make_op(O_ARRAY, 1,
243 stab2arg(A_STAB,scrstab),
244 Nullarg,Nullarg, 1 )),
245 listish(make_list($4)),
248 wopt(over(defstab,add_label($1,
251 stab2arg(A_STAB,scrstab),
255 else { /* lisp, anyone? */
256 $$ = wopt(over(defstab,add_label($1,
257 make_ccmd(C_WHILE,$4,$6) )));
260 | label FOR '(' nexpr ';' texpr ';' nexpr ')' block
261 /* basically fake up an initialize-while lineseq */
262 { yyval.compval.comp_true = $10;
263 yyval.compval.comp_alt = $8;
265 $$ = append_line($4,wopt(add_label($1,
266 make_ccmd(C_WHILE,$6,yyval.compval) ))); }
267 | label compblock /* a block is a loop that happens once */
268 { $$ = add_label($1,make_ccmd(C_BLOCK,Nullarg,$2)); }
276 texpr : /* NULL means true */
277 { (void)scanstr("1"); $$ = yylval.arg; }
294 format : FORMAT WORD '=' FORMLIST
295 { if (strEQ($2,"stdout"))
296 stab_form(stabent("STDOUT",TRUE)) = $4;
297 else if (strEQ($2,"stderr"))
298 stab_form(stabent("STDERR",TRUE)) = $4;
300 stab_form(stabent($2,TRUE)) = $4;
302 | FORMAT '=' FORMLIST
303 { stab_form(stabent("STDOUT",TRUE)) = $3; }
306 subrout : SUB WORD block
310 package : PACKAGE WORD ';'
315 str_set(curstname,$2);
316 sprintf(tmpbuf,"'_%s",$2);
317 curstash = stab_xhash(hadd(stabent(tmpbuf,TRUE)));
318 curstash->tbl_coeffsize = 0;
327 expr : expr ',' sexpr
328 { $$ = make_op(O_COMMA, 2, $1, $3, Nullarg); }
336 sexpr : sexpr '=' sexpr
338 if ($1->arg_type == O_ASSIGN && $1->arg_len == 1)
339 $1->arg_type = O_ITEM; /* a local() */
340 if ($1->arg_type == O_LIST)
342 $$ = l(make_op(O_ASSIGN, 2, $1, $3, Nullarg)); }
343 | sexpr POW '=' sexpr
344 { $$ = l(make_op(O_POW, 2, $1, $4, Nullarg)); }
345 | sexpr MULOP '=' sexpr
346 { $$ = l(make_op($2, 2, $1, $4, Nullarg)); }
347 | sexpr ADDOP '=' sexpr
348 { $$ = rcatmaybe(l(make_op($2, 2, $1, $4, Nullarg)));}
350 { $$ = l(make_op(O_LEFT_SHIFT, 2, $1, $4, Nullarg)); }
352 { $$ = l(make_op(O_RIGHT_SHIFT, 2, $1, $4, Nullarg)); }
353 | sexpr '&' '=' sexpr
354 { $$ = l(make_op(O_BIT_AND, 2, $1, $4, Nullarg)); }
355 | sexpr '^' '=' sexpr
356 { $$ = l(make_op(O_XOR, 2, $1, $4, Nullarg)); }
357 | sexpr '|' '=' sexpr
358 { $$ = l(make_op(O_BIT_OR, 2, $1, $4, Nullarg)); }
362 { $$ = make_op(O_POW, 2, $1, $3, Nullarg); }
364 { $$ = make_op($2, 2, $1, $3, Nullarg); }
366 { $$ = make_op($2, 2, $1, $3, Nullarg); }
368 { $$ = make_op(O_LEFT_SHIFT, 2, $1, $3, Nullarg); }
370 { $$ = make_op(O_RIGHT_SHIFT, 2, $1, $3, Nullarg); }
372 { $$ = make_op($2, 2, $1, $3, Nullarg); }
374 { $$ = make_op($2, 2, $1, $3, Nullarg); }
376 { $$ = make_op(O_BIT_AND, 2, $1, $3, Nullarg); }
378 { $$ = make_op(O_XOR, 2, $1, $3, Nullarg); }
380 { $$ = make_op(O_BIT_OR, 2, $1, $3, Nullarg); }
383 $$ = make_op(O_F_OR_R, 4, $1, $3, Nullarg); }
385 { $$ = make_op(O_AND, 2, $1, $3, Nullarg); }
387 { $$ = make_op(O_OR, 2, $1, $3, Nullarg); }
388 | sexpr '?' sexpr ':' sexpr
389 { $$ = make_op(O_COND_EXPR, 3, $1, $3, $5); }
391 { $$ = mod_match(O_MATCH, $1, $3); }
393 { $$ = mod_match(O_NMATCH, $1, $3); }
398 term : '-' term %prec UMINUS
399 { $$ = make_op(O_NEGATE, 1, $2, Nullarg, Nullarg); }
400 | '+' term %prec UMINUS
403 { $$ = make_op(O_NOT, 1, $2, Nullarg, Nullarg); }
405 { $$ = make_op(O_COMPLEMENT, 1, $2, Nullarg, Nullarg);}
407 { $$ = addflags(1, AF_POST|AF_UP,
408 l(make_op(O_ITEM,1,$1,Nullarg,Nullarg))); }
410 { $$ = addflags(1, AF_POST,
411 l(make_op(O_ITEM,1,$1,Nullarg,Nullarg))); }
413 { $$ = addflags(1, AF_PRE|AF_UP,
414 l(make_op(O_ITEM,1,$2,Nullarg,Nullarg))); }
416 { $$ = addflags(1, AF_PRE,
417 l(make_op(O_ITEM,1,$2,Nullarg,Nullarg))); }
419 { opargs[$1] = 0; /* force it special */
421 stab2arg(A_STAB,stabent($2,TRUE)),
426 $$ = make_op($1, 1, $2, Nullarg, Nullarg); }
428 { opargs[$1] = ($1 != O_FTTTY);
431 $1 == O_FTTTY?stabent("STDIN",TRUE):defstab),
434 { $$ = l(localize(make_op(O_ASSIGN, 1,
435 localize(listish(make_list($3))),
436 Nullarg,Nullarg))); }
438 { $$ = make_list(hide_ary($2)); }
440 { $$ = make_list(Nullarg); }
441 | DO sexpr %prec FILETEST
443 make_op(O_DOFILE,2,$2,Nullarg,Nullarg) );
446 { $$ = cmd_to_arg($2); }
448 { $$ = stab2arg(A_STAB,$1); }
450 { $$ = stab2arg(A_STAR,$1); }
451 | REG '[' expr ']' %prec '('
452 { $$ = make_op(O_AELEM, 2,
453 stab2arg(A_STAB,aadd($1)), $3, Nullarg); }
455 { $$ = make_op(O_HASH, 1,
459 { $$ = make_op(O_ARRAY, 1,
462 | REG '{' expr '}' %prec '('
463 { $$ = make_op(O_HELEM, 2,
464 stab2arg(A_STAB,hadd($1)),
467 | ARY '[' expr ']' %prec '('
468 { $$ = make_op(O_ASLICE, 2,
469 stab2arg(A_STAB,aadd($1)),
470 listish(make_list($3)),
472 | ARY '{' expr '}' %prec '('
473 { $$ = make_op(O_HSLICE, 2,
474 stab2arg(A_STAB,hadd($1)),
475 listish(make_list($3)),
477 | DELETE REG '{' expr '}' %prec '('
478 { $$ = make_op(O_DELETE, 2,
479 stab2arg(A_STAB,hadd($2)),
483 { $$ = stab2arg(A_ARYLEN,$1); }
492 | DO WORD '(' expr ')'
493 { $$ = make_op((perldb ? O_DBSUBR : O_SUBR), 2,
494 stab2arg(A_WORD,stabent($2,TRUE)),
496 Nullarg); Safefree($2); }
497 | AMPER WORD '(' expr ')'
498 { $$ = make_op((perldb ? O_DBSUBR : O_SUBR), 2,
499 stab2arg(A_WORD,stabent($2,TRUE)),
501 Nullarg); Safefree($2); }
503 { $$ = make_op((perldb ? O_DBSUBR : O_SUBR), 2,
504 stab2arg(A_WORD,stabent($2,TRUE)),
508 { $$ = make_op((perldb ? O_DBSUBR : O_SUBR), 2,
509 stab2arg(A_WORD,stabent($2,TRUE)),
513 { $$ = make_op((perldb ? O_DBSUBR : O_SUBR), 2,
514 stab2arg(A_WORD,stabent($2,TRUE)),
517 | DO REG '(' expr ')'
518 { $$ = make_op((perldb ? O_DBSUBR : O_SUBR), 2,
522 | AMPER REG '(' expr ')'
523 { $$ = make_op((perldb ? O_DBSUBR : O_SUBR), 2,
528 { $$ = make_op((perldb ? O_DBSUBR : O_SUBR), 2,
533 { $$ = make_op((perldb ? O_DBSUBR : O_SUBR), 2,
538 { $$ = make_op((perldb ? O_DBSUBR : O_SUBR), 2,
543 { $$ = make_op($1,0,Nullarg,Nullarg,Nullarg); }
545 { $$ = make_op($1,1,cval_to_arg($2),
548 { $$ = make_op($1,0,Nullarg,Nullarg,Nullarg);
549 if ($1 == O_EVAL || $1 == O_RESET)
552 { $$ = make_op($1,1,$2,Nullarg,Nullarg);
553 if ($1 == O_EVAL || $1 == O_RESET)
556 { $$ = make_op(O_SELECT, 0, Nullarg, Nullarg, Nullarg);}
557 | SELECT '(' handle ')'
558 { $$ = make_op(O_SELECT, 1, $3, Nullarg, Nullarg); }
559 | SELECT '(' sexpr csexpr csexpr csexpr ')'
561 $$ = make_op(O_SSELECT, 4, $3, $4, $5); }
562 | OPEN WORD %prec '('
563 { $$ = make_op(O_OPEN, 2,
564 stab2arg(A_WORD,stabent($2,TRUE)),
565 stab2arg(A_STAB,stabent($2,TRUE)),
568 { $$ = make_op(O_OPEN, 2,
569 stab2arg(A_WORD,stabent($3,TRUE)),
570 stab2arg(A_STAB,stabent($3,TRUE)),
572 | OPEN '(' handle cexpr ')'
573 { $$ = make_op(O_OPEN, 2,
576 | FILOP '(' handle ')'
577 { $$ = make_op($1, 1,
581 { $$ = make_op($1, 1,
582 stab2arg(A_WORD,stabent($2,TRUE)),
586 { $$ = make_op($1, 1,
590 { $$ = make_op($1, 1,
591 stab2arg(A_WORD,Nullstab),
594 { $$ = make_op($1, 0,
595 Nullarg, Nullarg, Nullarg); }
596 | FILOP2 '(' handle cexpr ')'
597 { $$ = make_op($1, 2, $3, $4, Nullarg); }
598 | FILOP3 '(' handle csexpr cexpr ')'
599 { $$ = make_op($1, 3, $3, $4, $5); }
600 | FILOP22 '(' handle ',' handle ')'
601 { $$ = make_op($1, 2, $3, $5, Nullarg); }
602 | FILOP4 '(' handle csexpr csexpr cexpr ')'
603 { arg4 = $6; $$ = make_op($1, 4, $3, $4, $5); }
604 | FILOP25 '(' handle ',' handle csexpr csexpr cexpr ')'
605 { arg4 = $7; arg5 = $8;
606 $$ = make_op($1, 5, $3, $5, $6); }
607 | PUSH '(' aryword cexpr ')'
608 { $$ = make_op($1, 2,
612 | POP aryword %prec '('
613 { $$ = make_op(O_POP, 1, $2, Nullarg, Nullarg); }
614 | POP '(' aryword ')'
615 { $$ = make_op(O_POP, 1, $3, Nullarg, Nullarg); }
616 | SHIFT aryword %prec '('
617 { $$ = make_op(O_SHIFT, 1, $2, Nullarg, Nullarg); }
618 | SHIFT '(' aryword ')'
619 { $$ = make_op(O_SHIFT, 1, $3, Nullarg, Nullarg); }
621 { $$ = make_op(O_SHIFT, 1,
623 aadd(stabent(subline ? "_" : "ARGV", TRUE))),
626 { (void)scanpat("/\\s+/");
627 $$ = make_split(defstab,yylval.arg,Nullarg); }
628 | SPLIT '(' sexpr csexpr csexpr ')'
629 { $$ = mod_match(O_MATCH, $4,
630 make_split(defstab,$3,$5));}
631 | SPLIT '(' sexpr csexpr ')'
632 { $$ = mod_match(O_MATCH, $4,
633 make_split(defstab,$3,Nullarg) ); }
634 | SPLIT '(' sexpr ')'
635 { $$ = mod_match(O_MATCH,
636 stab2arg(A_STAB,defstab),
637 make_split(defstab,$3,Nullarg) ); }
638 | FLIST2 '(' sexpr cexpr ')'
639 { $$ = make_op($1, 2,
641 listish(make_list($4)),
644 { $$ = make_op($1, 1,
648 | LVALFUN sexpr %prec '('
649 { $$ = l(make_op($1, 1, fixl($1,$2),
650 Nullarg, Nullarg)); }
652 { $$ = l(make_op($1, 1,
653 stab2arg(A_STAB,defstab),
654 Nullarg, Nullarg)); }
656 { $$ = make_op($1, 0, Nullarg, Nullarg, Nullarg); }
658 { $$ = make_op($1, 0, Nullarg, Nullarg, Nullarg); }
660 { $$ = make_op($1, 0, Nullarg, Nullarg, Nullarg);
661 if ($1 == O_EVAL || $1 == O_RESET)
664 { $$ = make_op($1, 1, $3, Nullarg, Nullarg);
665 if ($1 == O_EVAL || $1 == O_RESET)
667 | FUNC2 '(' sexpr cexpr ')'
668 { $$ = make_op($1, 2, $3, $4, Nullarg);
669 if ($1 == O_INDEX && $$[2].arg_type == A_SINGLE)
670 fbmcompile($$[2].arg_ptr.arg_str,0); }
671 | FUNC3 '(' sexpr csexpr cexpr ')'
672 { $$ = make_op($1, 3, $3, $4, $5); }
673 | LFUNC4 '(' sexpr csexpr csexpr cexpr ')'
674 { arg4 = $6; $$ = make_op($1, 4, l($3), $4, $5); }
675 | HSHFUN '(' hshword ')'
676 { $$ = make_op($1, 1,
681 { $$ = make_op($1, 1,
685 | HSHFUN3 '(' hshword csexpr cexpr ')'
686 { $$ = make_op($1, 3, $3, $4, $5); }
692 stab2arg(A_WORD,Nullstab),
693 stab2arg(A_STAB,defstab),
697 stab2arg(A_WORD,Nullstab),
698 maybelistish($1,make_list($2)),
702 stab2arg(A_WORD,stabent($2,TRUE)),
703 stab2arg(A_STAB,defstab),
707 stab2arg(A_WORD,stabent($2,TRUE)),
708 maybelistish($1,make_list($3)),
709 Nullarg); Safefree($2); }
713 maybelistish($1,make_list($3)),
718 { $$ = stab2arg(A_WORD,stabent($1,TRUE)); Safefree($1);}
723 { $$ = stab2arg(A_WORD,aadd(stabent($1,TRUE)));
726 { $$ = stab2arg(A_STAB,$1); }
730 { $$ = stab2arg(A_WORD,hadd(stabent($1,TRUE)));
733 { $$ = stab2arg(A_STAB,$1); }