1 /* $Header: perl.y,v 3.0.1.4 90/02/28 18:03:23 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.4 90/02/28 18:03:23 lwall
10 * patch9: line numbers were bogus during certain portions of foreach evaluation
12 * Revision 3.0.1.3 89/12/21 20:13:41 lwall
13 * patch7: send() didn't allow a TO argument
15 * Revision 3.0.1.2 89/11/11 04:49:04 lwall
16 * patch2: moved yydebug to where its type doesn't matter
17 * patch2: !$foo++ was unreasonably illegal
18 * patch2: local(@foo) didn't work
19 * patch2: default args to unary operators didn't work
21 * Revision 3.0.1.1 89/10/26 23:20:41 lwall
22 * patch1: grandfathered "format stdout"
23 * patch1: operator(); is now normally equivalent to operator;
25 * Revision 3.0 89/10/18 15:22:04 lwall
35 ARG *arg4; /* rarely used arguments to make_op() */
47 struct compcmd compval;
53 %token <ival> APPEND OPEN SELECT LOOPEX
54 %token <ival> USING FORMAT DO SHIFT PUSH POP LVALFUN
55 %token <ival> WHILE UNTIL IF UNLESS ELSE ELSIF CONTINUE SPLIT FLIST
56 %token <ival> FOR FILOP FILOP2 FILOP3 FILOP4 FILOP22 FILOP25
57 %token <ival> FUNC0 FUNC1 FUNC2 FUNC3 HSHFUN HSHFUN3
58 %token <ival> FLIST2 SUB FILETEST LOCAL DELETE
59 %token <ival> RELOP EQOP MULOP ADDOP PACKAGE AMPER LFUNC4
60 %token <formval> FORMLIST
61 %token <stabval> REG ARYLEN ARY HSH STAR
62 %token <arg> SUBST PATTERN
63 %token <arg> RSTRING TRANS
65 %type <ival> prog decl format remember
67 %type <cmdval> block lineseq line loop cond sideff nexpr else
68 %type <arg> expr sexpr cexpr csexpr term handle aryword hshword
69 %type <arg> texpr listop
71 %type <compval> compblock
73 %nonassoc <ival> LISTOP
84 %nonassoc <ival> UNIOP
99 #if defined(YYDEBUG) && defined(DEBUGGING)
100 yydebug = (debug & 1);
103 /*CONTINUED*/ lineseq
105 eval_root = block_head($2);
107 main_root = block_head($2); }
110 compblock: block CONTINUE block
111 { $$.comp_true = $1; $$.comp_alt = $3; }
113 { $$.comp_true = $1; $$.comp_alt = $2; }
120 | ELSIF '(' expr ')' compblock
122 $$ = make_ccmd(C_ELSIF,$3,$5); }
125 block : '{' remember lineseq '}'
126 { $$ = block_head($3);
127 if (savestack->ary_fill > $2)
131 remember: /* NULL */ /* in case they push a package name */
132 { $$ = savestack->ary_fill; }
138 { $$ = append_line($1,$2); }
144 { $$ = add_label($1,$2); }
145 | loop /* loops add their own labels */
147 { if ($1 != Nullch) {
148 $$ = add_label($1, make_acmd(C_EXPR, Nullstab,
153 { $$ = add_label($1,$2); }
159 { $$ = make_acmd(C_EXPR, Nullstab, $1, Nullarg); }
162 make_acmd(C_EXPR, Nullstab, Nullarg, $1), $3); }
164 { $$ = addcond(invert(
165 make_acmd(C_EXPR, Nullstab, Nullarg, $1)), $3); }
168 make_acmd(C_EXPR, Nullstab, Nullarg, $1), $3); }
170 { $$ = addloop(invert(
171 make_acmd(C_EXPR, Nullstab, Nullarg, $1)), $3); }
174 cond : IF '(' expr ')' compblock
176 $$ = make_icmd(C_IF,$3,$5); }
177 | UNLESS '(' expr ')' compblock
179 $$ = invert(make_icmd(C_IF,$3,$5)); }
182 $$ = make_ccmd(C_IF,cmd_to_arg($2),$3); }
183 | UNLESS block compblock
185 $$ = invert(make_ccmd(C_IF,cmd_to_arg($2),$3)); }
188 loop : label WHILE '(' texpr ')' compblock
190 $$ = wopt(add_label($1,
191 make_ccmd(C_WHILE,$4,$6) )); }
192 | label UNTIL '(' expr ')' compblock
194 $$ = wopt(add_label($1,
195 invert(make_ccmd(C_WHILE,$4,$6)) )); }
196 | label WHILE block compblock
198 $$ = wopt(add_label($1,
199 make_ccmd(C_WHILE, cmd_to_arg($3),$4) )); }
200 | label UNTIL block compblock
202 $$ = wopt(add_label($1,
203 invert(make_ccmd(C_WHILE, cmd_to_arg($3),$4)) )); }
204 | label FOR REG '(' expr ')' compblock
207 * The following gobbledygook catches EXPRs that
208 * aren't explicit array refs and translates
209 * foreach VAR (EXPR) {
212 * foreach VAR (@ary) {
213 * where @ary is a hidden array made by genstab().
214 * (Note that @ary may become a local array if
215 * it is determined that it might be called
216 * recursively. See cmd_tosave().)
218 if ($5->arg_type != O_ARRAY) {
219 scrstab = aadd(genstab());
221 make_acmd(C_EXPR, Nullstab,
222 l(make_op(O_ASSIGN,2,
223 listish(make_op(O_ARRAY, 1,
224 stab2arg(A_STAB,scrstab),
225 Nullarg,Nullarg, 1)),
226 listish(make_list($5)),
229 wopt(over($3,add_label($1,
232 stab2arg(A_STAB,scrstab),
236 $$->c_head->c_line = $2;
239 $$ = wopt(over($3,add_label($1,
240 make_ccmd(C_WHILE,$5,$7) )));
243 | label FOR '(' expr ')' compblock
245 if ($4->arg_type != O_ARRAY) {
246 scrstab = aadd(genstab());
248 make_acmd(C_EXPR, Nullstab,
249 l(make_op(O_ASSIGN,2,
250 listish(make_op(O_ARRAY, 1,
251 stab2arg(A_STAB,scrstab),
252 Nullarg,Nullarg, 1 )),
253 listish(make_list($4)),
256 wopt(over(defstab,add_label($1,
259 stab2arg(A_STAB,scrstab),
263 $$->c_head->c_line = $2;
265 else { /* lisp, anyone? */
266 $$ = wopt(over(defstab,add_label($1,
267 make_ccmd(C_WHILE,$4,$6) )));
270 | label FOR '(' nexpr ';' texpr ';' nexpr ')' block
271 /* basically fake up an initialize-while lineseq */
272 { yyval.compval.comp_true = $10;
273 yyval.compval.comp_alt = $8;
275 $$ = append_line($4,wopt(add_label($1,
276 make_ccmd(C_WHILE,$6,yyval.compval) ))); }
277 | label compblock /* a block is a loop that happens once */
278 { $$ = add_label($1,make_ccmd(C_BLOCK,Nullarg,$2)); }
286 texpr : /* NULL means true */
287 { (void)scanstr("1"); $$ = yylval.arg; }
304 format : FORMAT WORD '=' FORMLIST
305 { if (strEQ($2,"stdout"))
306 stab_form(stabent("STDOUT",TRUE)) = $4;
307 else if (strEQ($2,"stderr"))
308 stab_form(stabent("STDERR",TRUE)) = $4;
310 stab_form(stabent($2,TRUE)) = $4;
312 | FORMAT '=' FORMLIST
313 { stab_form(stabent("STDOUT",TRUE)) = $3; }
316 subrout : SUB WORD block
320 package : PACKAGE WORD ';'
325 str_set(curstname,$2);
326 sprintf(tmpbuf,"'_%s",$2);
327 curstash = stab_xhash(hadd(stabent(tmpbuf,TRUE)));
328 curstash->tbl_coeffsize = 0;
337 expr : expr ',' sexpr
338 { $$ = make_op(O_COMMA, 2, $1, $3, Nullarg); }
346 sexpr : sexpr '=' sexpr
348 if ($1->arg_type == O_ASSIGN && $1->arg_len == 1)
349 $1->arg_type = O_ITEM; /* a local() */
350 if ($1->arg_type == O_LIST)
352 $$ = l(make_op(O_ASSIGN, 2, $1, $3, Nullarg)); }
353 | sexpr POW '=' sexpr
354 { $$ = l(make_op(O_POW, 2, $1, $4, Nullarg)); }
355 | sexpr MULOP '=' sexpr
356 { $$ = l(make_op($2, 2, $1, $4, Nullarg)); }
357 | sexpr ADDOP '=' sexpr
358 { $$ = rcatmaybe(l(make_op($2, 2, $1, $4, Nullarg)));}
360 { $$ = l(make_op(O_LEFT_SHIFT, 2, $1, $4, Nullarg)); }
362 { $$ = l(make_op(O_RIGHT_SHIFT, 2, $1, $4, Nullarg)); }
363 | sexpr '&' '=' sexpr
364 { $$ = l(make_op(O_BIT_AND, 2, $1, $4, Nullarg)); }
365 | sexpr '^' '=' sexpr
366 { $$ = l(make_op(O_XOR, 2, $1, $4, Nullarg)); }
367 | sexpr '|' '=' sexpr
368 { $$ = l(make_op(O_BIT_OR, 2, $1, $4, Nullarg)); }
372 { $$ = make_op(O_POW, 2, $1, $3, Nullarg); }
374 { $$ = make_op($2, 2, $1, $3, Nullarg); }
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(hide_ary($2)); }
450 { $$ = make_list(Nullarg); }
451 | DO sexpr %prec FILETEST
453 make_op(O_DOFILE,2,$2,Nullarg,Nullarg) );
456 { $$ = cmd_to_arg($2); }
458 { $$ = stab2arg(A_STAB,$1); }
460 { $$ = stab2arg(A_STAR,$1); }
461 | REG '[' expr ']' %prec '('
462 { $$ = make_op(O_AELEM, 2,
463 stab2arg(A_STAB,aadd($1)), $3, Nullarg); }
465 { $$ = make_op(O_HASH, 1,
469 { $$ = make_op(O_ARRAY, 1,
472 | REG '{' expr '}' %prec '('
473 { $$ = make_op(O_HELEM, 2,
474 stab2arg(A_STAB,hadd($1)),
477 | ARY '[' expr ']' %prec '('
478 { $$ = make_op(O_ASLICE, 2,
479 stab2arg(A_STAB,aadd($1)),
480 listish(make_list($3)),
482 | ARY '{' expr '}' %prec '('
483 { $$ = make_op(O_HSLICE, 2,
484 stab2arg(A_STAB,hadd($1)),
485 listish(make_list($3)),
487 | DELETE REG '{' expr '}' %prec '('
488 { $$ = make_op(O_DELETE, 2,
489 stab2arg(A_STAB,hadd($2)),
493 { $$ = stab2arg(A_ARYLEN,$1); }
502 | DO WORD '(' expr ')'
503 { $$ = make_op((perldb ? O_DBSUBR : O_SUBR), 2,
504 stab2arg(A_WORD,stabent($2,TRUE)),
506 Nullarg); Safefree($2); }
507 | AMPER WORD '(' expr ')'
508 { $$ = make_op((perldb ? O_DBSUBR : O_SUBR), 2,
509 stab2arg(A_WORD,stabent($2,TRUE)),
511 Nullarg); Safefree($2); }
513 { $$ = make_op((perldb ? O_DBSUBR : O_SUBR), 2,
514 stab2arg(A_WORD,stabent($2,TRUE)),
518 { $$ = make_op((perldb ? O_DBSUBR : O_SUBR), 2,
519 stab2arg(A_WORD,stabent($2,TRUE)),
523 { $$ = make_op((perldb ? O_DBSUBR : O_SUBR), 2,
524 stab2arg(A_WORD,stabent($2,TRUE)),
527 | DO REG '(' expr ')'
528 { $$ = make_op((perldb ? O_DBSUBR : O_SUBR), 2,
532 | AMPER REG '(' expr ')'
533 { $$ = make_op((perldb ? O_DBSUBR : O_SUBR), 2,
538 { $$ = make_op((perldb ? O_DBSUBR : O_SUBR), 2,
543 { $$ = make_op((perldb ? O_DBSUBR : O_SUBR), 2,
548 { $$ = make_op((perldb ? O_DBSUBR : O_SUBR), 2,
553 { $$ = make_op($1,0,Nullarg,Nullarg,Nullarg); }
555 { $$ = make_op($1,1,cval_to_arg($2),
558 { $$ = make_op($1,0,Nullarg,Nullarg,Nullarg);
559 if ($1 == O_EVAL || $1 == O_RESET)
562 { $$ = make_op($1,1,$2,Nullarg,Nullarg);
563 if ($1 == O_EVAL || $1 == O_RESET)
566 { $$ = make_op(O_SELECT, 0, Nullarg, Nullarg, Nullarg);}
567 | SELECT '(' handle ')'
568 { $$ = make_op(O_SELECT, 1, $3, Nullarg, Nullarg); }
569 | SELECT '(' sexpr csexpr csexpr csexpr ')'
571 $$ = make_op(O_SSELECT, 4, $3, $4, $5); }
572 | OPEN WORD %prec '('
573 { $$ = make_op(O_OPEN, 2,
574 stab2arg(A_WORD,stabent($2,TRUE)),
575 stab2arg(A_STAB,stabent($2,TRUE)),
578 { $$ = make_op(O_OPEN, 2,
579 stab2arg(A_WORD,stabent($3,TRUE)),
580 stab2arg(A_STAB,stabent($3,TRUE)),
582 | OPEN '(' handle cexpr ')'
583 { $$ = make_op(O_OPEN, 2,
586 | FILOP '(' handle ')'
587 { $$ = make_op($1, 1,
591 { $$ = make_op($1, 1,
592 stab2arg(A_WORD,stabent($2,TRUE)),
596 { $$ = make_op($1, 1,
600 { $$ = make_op($1, 1,
601 stab2arg(A_WORD,Nullstab),
604 { $$ = make_op($1, 0,
605 Nullarg, Nullarg, Nullarg); }
606 | FILOP2 '(' handle cexpr ')'
607 { $$ = make_op($1, 2, $3, $4, Nullarg); }
608 | FILOP3 '(' handle csexpr cexpr ')'
609 { $$ = make_op($1, 3, $3, $4, make_list($5)); }
610 | FILOP22 '(' handle ',' handle ')'
611 { $$ = make_op($1, 2, $3, $5, Nullarg); }
612 | FILOP4 '(' handle csexpr csexpr cexpr ')'
613 { arg4 = $6; $$ = make_op($1, 4, $3, $4, $5); }
614 | FILOP25 '(' handle ',' handle csexpr csexpr cexpr ')'
615 { arg4 = $7; arg5 = $8;
616 $$ = make_op($1, 5, $3, $5, $6); }
617 | PUSH '(' aryword cexpr ')'
618 { $$ = make_op($1, 2,
622 | POP aryword %prec '('
623 { $$ = make_op(O_POP, 1, $2, Nullarg, Nullarg); }
624 | POP '(' aryword ')'
625 { $$ = make_op(O_POP, 1, $3, Nullarg, Nullarg); }
626 | SHIFT aryword %prec '('
627 { $$ = make_op(O_SHIFT, 1, $2, Nullarg, Nullarg); }
628 | SHIFT '(' aryword ')'
629 { $$ = make_op(O_SHIFT, 1, $3, Nullarg, Nullarg); }
631 { $$ = make_op(O_SHIFT, 1,
633 aadd(stabent(subline ? "_" : "ARGV", TRUE))),
636 { (void)scanpat("/\\s+/");
637 $$ = make_split(defstab,yylval.arg,Nullarg); }
638 | SPLIT '(' sexpr csexpr csexpr ')'
639 { $$ = mod_match(O_MATCH, $4,
640 make_split(defstab,$3,$5));}
641 | SPLIT '(' sexpr csexpr ')'
642 { $$ = mod_match(O_MATCH, $4,
643 make_split(defstab,$3,Nullarg) ); }
644 | SPLIT '(' sexpr ')'
645 { $$ = mod_match(O_MATCH,
646 stab2arg(A_STAB,defstab),
647 make_split(defstab,$3,Nullarg) ); }
648 | FLIST2 '(' sexpr cexpr ')'
649 { $$ = make_op($1, 2,
651 listish(make_list($4)),
654 { $$ = make_op($1, 1,
658 | LVALFUN sexpr %prec '('
659 { $$ = l(make_op($1, 1, fixl($1,$2),
660 Nullarg, Nullarg)); }
662 { $$ = l(make_op($1, 1,
663 stab2arg(A_STAB,defstab),
664 Nullarg, Nullarg)); }
666 { $$ = make_op($1, 0, Nullarg, Nullarg, Nullarg); }
668 { $$ = make_op($1, 0, Nullarg, Nullarg, Nullarg); }
670 { $$ = make_op($1, 0, Nullarg, Nullarg, Nullarg);
671 if ($1 == O_EVAL || $1 == O_RESET)
674 { $$ = make_op($1, 1, $3, Nullarg, Nullarg);
675 if ($1 == O_EVAL || $1 == O_RESET)
677 | FUNC2 '(' sexpr cexpr ')'
678 { $$ = make_op($1, 2, $3, $4, Nullarg);
679 if ($1 == O_INDEX && $$[2].arg_type == A_SINGLE)
680 fbmcompile($$[2].arg_ptr.arg_str,0); }
681 | FUNC3 '(' sexpr csexpr cexpr ')'
682 { $$ = make_op($1, 3, $3, $4, $5); }
683 | LFUNC4 '(' sexpr csexpr csexpr cexpr ')'
684 { arg4 = $6; $$ = make_op($1, 4, l($3), $4, $5); }
685 | HSHFUN '(' hshword ')'
686 { $$ = make_op($1, 1,
691 { $$ = make_op($1, 1,
695 | HSHFUN3 '(' hshword csexpr cexpr ')'
696 { $$ = make_op($1, 3, $3, $4, $5); }
702 stab2arg(A_WORD,Nullstab),
703 stab2arg(A_STAB,defstab),
707 stab2arg(A_WORD,Nullstab),
708 maybelistish($1,make_list($2)),
712 stab2arg(A_WORD,stabent($2,TRUE)),
713 stab2arg(A_STAB,defstab),
717 stab2arg(A_WORD,stabent($2,TRUE)),
718 maybelistish($1,make_list($3)),
719 Nullarg); Safefree($2); }
723 maybelistish($1,make_list($3)),
728 { $$ = stab2arg(A_WORD,stabent($1,TRUE)); Safefree($1);}
733 { $$ = stab2arg(A_WORD,aadd(stabent($1,TRUE)));
736 { $$ = stab2arg(A_STAB,$1); }
740 { $$ = stab2arg(A_WORD,hadd(stabent($1,TRUE)));
743 { $$ = stab2arg(A_STAB,$1); }