1 /* $Header: perl.y,v 3.0 89/10/18 15:22: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 89/10/18 15:22:04 lwall
19 ARG *arg4; /* rarely used arguments to make_op() */
31 struct compcmd compval;
37 %token <ival> APPEND OPEN SELECT 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 FUNC3 HSHFUN HSHFUN3
42 %token <ival> FLIST2 SUB FILETEST LOCAL DELETE
43 %token <ival> RELOP EQOP MULOP ADDOP PACKAGE AMPER LFUNC4
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
51 %type <cmdval> block lineseq line loop cond sideff nexpr else
52 %type <arg> expr sexpr cexpr csexpr term handle aryword hshword
53 %type <arg> texpr listop
55 %type <compval> compblock
57 %nonassoc <ival> LISTOP
68 %nonassoc <ival> UNIOP
83 eval_root = block_head($1);
85 main_root = block_head($1); }
88 compblock: block CONTINUE block
89 { $$.comp_true = $1; $$.comp_alt = $3; }
91 { $$.comp_true = $1; $$.comp_alt = $2; }
98 | ELSIF '(' expr ')' compblock
100 $$ = make_ccmd(C_ELSIF,$3,$5); }
103 block : '{' remember lineseq '}'
104 { $$ = block_head($3);
105 if (savestack->ary_fill > $2)
109 remember: /* NULL */ /* in case they push a package name */
110 { $$ = savestack->ary_fill; }
116 { $$ = append_line($1,$2); }
122 { $$ = add_label($1,$2); }
123 | loop /* loops add their own labels */
125 { if ($1 != Nullch) {
126 $$ = add_label($1, make_acmd(C_EXPR, Nullstab,
131 { $$ = add_label($1,$2); }
137 { $$ = make_acmd(C_EXPR, Nullstab, $1, Nullarg); }
140 make_acmd(C_EXPR, Nullstab, Nullarg, $1), $3); }
142 { $$ = addcond(invert(
143 make_acmd(C_EXPR, Nullstab, Nullarg, $1)), $3); }
146 make_acmd(C_EXPR, Nullstab, Nullarg, $1), $3); }
148 { $$ = addloop(invert(
149 make_acmd(C_EXPR, Nullstab, Nullarg, $1)), $3); }
152 cond : IF '(' expr ')' compblock
154 $$ = make_icmd(C_IF,$3,$5); }
155 | UNLESS '(' expr ')' compblock
157 $$ = invert(make_icmd(C_IF,$3,$5)); }
160 $$ = make_ccmd(C_IF,cmd_to_arg($2),$3); }
161 | UNLESS block compblock
163 $$ = invert(make_ccmd(C_IF,cmd_to_arg($2),$3)); }
166 loop : label WHILE '(' texpr ')' compblock
168 $$ = wopt(add_label($1,
169 make_ccmd(C_WHILE,$4,$6) )); }
170 | label UNTIL '(' expr ')' compblock
172 $$ = wopt(add_label($1,
173 invert(make_ccmd(C_WHILE,$4,$6)) )); }
174 | label WHILE block compblock
176 $$ = wopt(add_label($1,
177 make_ccmd(C_WHILE, cmd_to_arg($3),$4) )); }
178 | label UNTIL block compblock
180 $$ = wopt(add_label($1,
181 invert(make_ccmd(C_WHILE, cmd_to_arg($3),$4)) )); }
182 | label FOR REG '(' expr ')' compblock
185 * The following gobbledygook catches EXPRs that
186 * aren't explicit array refs and translates
187 * foreach VAR (EXPR) {
190 * foreach VAR (@ary) {
191 * where @ary is a hidden array made by genstab().
192 * (Note that @ary may become a local array if
193 * it is determined that it might be called
194 * recursively. See cmd_tosave().)
196 if ($5->arg_type != O_ARRAY) {
197 scrstab = aadd(genstab());
199 make_acmd(C_EXPR, Nullstab,
200 l(make_op(O_ASSIGN,2,
201 listish(make_op(O_ARRAY, 1,
202 stab2arg(A_STAB,scrstab),
203 Nullarg,Nullarg, 1)),
204 listish(make_list($5)),
207 wopt(over($3,add_label($1,
210 stab2arg(A_STAB,scrstab),
215 $$ = wopt(over($3,add_label($1,
216 make_ccmd(C_WHILE,$5,$7) )));
219 | label FOR '(' expr ')' compblock
221 if ($4->arg_type != O_ARRAY) {
222 scrstab = aadd(genstab());
224 make_acmd(C_EXPR, Nullstab,
225 l(make_op(O_ASSIGN,2,
226 listish(make_op(O_ARRAY, 1,
227 stab2arg(A_STAB,scrstab),
228 Nullarg,Nullarg, 1 )),
229 listish(make_list($4)),
232 wopt(over(defstab,add_label($1,
235 stab2arg(A_STAB,scrstab),
239 else { /* lisp, anyone? */
240 $$ = wopt(over(defstab,add_label($1,
241 make_ccmd(C_WHILE,$4,$6) )));
244 | label FOR '(' nexpr ';' texpr ';' nexpr ')' block
245 /* basically fake up an initialize-while lineseq */
246 { yyval.compval.comp_true = $10;
247 yyval.compval.comp_alt = $8;
249 $$ = append_line($4,wopt(add_label($1,
250 make_ccmd(C_WHILE,$6,yyval.compval) ))); }
251 | label compblock /* a block is a loop that happens once */
252 { $$ = add_label($1,make_ccmd(C_BLOCK,Nullarg,$2)); }
260 texpr : /* NULL means true */
261 { (void)scanstr("1"); $$ = yylval.arg; }
278 format : FORMAT WORD '=' FORMLIST
279 { stab_form(stabent($2,TRUE)) = $4; Safefree($2);}
280 | FORMAT '=' FORMLIST
281 { stab_form(stabent("STDOUT",TRUE)) = $3; }
284 subrout : SUB WORD block
288 package : PACKAGE WORD ';'
293 str_set(curstname,$2);
294 sprintf(tmpbuf,"'_%s",$2);
295 curstash = stab_xhash(hadd(stabent(tmpbuf,TRUE)));
296 curstash->tbl_coeffsize = 0;
305 expr : expr ',' sexpr
306 { $$ = make_op(O_COMMA, 2, $1, $3, Nullarg); }
314 sexpr : sexpr '=' sexpr
316 if ($1->arg_type == O_ASSIGN && $1->arg_len == 1)
317 $1->arg_type = O_ITEM; /* a local() */
318 if ($1->arg_type == O_LIST)
320 $$ = l(make_op(O_ASSIGN, 2, $1, $3, Nullarg)); }
321 | sexpr POW '=' sexpr
322 { $$ = l(make_op(O_POW, 2, $1, $4, Nullarg)); }
323 | sexpr MULOP '=' sexpr
324 { $$ = l(make_op($2, 2, $1, $4, Nullarg)); }
325 | sexpr ADDOP '=' sexpr
326 { $$ = rcatmaybe(l(make_op($2, 2, $1, $4, Nullarg)));}
328 { $$ = l(make_op(O_LEFT_SHIFT, 2, $1, $4, Nullarg)); }
330 { $$ = l(make_op(O_RIGHT_SHIFT, 2, $1, $4, Nullarg)); }
331 | sexpr '&' '=' sexpr
332 { $$ = l(make_op(O_BIT_AND, 2, $1, $4, Nullarg)); }
333 | sexpr '^' '=' sexpr
334 { $$ = l(make_op(O_XOR, 2, $1, $4, Nullarg)); }
335 | sexpr '|' '=' sexpr
336 { $$ = l(make_op(O_BIT_OR, 2, $1, $4, Nullarg)); }
340 { $$ = make_op(O_POW, 2, $1, $3, Nullarg); }
342 { $$ = make_op($2, 2, $1, $3, Nullarg); }
344 { $$ = make_op($2, 2, $1, $3, Nullarg); }
346 { $$ = make_op(O_LEFT_SHIFT, 2, $1, $3, Nullarg); }
348 { $$ = make_op(O_RIGHT_SHIFT, 2, $1, $3, Nullarg); }
350 { $$ = make_op($2, 2, $1, $3, Nullarg); }
352 { $$ = make_op($2, 2, $1, $3, Nullarg); }
354 { $$ = make_op(O_BIT_AND, 2, $1, $3, Nullarg); }
356 { $$ = make_op(O_XOR, 2, $1, $3, Nullarg); }
358 { $$ = make_op(O_BIT_OR, 2, $1, $3, Nullarg); }
361 $$ = make_op(O_F_OR_R, 4, $1, $3, Nullarg); }
363 { $$ = make_op(O_AND, 2, $1, $3, Nullarg); }
365 { $$ = make_op(O_OR, 2, $1, $3, Nullarg); }
366 | sexpr '?' sexpr ':' sexpr
367 { $$ = make_op(O_COND_EXPR, 3, $1, $3, $5); }
369 { $$ = mod_match(O_MATCH, $1, $3); }
371 { $$ = mod_match(O_NMATCH, $1, $3); }
373 { $$ = addflags(1, AF_POST|AF_UP,
374 l(make_op(O_ITEM,1,$1,Nullarg,Nullarg))); }
376 { $$ = addflags(1, AF_POST,
377 l(make_op(O_ITEM,1,$1,Nullarg,Nullarg))); }
379 { $$ = addflags(1, AF_PRE|AF_UP,
380 l(make_op(O_ITEM,1,$2,Nullarg,Nullarg))); }
382 { $$ = addflags(1, AF_PRE,
383 l(make_op(O_ITEM,1,$2,Nullarg,Nullarg))); }
388 term : '-' term %prec UMINUS
389 { $$ = make_op(O_NEGATE, 1, $2, Nullarg, Nullarg); }
390 | '+' term %prec UMINUS
393 { $$ = make_op(O_NOT, 1, $2, Nullarg, Nullarg); }
395 { $$ = make_op(O_COMPLEMENT, 1, $2, Nullarg, Nullarg);}
397 { opargs[$1] = 0; /* force it special */
399 stab2arg(A_STAB,stabent($2,TRUE)),
404 $$ = make_op($1, 1, $2, Nullarg, Nullarg); }
406 { opargs[$1] = ($1 != O_FTTTY);
409 $1 == O_FTTTY?stabent("STDIN",TRUE):defstab),
412 { $$ = l(make_op(O_ITEM, 1,
413 localize(listish(make_list($3))),
416 { $$ = make_list(hide_ary($2)); }
418 { $$ = make_list(Nullarg); }
419 | DO sexpr %prec FILETEST
421 make_op(O_DOFILE,2,$2,Nullarg,Nullarg) );
424 { $$ = cmd_to_arg($2); }
426 { $$ = stab2arg(A_STAB,$1); }
428 { $$ = stab2arg(A_STAR,$1); }
429 | REG '[' expr ']' %prec '('
430 { $$ = make_op(O_AELEM, 2,
431 stab2arg(A_STAB,aadd($1)), $3, Nullarg); }
433 { $$ = make_op(O_HASH, 1,
437 { $$ = make_op(O_ARRAY, 1,
440 | REG '{' expr '}' %prec '('
441 { $$ = make_op(O_HELEM, 2,
442 stab2arg(A_STAB,hadd($1)),
445 | ARY '[' expr ']' %prec '('
446 { $$ = make_op(O_ASLICE, 2,
447 stab2arg(A_STAB,aadd($1)),
448 listish(make_list($3)),
450 | ARY '{' expr '}' %prec '('
451 { $$ = make_op(O_HSLICE, 2,
452 stab2arg(A_STAB,hadd($1)),
453 listish(make_list($3)),
455 | DELETE REG '{' expr '}' %prec '('
456 { $$ = make_op(O_DELETE, 2,
457 stab2arg(A_STAB,hadd($2)),
461 { $$ = stab2arg(A_ARYLEN,$1); }
470 | DO WORD '(' expr ')'
471 { $$ = make_op((perldb ? O_DBSUBR : O_SUBR), 2,
472 stab2arg(A_WORD,stabent($2,TRUE)),
474 Nullarg); Safefree($2); }
475 | AMPER WORD '(' expr ')'
476 { $$ = make_op((perldb ? O_DBSUBR : O_SUBR), 2,
477 stab2arg(A_WORD,stabent($2,TRUE)),
479 Nullarg); Safefree($2); }
481 { $$ = make_op((perldb ? O_DBSUBR : O_SUBR), 2,
482 stab2arg(A_WORD,stabent($2,TRUE)),
486 { $$ = make_op((perldb ? O_DBSUBR : O_SUBR), 2,
487 stab2arg(A_WORD,stabent($2,TRUE)),
491 { $$ = make_op((perldb ? O_DBSUBR : O_SUBR), 2,
492 stab2arg(A_WORD,stabent($2,TRUE)),
495 | DO REG '(' expr ')'
496 { $$ = make_op((perldb ? O_DBSUBR : O_SUBR), 2,
500 | AMPER REG '(' expr ')'
501 { $$ = make_op((perldb ? O_DBSUBR : O_SUBR), 2,
506 { $$ = make_op((perldb ? O_DBSUBR : O_SUBR), 2,
511 { $$ = make_op((perldb ? O_DBSUBR : O_SUBR), 2,
516 { $$ = make_op((perldb ? O_DBSUBR : O_SUBR), 2,
521 { $$ = make_op($1,0,Nullarg,Nullarg,Nullarg); }
523 { $$ = make_op($1,1,cval_to_arg($2),
526 { $$ = make_op($1,1,Nullarg,Nullarg,Nullarg);
527 if ($1 == O_EVAL || $1 == O_RESET)
530 { $$ = make_op($1,1,$2,Nullarg,Nullarg);
531 if ($1 == O_EVAL || $1 == O_RESET)
534 { $$ = make_op(O_SELECT, 0, Nullarg, Nullarg, Nullarg);}
535 | SELECT '(' handle ')'
536 { $$ = make_op(O_SELECT, 1, $3, Nullarg, Nullarg); }
537 | SELECT '(' sexpr csexpr csexpr csexpr ')'
539 $$ = make_op(O_SSELECT, 4, $3, $4, $5); }
540 | OPEN WORD %prec '('
541 { $$ = make_op(O_OPEN, 2,
542 stab2arg(A_WORD,stabent($2,TRUE)),
543 stab2arg(A_STAB,stabent($2,TRUE)),
546 { $$ = make_op(O_OPEN, 2,
547 stab2arg(A_WORD,stabent($3,TRUE)),
548 stab2arg(A_STAB,stabent($3,TRUE)),
550 | OPEN '(' handle cexpr ')'
551 { $$ = make_op(O_OPEN, 2,
554 | FILOP '(' handle ')'
555 { $$ = make_op($1, 1,
559 { $$ = make_op($1, 1,
560 stab2arg(A_WORD,stabent($2,TRUE)),
564 { $$ = make_op($1, 1,
568 { $$ = make_op($1, 1,
569 stab2arg(A_WORD,Nullstab),
572 { $$ = make_op($1, 0,
573 Nullarg, Nullarg, Nullarg); }
574 | FILOP2 '(' handle cexpr ')'
575 { $$ = make_op($1, 2, $3, $4, Nullarg); }
576 | FILOP3 '(' handle csexpr cexpr ')'
577 { $$ = make_op($1, 3, $3, $4, $5); }
578 | FILOP22 '(' handle ',' handle ')'
579 { $$ = make_op($1, 2, $3, $5, Nullarg); }
580 | FILOP4 '(' handle csexpr csexpr cexpr ')'
581 { arg4 = $6; $$ = make_op($1, 4, $3, $4, $5); }
582 | FILOP25 '(' handle ',' handle csexpr csexpr cexpr ')'
583 { arg4 = $7; arg5 = $8;
584 $$ = make_op($1, 5, $3, $5, $6); }
585 | PUSH '(' aryword cexpr ')'
586 { $$ = make_op($1, 2,
590 | POP aryword %prec '('
591 { $$ = make_op(O_POP, 1, $2, Nullarg, Nullarg); }
592 | POP '(' aryword ')'
593 { $$ = make_op(O_POP, 1, $3, Nullarg, Nullarg); }
594 | SHIFT aryword %prec '('
595 { $$ = make_op(O_SHIFT, 1, $2, Nullarg, Nullarg); }
596 | SHIFT '(' aryword ')'
597 { $$ = make_op(O_SHIFT, 1, $3, Nullarg, Nullarg); }
599 { $$ = make_op(O_SHIFT, 1,
601 aadd(stabent(subline ? "_" : "ARGV", TRUE))),
604 { (void)scanpat("/\\s+/");
605 $$ = make_split(defstab,yylval.arg,Nullarg); }
606 | SPLIT '(' sexpr csexpr csexpr ')'
607 { $$ = mod_match(O_MATCH, $4,
608 make_split(defstab,$3,$5));}
609 | SPLIT '(' sexpr csexpr ')'
610 { $$ = mod_match(O_MATCH, $4,
611 make_split(defstab,$3,Nullarg) ); }
612 | SPLIT '(' sexpr ')'
613 { $$ = mod_match(O_MATCH,
614 stab2arg(A_STAB,defstab),
615 make_split(defstab,$3,Nullarg) ); }
616 | FLIST2 '(' sexpr cexpr ')'
617 { $$ = make_op($1, 2,
619 listish(make_list($4)),
622 { $$ = make_op($1, 1,
626 | LVALFUN sexpr %prec '('
627 { $$ = l(make_op($1, 1, fixl($1,$2),
628 Nullarg, Nullarg)); }
630 { $$ = l(make_op($1, 1,
631 stab2arg(A_STAB,defstab),
632 Nullarg, Nullarg)); }
634 { $$ = make_op($1, 0, Nullarg, Nullarg, Nullarg); }
636 { $$ = make_op($1, 1, $3, Nullarg, Nullarg);
637 if ($1 == O_EVAL || $1 == O_RESET)
639 | FUNC2 '(' sexpr cexpr ')'
640 { $$ = make_op($1, 2, $3, $4, Nullarg);
641 if ($1 == O_INDEX && $$[2].arg_type == A_SINGLE)
642 fbmcompile($$[2].arg_ptr.arg_str,0); }
643 | FUNC3 '(' sexpr csexpr cexpr ')'
644 { $$ = make_op($1, 3, $3, $4, $5); }
645 | LFUNC4 '(' sexpr csexpr csexpr cexpr ')'
646 { arg4 = $6; $$ = make_op($1, 4, l($3), $4, $5); }
647 | HSHFUN '(' hshword ')'
648 { $$ = make_op($1, 1,
653 { $$ = make_op($1, 1,
657 | HSHFUN3 '(' hshword csexpr cexpr ')'
658 { $$ = make_op($1, 3, $3, $4, $5); }
664 stab2arg(A_WORD,Nullstab),
665 stab2arg(A_STAB,defstab),
669 stab2arg(A_WORD,Nullstab),
670 maybelistish($1,make_list($2)),
674 stab2arg(A_WORD,stabent($2,TRUE)),
675 stab2arg(A_STAB,defstab),
679 stab2arg(A_WORD,stabent($2,TRUE)),
680 maybelistish($1,make_list($3)),
681 Nullarg); Safefree($2); }
685 maybelistish($1,make_list($3)),
690 { $$ = stab2arg(A_WORD,stabent($1,TRUE)); Safefree($1);}
695 { $$ = stab2arg(A_WORD,aadd(stabent($1,TRUE)));
698 { $$ = stab2arg(A_STAB,$1); }
702 { $$ = stab2arg(A_WORD,hadd(stabent($1,TRUE)));
705 { $$ = stab2arg(A_STAB,$1); }