1 /* $Header: perl.y,v 3.0.1.6 90/03/27 16:13:45 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.6 90/03/27 16:13:45 lwall
10 * patch16: formats didn't work inside eval
12 * Revision 3.0.1.5 90/03/12 16:55:56 lwall
13 * patch13: added list slice operator (LIST)[LIST]
14 * patch13: (LIST,) now legal
16 * Revision 3.0.1.4 90/02/28 18:03:23 lwall
17 * patch9: line numbers were bogus during certain portions of foreach evaluation
19 * Revision 3.0.1.3 89/12/21 20:13:41 lwall
20 * patch7: send() didn't allow a TO argument
22 * Revision 3.0.1.2 89/11/11 04:49:04 lwall
23 * patch2: moved yydebug to where its type doesn't matter
24 * patch2: !$foo++ was unreasonably illegal
25 * patch2: local(@foo) didn't work
26 * patch2: default args to unary operators didn't work
28 * Revision 3.0.1.1 89/10/26 23:20:41 lwall
29 * patch1: grandfathered "format stdout"
30 * patch1: operator(); is now normally equivalent to operator;
32 * Revision 3.0 89/10/18 15:22:04 lwall
42 ARG *arg4; /* rarely used arguments to make_op() */
54 struct compcmd compval;
60 %token <ival> APPEND OPEN SELECT LOOPEX
61 %token <ival> USING FORMAT DO SHIFT PUSH POP LVALFUN
62 %token <ival> WHILE UNTIL IF UNLESS ELSE ELSIF CONTINUE SPLIT FLIST
63 %token <ival> FOR FILOP FILOP2 FILOP3 FILOP4 FILOP22 FILOP25
64 %token <ival> FUNC0 FUNC1 FUNC2 FUNC3 HSHFUN HSHFUN3
65 %token <ival> FLIST2 SUB FILETEST LOCAL DELETE
66 %token <ival> RELOP EQOP MULOP ADDOP PACKAGE AMPER LFUNC4
67 %token <formval> FORMLIST
68 %token <stabval> REG ARYLEN ARY HSH STAR
69 %token <arg> SUBST PATTERN
70 %token <arg> RSTRING TRANS
72 %type <ival> prog decl format remember
73 %type <cmdval> block lineseq line loop cond sideff nexpr else
74 %type <arg> expr sexpr cexpr csexpr term handle aryword hshword
75 %type <arg> texpr listop
77 %type <compval> compblock
79 %nonassoc <ival> LISTOP
90 %nonassoc <ival> UNIOP
105 #if defined(YYDEBUG) && defined(DEBUGGING)
106 yydebug = (debug & 1);
109 /*CONTINUED*/ lineseq
111 eval_root = block_head($2);
113 main_root = block_head($2); }
116 compblock: block CONTINUE block
117 { $$.comp_true = $1; $$.comp_alt = $3; }
119 { $$.comp_true = $1; $$.comp_alt = $2; }
126 | ELSIF '(' expr ')' compblock
128 $$ = make_ccmd(C_ELSIF,$3,$5); }
131 block : '{' remember lineseq '}'
132 { $$ = block_head($3);
133 if (savestack->ary_fill > $2)
137 remember: /* NULL */ /* in case they push a package name */
138 { $$ = savestack->ary_fill; }
144 { $$ = append_line($1,$2); }
150 { $$ = add_label($1,$2); }
151 | loop /* loops add their own labels */
153 { if ($1 != Nullch) {
154 $$ = add_label($1, make_acmd(C_EXPR, Nullstab,
159 { $$ = add_label($1,$2); }
165 { $$ = make_acmd(C_EXPR, Nullstab, $1, Nullarg); }
168 make_acmd(C_EXPR, Nullstab, Nullarg, $1), $3); }
170 { $$ = addcond(invert(
171 make_acmd(C_EXPR, Nullstab, Nullarg, $1)), $3); }
174 make_acmd(C_EXPR, Nullstab, Nullarg, $1), $3); }
176 { $$ = addloop(invert(
177 make_acmd(C_EXPR, Nullstab, Nullarg, $1)), $3); }
180 cond : IF '(' expr ')' compblock
182 $$ = make_icmd(C_IF,$3,$5); }
183 | UNLESS '(' expr ')' compblock
185 $$ = invert(make_icmd(C_IF,$3,$5)); }
188 $$ = make_ccmd(C_IF,cmd_to_arg($2),$3); }
189 | UNLESS block compblock
191 $$ = invert(make_ccmd(C_IF,cmd_to_arg($2),$3)); }
194 loop : label WHILE '(' texpr ')' compblock
196 $$ = wopt(add_label($1,
197 make_ccmd(C_WHILE,$4,$6) )); }
198 | label UNTIL '(' expr ')' compblock
200 $$ = wopt(add_label($1,
201 invert(make_ccmd(C_WHILE,$4,$6)) )); }
202 | label WHILE block compblock
204 $$ = wopt(add_label($1,
205 make_ccmd(C_WHILE, cmd_to_arg($3),$4) )); }
206 | label UNTIL block compblock
208 $$ = wopt(add_label($1,
209 invert(make_ccmd(C_WHILE, cmd_to_arg($3),$4)) )); }
210 | label FOR REG '(' expr ')' compblock
213 * The following gobbledygook catches EXPRs that
214 * aren't explicit array refs and translates
215 * foreach VAR (EXPR) {
218 * foreach VAR (@ary) {
219 * where @ary is a hidden array made by genstab().
220 * (Note that @ary may become a local array if
221 * it is determined that it might be called
222 * recursively. See cmd_tosave().)
224 if ($5->arg_type != O_ARRAY) {
225 scrstab = aadd(genstab());
227 make_acmd(C_EXPR, Nullstab,
228 l(make_op(O_ASSIGN,2,
229 listish(make_op(O_ARRAY, 1,
230 stab2arg(A_STAB,scrstab),
231 Nullarg,Nullarg, 1)),
232 listish(make_list($5)),
235 wopt(over($3,add_label($1,
238 stab2arg(A_STAB,scrstab),
242 $$->c_head->c_line = $2;
245 $$ = wopt(over($3,add_label($1,
246 make_ccmd(C_WHILE,$5,$7) )));
249 | label FOR '(' expr ')' compblock
251 if ($4->arg_type != O_ARRAY) {
252 scrstab = aadd(genstab());
254 make_acmd(C_EXPR, Nullstab,
255 l(make_op(O_ASSIGN,2,
256 listish(make_op(O_ARRAY, 1,
257 stab2arg(A_STAB,scrstab),
258 Nullarg,Nullarg, 1 )),
259 listish(make_list($4)),
262 wopt(over(defstab,add_label($1,
265 stab2arg(A_STAB,scrstab),
269 $$->c_head->c_line = $2;
271 else { /* lisp, anyone? */
272 $$ = wopt(over(defstab,add_label($1,
273 make_ccmd(C_WHILE,$4,$6) )));
276 | label FOR '(' nexpr ';' texpr ';' nexpr ')' block
277 /* basically fake up an initialize-while lineseq */
278 { yyval.compval.comp_true = $10;
279 yyval.compval.comp_alt = $8;
281 $$ = append_line($4,wopt(add_label($1,
282 make_ccmd(C_WHILE,$6,yyval.compval) ))); }
283 | label compblock /* a block is a loop that happens once */
284 { $$ = add_label($1,make_ccmd(C_BLOCK,Nullarg,$2)); }
292 texpr : /* NULL means true */
293 { (void)scanstr("1"); $$ = yylval.arg; }
310 format : FORMAT WORD '=' FORMLIST
311 { if (strEQ($2,"stdout"))
312 make_form(stabent("STDOUT",TRUE),$4);
313 else if (strEQ($2,"stderr"))
314 make_form(stabent("STDERR",TRUE),$4);
316 make_form(stabent($2,TRUE),$4);
318 | FORMAT '=' FORMLIST
319 { make_form(stabent("STDOUT",TRUE),$3); }
322 subrout : SUB WORD block
326 package : PACKAGE WORD ';'
331 str_set(curstname,$2);
332 sprintf(tmpbuf,"'_%s",$2);
333 curstash = stab_xhash(hadd(stabent(tmpbuf,TRUE)));
334 curstash->tbl_coeffsize = 0;
343 expr : expr ',' sexpr
344 { $$ = make_op(O_COMMA, 2, $1, $3, Nullarg); }
352 sexpr : sexpr '=' sexpr
354 if ($1->arg_type == O_ASSIGN && $1->arg_len == 1)
355 $1->arg_type = O_ITEM; /* a local() */
356 if ($1->arg_type == O_LIST)
358 $$ = l(make_op(O_ASSIGN, 2, $1, $3, Nullarg)); }
359 | sexpr POW '=' sexpr
360 { $$ = l(make_op(O_POW, 2, $1, $4, Nullarg)); }
361 | sexpr MULOP '=' sexpr
362 { $$ = l(make_op($2, 2, $1, $4, Nullarg)); }
363 | sexpr ADDOP '=' sexpr
364 { $$ = rcatmaybe(l(make_op($2, 2, $1, $4, Nullarg)));}
366 { $$ = l(make_op(O_LEFT_SHIFT, 2, $1, $4, Nullarg)); }
368 { $$ = l(make_op(O_RIGHT_SHIFT, 2, $1, $4, Nullarg)); }
369 | sexpr '&' '=' sexpr
370 { $$ = l(make_op(O_BIT_AND, 2, $1, $4, Nullarg)); }
371 | sexpr '^' '=' sexpr
372 { $$ = l(make_op(O_XOR, 2, $1, $4, Nullarg)); }
373 | sexpr '|' '=' sexpr
374 { $$ = l(make_op(O_BIT_OR, 2, $1, $4, Nullarg)); }
378 { $$ = make_op(O_POW, 2, $1, $3, Nullarg); }
380 { $$ = make_op($2, 2, $1, $3, Nullarg); }
382 { $$ = make_op($2, 2, $1, $3, Nullarg); }
384 { $$ = make_op(O_LEFT_SHIFT, 2, $1, $3, Nullarg); }
386 { $$ = make_op(O_RIGHT_SHIFT, 2, $1, $3, Nullarg); }
388 { $$ = make_op($2, 2, $1, $3, Nullarg); }
390 { $$ = make_op($2, 2, $1, $3, Nullarg); }
392 { $$ = make_op(O_BIT_AND, 2, $1, $3, Nullarg); }
394 { $$ = make_op(O_XOR, 2, $1, $3, Nullarg); }
396 { $$ = make_op(O_BIT_OR, 2, $1, $3, Nullarg); }
399 $$ = make_op(O_F_OR_R, 4, $1, $3, Nullarg); }
401 { $$ = make_op(O_AND, 2, $1, $3, Nullarg); }
403 { $$ = make_op(O_OR, 2, $1, $3, Nullarg); }
404 | sexpr '?' sexpr ':' sexpr
405 { $$ = make_op(O_COND_EXPR, 3, $1, $3, $5); }
407 { $$ = mod_match(O_MATCH, $1, $3); }
409 { $$ = mod_match(O_NMATCH, $1, $3); }
414 term : '-' term %prec UMINUS
415 { $$ = make_op(O_NEGATE, 1, $2, Nullarg, Nullarg); }
416 | '+' term %prec UMINUS
419 { $$ = make_op(O_NOT, 1, $2, Nullarg, Nullarg); }
421 { $$ = make_op(O_COMPLEMENT, 1, $2, Nullarg, Nullarg);}
423 { $$ = addflags(1, AF_POST|AF_UP,
424 l(make_op(O_ITEM,1,$1,Nullarg,Nullarg))); }
426 { $$ = addflags(1, AF_POST,
427 l(make_op(O_ITEM,1,$1,Nullarg,Nullarg))); }
429 { $$ = addflags(1, AF_PRE|AF_UP,
430 l(make_op(O_ITEM,1,$2,Nullarg,Nullarg))); }
432 { $$ = addflags(1, AF_PRE,
433 l(make_op(O_ITEM,1,$2,Nullarg,Nullarg))); }
435 { opargs[$1] = 0; /* force it special */
437 stab2arg(A_STAB,stabent($2,TRUE)),
442 $$ = make_op($1, 1, $2, Nullarg, Nullarg); }
444 { opargs[$1] = ($1 != O_FTTTY);
447 $1 == O_FTTTY?stabent("STDIN",TRUE):defstab),
450 { $$ = l(localize(make_op(O_ASSIGN, 1,
451 localize(listish(make_list($3))),
452 Nullarg,Nullarg))); }
454 { $$ = make_list(hide_ary($2)); }
456 { $$ = make_list(hide_ary($2)); }
458 { $$ = make_list(Nullarg); }
459 | DO sexpr %prec FILETEST
461 make_op(O_DOFILE,2,$2,Nullarg,Nullarg) );
464 { $$ = cmd_to_arg($2); }
466 { $$ = stab2arg(A_STAB,$1); }
468 { $$ = stab2arg(A_STAR,$1); }
469 | REG '[' expr ']' %prec '('
470 { $$ = make_op(O_AELEM, 2,
471 stab2arg(A_STAB,aadd($1)), $3, Nullarg); }
473 { $$ = make_op(O_HASH, 1,
477 { $$ = make_op(O_ARRAY, 1,
480 | REG '{' expr '}' %prec '('
481 { $$ = make_op(O_HELEM, 2,
482 stab2arg(A_STAB,hadd($1)),
485 | '(' expr ')' '[' expr ']' %prec '('
486 { $$ = make_op(O_LSLICE, 3,
488 listish(make_list($5)),
489 listish(make_list($2))); }
490 | ARY '[' expr ']' %prec '('
491 { $$ = make_op(O_ASLICE, 2,
492 stab2arg(A_STAB,aadd($1)),
493 listish(make_list($3)),
495 | ARY '{' expr '}' %prec '('
496 { $$ = make_op(O_HSLICE, 2,
497 stab2arg(A_STAB,hadd($1)),
498 listish(make_list($3)),
500 | DELETE REG '{' expr '}' %prec '('
501 { $$ = make_op(O_DELETE, 2,
502 stab2arg(A_STAB,hadd($2)),
506 { $$ = stab2arg(A_ARYLEN,$1); }
515 | DO WORD '(' expr ')'
516 { $$ = make_op((perldb ? O_DBSUBR : O_SUBR), 2,
517 stab2arg(A_WORD,stabent($2,TRUE)),
519 Nullarg); Safefree($2); }
520 | AMPER WORD '(' expr ')'
521 { $$ = make_op((perldb ? O_DBSUBR : O_SUBR), 2,
522 stab2arg(A_WORD,stabent($2,TRUE)),
524 Nullarg); Safefree($2); }
526 { $$ = make_op((perldb ? O_DBSUBR : O_SUBR), 2,
527 stab2arg(A_WORD,stabent($2,TRUE)),
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 | AMPER REG '(' expr ')'
546 { $$ = make_op((perldb ? O_DBSUBR : O_SUBR), 2,
551 { $$ = make_op((perldb ? O_DBSUBR : O_SUBR), 2,
556 { $$ = make_op((perldb ? O_DBSUBR : O_SUBR), 2,
561 { $$ = make_op((perldb ? O_DBSUBR : O_SUBR), 2,
566 { $$ = make_op($1,0,Nullarg,Nullarg,Nullarg); }
568 { $$ = make_op($1,1,cval_to_arg($2),
571 { $$ = make_op($1,0,Nullarg,Nullarg,Nullarg);
572 if ($1 == O_EVAL || $1 == O_RESET)
575 { $$ = make_op($1,1,$2,Nullarg,Nullarg);
576 if ($1 == O_EVAL || $1 == O_RESET)
579 { $$ = make_op(O_SELECT, 0, Nullarg, Nullarg, Nullarg);}
580 | SELECT '(' handle ')'
581 { $$ = make_op(O_SELECT, 1, $3, Nullarg, Nullarg); }
582 | SELECT '(' sexpr csexpr csexpr csexpr ')'
584 $$ = make_op(O_SSELECT, 4, $3, $4, $5); }
585 | OPEN WORD %prec '('
586 { $$ = make_op(O_OPEN, 2,
587 stab2arg(A_WORD,stabent($2,TRUE)),
588 stab2arg(A_STAB,stabent($2,TRUE)),
591 { $$ = make_op(O_OPEN, 2,
592 stab2arg(A_WORD,stabent($3,TRUE)),
593 stab2arg(A_STAB,stabent($3,TRUE)),
595 | OPEN '(' handle cexpr ')'
596 { $$ = make_op(O_OPEN, 2,
599 | FILOP '(' handle ')'
600 { $$ = make_op($1, 1,
604 { $$ = make_op($1, 1,
605 stab2arg(A_WORD,stabent($2,TRUE)),
609 { $$ = make_op($1, 1,
613 { $$ = make_op($1, 1,
614 stab2arg(A_WORD,Nullstab),
617 { $$ = make_op($1, 0,
618 Nullarg, Nullarg, Nullarg); }
619 | FILOP2 '(' handle cexpr ')'
620 { $$ = make_op($1, 2, $3, $4, Nullarg); }
621 | FILOP3 '(' handle csexpr cexpr ')'
622 { $$ = make_op($1, 3, $3, $4, make_list($5)); }
623 | FILOP22 '(' handle ',' handle ')'
624 { $$ = make_op($1, 2, $3, $5, Nullarg); }
625 | FILOP4 '(' handle csexpr csexpr cexpr ')'
626 { arg4 = $6; $$ = make_op($1, 4, $3, $4, $5); }
627 | FILOP25 '(' handle ',' handle csexpr csexpr cexpr ')'
628 { arg4 = $7; arg5 = $8;
629 $$ = make_op($1, 5, $3, $5, $6); }
630 | PUSH '(' aryword cexpr ')'
631 { $$ = make_op($1, 2,
635 | POP aryword %prec '('
636 { $$ = make_op(O_POP, 1, $2, Nullarg, Nullarg); }
637 | POP '(' aryword ')'
638 { $$ = make_op(O_POP, 1, $3, Nullarg, Nullarg); }
639 | SHIFT aryword %prec '('
640 { $$ = make_op(O_SHIFT, 1, $2, Nullarg, Nullarg); }
641 | SHIFT '(' aryword ')'
642 { $$ = make_op(O_SHIFT, 1, $3, Nullarg, Nullarg); }
644 { $$ = make_op(O_SHIFT, 1,
646 aadd(stabent(subline ? "_" : "ARGV", TRUE))),
649 { (void)scanpat("/\\s+/");
650 $$ = make_split(defstab,yylval.arg,Nullarg); }
651 | SPLIT '(' sexpr csexpr csexpr ')'
652 { $$ = mod_match(O_MATCH, $4,
653 make_split(defstab,$3,$5));}
654 | SPLIT '(' sexpr csexpr ')'
655 { $$ = mod_match(O_MATCH, $4,
656 make_split(defstab,$3,Nullarg) ); }
657 | SPLIT '(' sexpr ')'
658 { $$ = mod_match(O_MATCH,
659 stab2arg(A_STAB,defstab),
660 make_split(defstab,$3,Nullarg) ); }
661 | FLIST2 '(' sexpr cexpr ')'
662 { $$ = make_op($1, 2,
664 listish(make_list($4)),
667 { $$ = make_op($1, 1,
671 | LVALFUN sexpr %prec '('
672 { $$ = l(make_op($1, 1, fixl($1,$2),
673 Nullarg, Nullarg)); }
675 { $$ = l(make_op($1, 1,
676 stab2arg(A_STAB,defstab),
677 Nullarg, Nullarg)); }
679 { $$ = make_op($1, 0, Nullarg, Nullarg, Nullarg); }
681 { $$ = make_op($1, 0, Nullarg, Nullarg, Nullarg); }
683 { $$ = make_op($1, 0, Nullarg, Nullarg, Nullarg);
684 if ($1 == O_EVAL || $1 == O_RESET)
687 { $$ = make_op($1, 1, $3, Nullarg, Nullarg);
688 if ($1 == O_EVAL || $1 == O_RESET)
690 | FUNC2 '(' sexpr cexpr ')'
691 { $$ = make_op($1, 2, $3, $4, Nullarg);
692 if ($1 == O_INDEX && $$[2].arg_type == A_SINGLE)
693 fbmcompile($$[2].arg_ptr.arg_str,0); }
694 | FUNC3 '(' sexpr csexpr cexpr ')'
695 { $$ = make_op($1, 3, $3, $4, $5); }
696 | LFUNC4 '(' sexpr csexpr csexpr cexpr ')'
697 { arg4 = $6; $$ = make_op($1, 4, l($3), $4, $5); }
698 | HSHFUN '(' hshword ')'
699 { $$ = make_op($1, 1,
704 { $$ = make_op($1, 1,
708 | HSHFUN3 '(' hshword csexpr cexpr ')'
709 { $$ = make_op($1, 3, $3, $4, $5); }
715 stab2arg(A_WORD,Nullstab),
716 stab2arg(A_STAB,defstab),
720 stab2arg(A_WORD,Nullstab),
721 maybelistish($1,make_list($2)),
725 stab2arg(A_WORD,stabent($2,TRUE)),
726 stab2arg(A_STAB,defstab),
730 stab2arg(A_WORD,stabent($2,TRUE)),
731 maybelistish($1,make_list($3)),
732 Nullarg); Safefree($2); }
736 maybelistish($1,make_list($3)),
741 { $$ = stab2arg(A_WORD,stabent($1,TRUE)); Safefree($1);}
746 { $$ = stab2arg(A_WORD,aadd(stabent($1,TRUE)));
749 { $$ = stab2arg(A_STAB,$1); }
753 { $$ = stab2arg(A_WORD,hadd(stabent($1,TRUE)));
756 { $$ = stab2arg(A_STAB,$1); }