1 /* $Header: perl.y,v 3.0.1.7 90/08/09 04:17:44 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.7 90/08/09 04:17:44 lwall
10 * patch19: did preliminary work toward debugging packages and evals
11 * patch19: added require operator
12 * patch19: bare identifiers are now strings if no other interpretation possible
13 * patch19: null-label lines threw off line number of next statement
14 * patch19: split; didn't pass correct bufend to scanpat
16 * Revision 3.0.1.6 90/03/27 16:13:45 lwall
17 * patch16: formats didn't work inside eval
19 * Revision 3.0.1.5 90/03/12 16:55:56 lwall
20 * patch13: added list slice operator (LIST)[LIST]
21 * patch13: (LIST,) now legal
23 * Revision 3.0.1.4 90/02/28 18:03:23 lwall
24 * patch9: line numbers were bogus during certain portions of foreach evaluation
26 * Revision 3.0.1.3 89/12/21 20:13:41 lwall
27 * patch7: send() didn't allow a TO argument
29 * Revision 3.0.1.2 89/11/11 04:49:04 lwall
30 * patch2: moved yydebug to where its type doesn't matter
31 * patch2: !$foo++ was unreasonably illegal
32 * patch2: local(@foo) didn't work
33 * patch2: default args to unary operators didn't work
35 * Revision 3.0.1.1 89/10/26 23:20:41 lwall
36 * patch1: grandfathered "format stdout"
37 * patch1: operator(); is now normally equivalent to operator;
39 * Revision 3.0 89/10/18 15:22:04 lwall
49 ARG *arg4; /* rarely used arguments to make_op() */
61 struct compcmd compval;
67 %token <ival> APPEND OPEN SSELECT LOOPEX
68 %token <ival> USING FORMAT DO SHIFT PUSH POP LVALFUN
69 %token <ival> WHILE UNTIL IF UNLESS ELSE ELSIF CONTINUE SPLIT FLIST
70 %token <ival> FOR FILOP FILOP2 FILOP3 FILOP4 FILOP22 FILOP25
71 %token <ival> FUNC0 FUNC1 FUNC2 FUNC3 HSHFUN HSHFUN3
72 %token <ival> FLIST2 SUB FILETEST LOCAL DELETE
73 %token <ival> RELOP EQOP MULOP ADDOP PACKAGE AMPER LFUNC4
74 %token <formval> FORMLIST
75 %token <stabval> REG ARYLEN ARY HSH STAR
76 %token <arg> SUBST PATTERN
77 %token <arg> RSTRING TRANS
79 %type <ival> prog decl format remember
80 %type <cmdval> block lineseq line loop cond sideff nexpr else
81 %type <arg> expr sexpr cexpr csexpr term handle aryword hshword
82 %type <arg> texpr listop bareword
84 %type <compval> compblock
86 %nonassoc <ival> LISTOP
97 %nonassoc <ival> UNIOP
103 %right '!' '~' UMINUS
112 #if defined(YYDEBUG) && defined(DEBUGGING)
113 yydebug = (debug & 1);
116 /*CONTINUED*/ lineseq
118 eval_root = block_head($2);
120 main_root = block_head($2); }
123 compblock: block CONTINUE block
124 { $$.comp_true = $1; $$.comp_alt = $3; }
126 { $$.comp_true = $1; $$.comp_alt = $2; }
133 | ELSIF '(' expr ')' compblock
135 $$ = make_ccmd(C_ELSIF,$3,$5); }
138 block : '{' remember lineseq '}'
139 { $$ = block_head($3);
140 if (savestack->ary_fill > $2)
144 remember: /* NULL */ /* in case they push a package name */
145 { $$ = savestack->ary_fill; }
151 { $$ = append_line($1,$2); }
157 { $$ = add_label($1,$2); }
158 | loop /* loops add their own labels */
160 { if ($1 != Nullch) {
161 $$ = add_label($1, make_acmd(C_EXPR, Nullstab,
169 { $$ = add_label($1,$2); }
175 { $$ = make_acmd(C_EXPR, Nullstab, $1, Nullarg); }
178 make_acmd(C_EXPR, Nullstab, Nullarg, $1), $3); }
180 { $$ = addcond(invert(
181 make_acmd(C_EXPR, Nullstab, Nullarg, $1)), $3); }
184 make_acmd(C_EXPR, Nullstab, Nullarg, $1), $3); }
186 { $$ = addloop(invert(
187 make_acmd(C_EXPR, Nullstab, Nullarg, $1)), $3); }
190 cond : IF '(' expr ')' compblock
192 $$ = make_icmd(C_IF,$3,$5); }
193 | UNLESS '(' expr ')' compblock
195 $$ = invert(make_icmd(C_IF,$3,$5)); }
198 $$ = make_ccmd(C_IF,cmd_to_arg($2),$3); }
199 | UNLESS block compblock
201 $$ = invert(make_ccmd(C_IF,cmd_to_arg($2),$3)); }
204 loop : label WHILE '(' texpr ')' compblock
206 $$ = wopt(add_label($1,
207 make_ccmd(C_WHILE,$4,$6) )); }
208 | label UNTIL '(' expr ')' compblock
210 $$ = wopt(add_label($1,
211 invert(make_ccmd(C_WHILE,$4,$6)) )); }
212 | label WHILE block compblock
214 $$ = wopt(add_label($1,
215 make_ccmd(C_WHILE, cmd_to_arg($3),$4) )); }
216 | label UNTIL block compblock
218 $$ = wopt(add_label($1,
219 invert(make_ccmd(C_WHILE, cmd_to_arg($3),$4)) )); }
220 | label FOR REG '(' expr ')' compblock
223 * The following gobbledygook catches EXPRs that
224 * aren't explicit array refs and translates
225 * foreach VAR (EXPR) {
228 * foreach VAR (@ary) {
229 * where @ary is a hidden array made by genstab().
230 * (Note that @ary may become a local array if
231 * it is determined that it might be called
232 * recursively. See cmd_tosave().)
234 if ($5->arg_type != O_ARRAY) {
235 scrstab = aadd(genstab());
237 make_acmd(C_EXPR, Nullstab,
238 l(make_op(O_ASSIGN,2,
239 listish(make_op(O_ARRAY, 1,
240 stab2arg(A_STAB,scrstab),
242 listish(make_list($5)),
245 wopt(over($3,add_label($1,
248 stab2arg(A_STAB,scrstab),
252 $$->c_head->c_line = $2;
255 $$ = wopt(over($3,add_label($1,
256 make_ccmd(C_WHILE,$5,$7) )));
259 | label FOR '(' expr ')' compblock
261 if ($4->arg_type != O_ARRAY) {
262 scrstab = aadd(genstab());
264 make_acmd(C_EXPR, Nullstab,
265 l(make_op(O_ASSIGN,2,
266 listish(make_op(O_ARRAY, 1,
267 stab2arg(A_STAB,scrstab),
269 listish(make_list($4)),
272 wopt(over(defstab,add_label($1,
275 stab2arg(A_STAB,scrstab),
279 $$->c_head->c_line = $2;
281 else { /* lisp, anyone? */
282 $$ = wopt(over(defstab,add_label($1,
283 make_ccmd(C_WHILE,$4,$6) )));
286 | label FOR '(' nexpr ';' texpr ';' nexpr ')' block
287 /* basically fake up an initialize-while lineseq */
288 { yyval.compval.comp_true = $10;
289 yyval.compval.comp_alt = $8;
291 $$ = append_line($4,wopt(add_label($1,
292 make_ccmd(C_WHILE,$6,yyval.compval) ))); }
293 | label compblock /* a block is a loop that happens once */
294 { $$ = add_label($1,make_ccmd(C_BLOCK,Nullarg,$2)); }
302 texpr : /* NULL means true */
303 { (void)scanstr("1"); $$ = yylval.arg; }
320 format : FORMAT WORD '=' FORMLIST
321 { if (strEQ($2,"stdout"))
322 make_form(stabent("STDOUT",TRUE),$4);
323 else if (strEQ($2,"stderr"))
324 make_form(stabent("STDERR",TRUE),$4);
326 make_form(stabent($2,TRUE),$4);
328 | FORMAT '=' FORMLIST
329 { make_form(stabent("STDOUT",TRUE),$3); }
332 subrout : SUB WORD block
336 package : PACKAGE WORD ';'
342 str_set(curstname,$2);
343 sprintf(tmpbuf,"'_%s",$2);
344 tmpstab = hadd(stabent(tmpbuf,TRUE));
345 curstash = stab_xhash(tmpstab);
346 curpack = stab_name(tmpstab);
347 curstash->tbl_coeffsize = 0;
356 expr : expr ',' sexpr
357 { $$ = make_op(O_COMMA, 2, $1, $3, Nullarg); }
365 sexpr : sexpr '=' sexpr
367 if ($1->arg_type == O_ASSIGN && $1->arg_len == 1)
368 $1->arg_type = O_ITEM; /* a local() */
369 if ($1->arg_type == O_LIST)
371 $$ = l(make_op(O_ASSIGN, 2, $1, $3, Nullarg)); }
372 | sexpr POW '=' sexpr
373 { $$ = l(make_op(O_POW, 2, $1, $4, Nullarg)); }
374 | sexpr MULOP '=' sexpr
375 { $$ = l(make_op($2, 2, $1, $4, Nullarg)); }
376 | sexpr ADDOP '=' sexpr
377 { $$ = rcatmaybe(l(make_op($2, 2, $1, $4, Nullarg)));}
379 { $$ = l(make_op(O_LEFT_SHIFT, 2, $1, $4, Nullarg)); }
381 { $$ = l(make_op(O_RIGHT_SHIFT, 2, $1, $4, Nullarg)); }
382 | sexpr '&' '=' sexpr
383 { $$ = l(make_op(O_BIT_AND, 2, $1, $4, Nullarg)); }
384 | sexpr '^' '=' sexpr
385 { $$ = l(make_op(O_XOR, 2, $1, $4, Nullarg)); }
386 | sexpr '|' '=' sexpr
387 { $$ = l(make_op(O_BIT_OR, 2, $1, $4, Nullarg)); }
391 { $$ = make_op(O_POW, 2, $1, $3, Nullarg); }
393 { $$ = make_op($2, 2, $1, $3, Nullarg); }
395 { $$ = make_op($2, 2, $1, $3, Nullarg); }
397 { $$ = make_op(O_LEFT_SHIFT, 2, $1, $3, Nullarg); }
399 { $$ = make_op(O_RIGHT_SHIFT, 2, $1, $3, Nullarg); }
401 { $$ = make_op($2, 2, $1, $3, Nullarg); }
403 { $$ = make_op($2, 2, $1, $3, Nullarg); }
405 { $$ = make_op(O_BIT_AND, 2, $1, $3, Nullarg); }
407 { $$ = make_op(O_XOR, 2, $1, $3, Nullarg); }
409 { $$ = make_op(O_BIT_OR, 2, $1, $3, Nullarg); }
412 $$ = make_op(O_F_OR_R, 4, $1, $3, Nullarg); }
414 { $$ = make_op(O_AND, 2, $1, $3, Nullarg); }
416 { $$ = make_op(O_OR, 2, $1, $3, Nullarg); }
417 | sexpr '?' sexpr ':' sexpr
418 { $$ = make_op(O_COND_EXPR, 3, $1, $3, $5); }
420 { $$ = mod_match(O_MATCH, $1, $3); }
422 { $$ = mod_match(O_NMATCH, $1, $3); }
427 term : '-' term %prec UMINUS
428 { $$ = make_op(O_NEGATE, 1, $2, Nullarg, Nullarg); }
429 | '+' term %prec UMINUS
432 { $$ = make_op(O_NOT, 1, $2, Nullarg, Nullarg); }
434 { $$ = make_op(O_COMPLEMENT, 1, $2, Nullarg, Nullarg);}
436 { $$ = addflags(1, AF_POST|AF_UP,
437 l(make_op(O_ITEM,1,$1,Nullarg,Nullarg))); }
439 { $$ = addflags(1, AF_POST,
440 l(make_op(O_ITEM,1,$1,Nullarg,Nullarg))); }
442 { $$ = addflags(1, AF_PRE|AF_UP,
443 l(make_op(O_ITEM,1,$2,Nullarg,Nullarg))); }
445 { $$ = addflags(1, AF_PRE,
446 l(make_op(O_ITEM,1,$2,Nullarg,Nullarg))); }
448 { opargs[$1] = 0; /* force it special */
450 stab2arg(A_STAB,stabent($2,TRUE)),
455 $$ = make_op($1, 1, $2, Nullarg, Nullarg); }
457 { opargs[$1] = ($1 != O_FTTTY);
460 $1 == O_FTTTY?stabent("STDIN",TRUE):defstab),
463 { $$ = l(localize(make_op(O_ASSIGN, 1,
464 localize(listish(make_list($3))),
465 Nullarg,Nullarg))); }
467 { $$ = make_list(hide_ary($2)); }
469 { $$ = make_list(hide_ary($2)); }
471 { $$ = make_list(Nullarg); }
472 | DO sexpr %prec FILETEST
474 make_op(O_DOFILE,2,$2,Nullarg,Nullarg) );
477 { $$ = cmd_to_arg($2); }
479 { $$ = stab2arg(A_STAB,$1); }
481 { $$ = stab2arg(A_STAR,$1); }
482 | REG '[' expr ']' %prec '('
483 { $$ = make_op(O_AELEM, 2,
484 stab2arg(A_STAB,aadd($1)), $3, Nullarg); }
486 { $$ = make_op(O_HASH, 1,
490 { $$ = make_op(O_ARRAY, 1,
493 | REG '{' expr '}' %prec '('
494 { $$ = make_op(O_HELEM, 2,
495 stab2arg(A_STAB,hadd($1)),
498 | '(' expr ')' '[' expr ']' %prec '('
499 { $$ = make_op(O_LSLICE, 3,
501 listish(make_list($5)),
502 listish(make_list($2))); }
503 | ARY '[' expr ']' %prec '('
504 { $$ = make_op(O_ASLICE, 2,
505 stab2arg(A_STAB,aadd($1)),
506 listish(make_list($3)),
508 | ARY '{' expr '}' %prec '('
509 { $$ = make_op(O_HSLICE, 2,
510 stab2arg(A_STAB,hadd($1)),
511 listish(make_list($3)),
513 | DELETE REG '{' expr '}' %prec '('
514 { $$ = make_op(O_DELETE, 2,
515 stab2arg(A_STAB,hadd($2)),
519 { $$ = stab2arg(A_ARYLEN,$1); }
528 | DO WORD '(' expr ')'
529 { $$ = make_op((perldb ? O_DBSUBR : O_SUBR), 2,
530 stab2arg(A_WORD,stabent($2,TRUE)),
532 Nullarg); Safefree($2); }
533 | AMPER WORD '(' expr ')'
534 { $$ = make_op((perldb ? O_DBSUBR : O_SUBR), 2,
535 stab2arg(A_WORD,stabent($2,TRUE)),
537 Nullarg); Safefree($2); }
539 { $$ = make_op((perldb ? O_DBSUBR : O_SUBR), 2,
540 stab2arg(A_WORD,stabent($2,TRUE)),
544 { $$ = make_op((perldb ? O_DBSUBR : O_SUBR), 2,
545 stab2arg(A_WORD,stabent($2,TRUE)),
549 { $$ = make_op((perldb ? O_DBSUBR : O_SUBR), 2,
550 stab2arg(A_WORD,stabent($2,TRUE)),
553 | DO REG '(' expr ')'
554 { $$ = make_op((perldb ? O_DBSUBR : O_SUBR), 2,
558 | AMPER REG '(' expr ')'
559 { $$ = make_op((perldb ? O_DBSUBR : O_SUBR), 2,
564 { $$ = make_op((perldb ? O_DBSUBR : O_SUBR), 2,
569 { $$ = make_op((perldb ? O_DBSUBR : O_SUBR), 2,
574 { $$ = make_op((perldb ? O_DBSUBR : O_SUBR), 2,
579 { $$ = make_op($1,0,Nullarg,Nullarg,Nullarg); }
581 { $$ = make_op($1,1,cval_to_arg($2),
584 { $$ = make_op($1,0,Nullarg,Nullarg,Nullarg);
585 if ($1 == O_EVAL || $1 == O_RESET || $1 == O_REQUIRE)
588 { $$ = make_op($1,1,$2,Nullarg,Nullarg);
589 if ($1 == O_EVAL || $1 == O_RESET || $1 == O_REQUIRE)
592 { $$ = make_op(O_SELECT, 0, Nullarg, Nullarg, Nullarg);}
593 | SSELECT '(' handle ')'
594 { $$ = make_op(O_SELECT, 1, $3, Nullarg, Nullarg); }
595 | SSELECT '(' sexpr csexpr csexpr csexpr ')'
597 $$ = make_op(O_SSELECT, 4, $3, $4, $5); }
598 | OPEN WORD %prec '('
599 { $$ = make_op(O_OPEN, 2,
600 stab2arg(A_WORD,stabent($2,TRUE)),
601 stab2arg(A_STAB,stabent($2,TRUE)),
604 { $$ = make_op(O_OPEN, 2,
605 stab2arg(A_WORD,stabent($3,TRUE)),
606 stab2arg(A_STAB,stabent($3,TRUE)),
608 | OPEN '(' handle cexpr ')'
609 { $$ = make_op(O_OPEN, 2,
612 | FILOP '(' handle ')'
613 { $$ = make_op($1, 1,
617 { $$ = make_op($1, 1,
618 stab2arg(A_WORD,stabent($2,TRUE)),
622 { $$ = make_op($1, 1,
626 { $$ = make_op($1, 1,
627 stab2arg(A_WORD,Nullstab),
630 { $$ = make_op($1, 0,
631 Nullarg, Nullarg, Nullarg); }
632 | FILOP2 '(' handle cexpr ')'
633 { $$ = make_op($1, 2, $3, $4, Nullarg); }
634 | FILOP3 '(' handle csexpr cexpr ')'
635 { $$ = make_op($1, 3, $3, $4, make_list($5)); }
636 | FILOP22 '(' handle ',' handle ')'
637 { $$ = make_op($1, 2, $3, $5, Nullarg); }
638 | FILOP4 '(' handle csexpr csexpr cexpr ')'
639 { arg4 = $6; $$ = make_op($1, 4, $3, $4, $5); }
640 | FILOP25 '(' handle ',' handle csexpr csexpr cexpr ')'
641 { arg4 = $7; arg5 = $8;
642 $$ = make_op($1, 5, $3, $5, $6); }
643 | PUSH '(' aryword cexpr ')'
644 { $$ = make_op($1, 2,
648 | POP aryword %prec '('
649 { $$ = make_op(O_POP, 1, $2, Nullarg, Nullarg); }
650 | POP '(' aryword ')'
651 { $$ = make_op(O_POP, 1, $3, Nullarg, Nullarg); }
652 | SHIFT aryword %prec '('
653 { $$ = make_op(O_SHIFT, 1, $2, Nullarg, Nullarg); }
654 | SHIFT '(' aryword ')'
655 { $$ = make_op(O_SHIFT, 1, $3, Nullarg, Nullarg); }
657 { $$ = make_op(O_SHIFT, 1,
659 aadd(stabent(subline ? "_" : "ARGV", TRUE))),
662 {static char p[]="/\\s+/";char*o=bufend;bufend=p+5;(void)scanpat(p);bufend=o;
663 $$ = make_split(defstab,yylval.arg,Nullarg); }
664 | SPLIT '(' sexpr csexpr csexpr ')'
665 { $$ = mod_match(O_MATCH, $4,
666 make_split(defstab,$3,$5));}
667 | SPLIT '(' sexpr csexpr ')'
668 { $$ = mod_match(O_MATCH, $4,
669 make_split(defstab,$3,Nullarg) ); }
670 | SPLIT '(' sexpr ')'
671 { $$ = mod_match(O_MATCH,
672 stab2arg(A_STAB,defstab),
673 make_split(defstab,$3,Nullarg) ); }
674 | FLIST2 '(' sexpr cexpr ')'
675 { $$ = make_op($1, 2,
677 listish(make_list($4)),
680 { $$ = make_op($1, 1,
684 | LVALFUN sexpr %prec '('
685 { $$ = l(make_op($1, 1, fixl($1,$2),
686 Nullarg, Nullarg)); }
688 { $$ = l(make_op($1, 1,
689 stab2arg(A_STAB,defstab),
690 Nullarg, Nullarg)); }
692 { $$ = make_op($1, 0, Nullarg, Nullarg, Nullarg); }
694 { $$ = make_op($1, 0, Nullarg, Nullarg, Nullarg); }
696 { $$ = make_op($1, 0, Nullarg, Nullarg, Nullarg);
697 if ($1 == O_EVAL || $1 == O_RESET || $1 == O_REQUIRE)
700 { $$ = make_op($1, 1, $3, Nullarg, Nullarg);
701 if ($1 == O_EVAL || $1 == O_RESET || $1 == O_REQUIRE)
703 | FUNC2 '(' sexpr cexpr ')'
704 { $$ = make_op($1, 2, $3, $4, Nullarg);
705 if ($1 == O_INDEX && $$[2].arg_type == A_SINGLE)
706 fbmcompile($$[2].arg_ptr.arg_str,0); }
707 | FUNC3 '(' sexpr csexpr cexpr ')'
708 { $$ = make_op($1, 3, $3, $4, $5); }
709 | LFUNC4 '(' sexpr csexpr csexpr cexpr ')'
710 { arg4 = $6; $$ = make_op($1, 4, l($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); }
750 maybelistish($1,make_list($3)),
755 { $$ = stab2arg(A_WORD,stabent($1,TRUE)); Safefree($1);}
760 { $$ = stab2arg(A_WORD,aadd(stabent($1,TRUE)));
763 { $$ = stab2arg(A_STAB,$1); }
767 { $$ = stab2arg(A_WORD,hadd(stabent($1,TRUE)));
770 { $$ = stab2arg(A_STAB,$1); }
774 * NOTE: The following entry must stay at the end of the file so that
775 * reduce/reduce conflicts resolve to it only if it's the only option.
781 $$->arg_type = O_ITEM;
782 $$[1].arg_type = A_SINGLE;
783 $$[1].arg_ptr.arg_str = str_make($1,0);
789 warn("\"%s\" may clash with future reserved word", $1);