perl 5.0 alpha 2
[p5sagit/p5-mst-13.2.git] / perly.y
1 /* $RCSfile: perly.y,v $$Revision: 4.1 $$Date: 92/08/07 18:26:16 $
2  *
3  *    Copyright (c) 1991, Larry Wall
4  *
5  *    You may distribute under the terms of either the GNU General Public
6  *    License or the Artistic License, as specified in the README file.
7  *
8  * $Log:        perly.y,v $
9  * Revision 4.1  92/08/07  18:26:16  lwall
10  * 
11  * Revision 4.0.1.5  92/06/11  21:12:50  lwall
12  * patch34: expectterm incorrectly set to indicate start of program or block
13  * 
14  * Revision 4.0.1.4  92/06/08  17:33:25  lwall
15  * patch20: one of the backdoors to expectterm was on the wrong reduction
16  * 
17  * Revision 4.0.1.3  92/06/08  15:18:16  lwall
18  * patch20: an expression may now start with a bareword
19  * patch20: relaxed requirement for semicolon at the end of a block
20  * patch20: added ... as variant on ..
21  * patch20: fixed double debug break in foreach with implicit array assignment
22  * patch20: if {block} {block} didn't work any more
23  * patch20: deleted some minor memory leaks
24  * 
25  * Revision 4.0.1.2  91/11/05  18:17:38  lwall
26  * patch11: extra comma at end of list is now allowed in more places (Hi, Felix!)
27  * patch11: once-thru blocks didn't display right in the debugger
28  * patch11: debugger got confused over nested subroutine definitions
29  * 
30  * Revision 4.0.1.1  91/06/07  11:42:34  lwall
31  * patch4: new copyright notice
32  * 
33  * Revision 4.0  91/03/20  01:38:40  lwall
34  * 4.0 baseline.
35  * 
36  */
37
38 %{
39 #include "EXTERN.h"
40 #include "perl.h"
41
42 /*SUPPRESS 530*/
43 /*SUPPRESS 593*/
44 /*SUPPRESS 595*/
45
46 %}
47
48 %start prog
49
50 %union {
51     I32 ival;
52     char *pval;
53     OP *opval;
54     GV *gvval;
55 }
56
57 %token <ival> '{' ')'
58
59 %token <opval> WORD METHOD THING PMFUNC
60 %token <pval> LABEL
61 %token <ival> FORMAT SUB PACKAGE
62 %token <ival> WHILE UNTIL IF UNLESS ELSE ELSIF CONTINUE FOR
63 %token <ival> LOOPEX DOTDOT
64 %token <ival> FUNC0 FUNC1 FUNC
65 %token <ival> RELOP EQOP MULOP ADDOP
66 %token <ival> DOLSHARP DO LOCAL DELETE HASHBRACK
67
68 %type <ival> prog decl format remember crp crb crhb
69 %type <opval> block lineseq line loop cond nexpr else
70 %type <opval> expr sexpr term scalar ary hsh arylen star amper sideff
71 %type <opval> listexpr indirob
72 %type <opval> texpr listop
73 %type <pval> label
74 %type <opval> cont
75
76 %nonassoc <ival> LSTOP
77 %left ','
78 %right '='
79 %right '?' ':'
80 %nonassoc DOTDOT
81 %left OROR
82 %left ANDAND
83 %left <ival> BITOROP
84 %left <ival> BITANDOP
85 %nonassoc EQOP
86 %nonassoc RELOP
87 %nonassoc <ival> UNIOP
88 %left <ival> SHIFTOP
89 %left ADDOP
90 %left MULOP
91 %left <ival> MATCHOP ARROW
92 %right '!' '~' UMINUS REFGEN
93 %right <ival> POWOP
94 %nonassoc PREINC PREDEC POSTINC POSTDEC
95 %left '('
96
97 %% /* RULES */
98
99 prog    :       /* NULL */
100                 {
101 #if defined(YYDEBUG) && defined(DEBUGGING)
102                     yydebug = (debug & 1);
103 #endif
104                     expect = XBLOCK;
105                 }
106         /*CONTINUED*/   lineseq
107                         {   if (in_eval) {
108                                 eval_root = newUNOP(OP_LEAVEEVAL, 0, $2);
109                                 eval_start = linklist(eval_root);
110                                 eval_root->op_next = 0;
111                                 peep(eval_start);
112                             }
113                             else
114                                 main_root = block_head(scalar($2), &main_start);
115                         }
116         ;
117
118 block   :       '{' remember lineseq '}'
119                         { $$ = scalarseq($3);
120                           if (copline > (line_t)$1)
121                               copline = $1;
122                           if (savestack_ix > $2)
123                             leave_scope($2);
124                           expect = XBLOCK; }
125         ;
126
127 remember:       /* NULL */      /* in case they push a package name */
128                         { $$ = savestack_ix; }
129         ;
130
131 lineseq :       /* NULL */
132                         { $$ = Nullop; }
133         |       lineseq decl
134                         { $$ = $1; }
135         |       lineseq line
136                         { $$ = append_list(OP_LINESEQ, $1, $2); pad_reset(); }
137         ;
138
139 line    :       label cond
140                         { $$ = newSTATEOP(0, $1, $2); }
141         |       loop    /* loops add their own labels */
142         |       label ';'
143                         { if ($1 != Nullch) {
144                               $$ = newSTATEOP(0, $1, newOP(OP_NULL, 0));
145                             }
146                             else {
147                               $$ = Nullop;
148                               copline = NOLINE;
149                             }
150                             expect = XBLOCK; }
151         |       label sideff ';'
152                         { $$ = newSTATEOP(0, $1, $2);
153                           expect = XBLOCK; }
154         ;
155
156 sideff  :       error
157                         { $$ = Nullop; }
158         |       expr
159                         { $$ = $1; }
160         |       expr IF expr
161                         { $$ = newLOGOP(OP_AND, 0, $3, $1); }
162         |       expr UNLESS expr
163                         { $$ = newLOGOP(OP_OR, 0, $3, $1); }
164         |       expr WHILE expr
165                         { $$ = newLOOPOP(0, 1, scalar($3), $1, Nullop); }
166         |       expr UNTIL expr
167                         { $$ = newLOOPOP(0, 1, invert(scalar($3)), $1, Nullop);}
168         ;
169
170 else    :       /* NULL */
171                         { $$ = Nullop; }
172         |       ELSE block
173                         { $$ = scope($2); }
174         |       ELSIF '(' expr ')' block else
175                         { copline = $1;
176                             $$ = newCONDOP(0, $3, scope($5), $6); }
177         ;
178
179 cond    :       IF '(' expr ')' block else
180                         { copline = $1;
181                             $$ = newCONDOP(0, $3, scope($5), $6); }
182         |       UNLESS '(' expr ')' block else
183                         { copline = $1;
184                             $$ = newCONDOP(0,
185                                 invert(scalar($3)), scope($5), $6); }
186         |       IF block block else
187                         { copline = $1;
188                             $$ = newCONDOP(0, scope($2), scope($3), $4); }
189         |       UNLESS block block else
190                         { copline = $1;
191                             $$ = newCONDOP(0, invert(scalar(scope($2))),
192                                                 scope($3), $4); }
193         ;
194
195 cont    :       /* NULL */
196                         { $$ = Nullop; }
197         |       CONTINUE block
198                         { $$ = scope($2); }
199         ;
200
201 loop    :       label WHILE '(' texpr ')' block cont
202                         { copline = $2;
203                             $$ = newSTATEOP(0, $1,
204                                     newWHILEOP(0, 1, Nullop, $4, $6, $7) ); }
205         |       label UNTIL '(' expr ')' block cont
206                         { copline = $2;
207                             $$ = newSTATEOP(0, $1,
208                                     newWHILEOP(0, 1, Nullop,
209                                         invert(scalar($4)), $6, $7) ); }
210         |       label WHILE block block cont
211                         { copline = $2;
212                             $$ = newSTATEOP(0, $1,
213                                     newWHILEOP(0, 1, Nullop,
214                                         scope($3), $4, $5) ); }
215         |       label UNTIL block block cont
216                         { copline = $2;
217                             $$ = newSTATEOP(0, $1,
218                                     newWHILEOP(0, 1, Nullop,
219                                         invert(scalar(scope($3))), $4, $5)); }
220         |       label FOR scalar '(' expr crp block cont
221                         { $$ = newFOROP(0, $1, $2, ref($3, OP_ENTERLOOP),
222                                 $5, $7, $8); }
223         |       label FOR '(' expr crp block cont
224                         { $$ = newFOROP(0, $1, $2, Nullop, $4, $6, $7); }
225         |       label FOR '(' nexpr ';' texpr ';' nexpr ')' block
226                         /* basically fake up an initialize-while lineseq */
227                         {  copline = $2;
228                             $$ = append_elem(OP_LINESEQ,
229                                     newSTATEOP(0, $1, scalar($4)),
230                                     newSTATEOP(0, $1,
231                                         newWHILEOP(0, 1, Nullop,
232                                             scalar($6), $10, scalar($8)) )); }
233         |       label block cont  /* a block is a loop that happens once */
234                         { $$ = newSTATEOP(0,
235                                 $1, newWHILEOP(0, 1, Nullop, Nullop, $2, $3)); }
236         ;
237
238 nexpr   :       /* NULL */
239                         { $$ = Nullop; }
240         |       sideff
241         ;
242
243 texpr   :       /* NULL means true */
244                         { (void)scan_num("1"); $$ = yylval.opval; }
245         |       expr
246         ;
247
248 label   :       /* empty */
249                         { $$ = Nullch; }
250         |       LABEL
251         ;
252
253 decl    :       format
254                         { $$ = 0; }
255         |       subrout
256                         { $$ = 0; }
257         |       package
258                         { $$ = 0; }
259         ;
260
261 format  :       FORMAT WORD block
262                         { newFORM($1, $2, $3); }
263         |       FORMAT block
264                         { newFORM($1, Nullop, $2); }
265         ;
266
267 subrout :       SUB WORD block
268                         { newSUB($1, $2, $3); }
269         ;
270
271 package :       PACKAGE WORD ';'
272                         { package($2); }
273         ;
274
275 expr    :       expr ',' sexpr
276                         { $$ = append_elem(OP_LIST, $1, $3); }
277         |       sexpr
278         ;
279
280 listop  :       LSTOP indirob listexpr
281                         { $$ = convert($1, OPf_STACKED,
282                                 prepend_elem(OP_LIST, newGVREF($2), $3) ); }
283         |       FUNC '(' indirob listexpr ')'
284                         { $$ = convert($1, OPf_STACKED,
285                                 prepend_elem(OP_LIST, newGVREF($3), $4) ); }
286         |       indirob ARROW LSTOP listexpr
287                         { $$ = convert($3, OPf_STACKED,
288                                 prepend_elem(OP_LIST, newGVREF($1), $4) ); }
289         |       indirob ARROW FUNC '(' listexpr ')'
290                         { $$ = convert($3, OPf_STACKED,
291                                 prepend_elem(OP_LIST, newGVREF($1), $5) ); }
292         |       term ARROW METHOD '(' listexpr ')'
293                         { $$ = convert(OP_ENTERSUBR, OPf_STACKED|OPf_SPECIAL,
294                                 prepend_elem(OP_LIST, newMETHOD($1,$3), $5)); }
295         |       METHOD indirob listexpr
296                         { $$ = convert(OP_ENTERSUBR, OPf_STACKED|OPf_SPECIAL,
297                                 prepend_elem(OP_LIST, newMETHOD($2,$1), $3)); }
298         |       LSTOP listexpr
299                         { $$ = convert($1, 0, $2); }
300         |       FUNC '(' listexpr ')'
301                         { $$ = convert($1, 0, $3); }
302         ;
303
304 sexpr   :       sexpr '=' sexpr
305                         { $$ = newASSIGNOP(OPf_STACKED, $1, $3); }
306         |       sexpr POWOP '=' sexpr
307                         { $$ = newBINOP($2, OPf_STACKED,
308                                 ref(scalar($1), $2), scalar($4)); }
309         |       sexpr MULOP '=' sexpr
310                         { $$ = newBINOP($2, OPf_STACKED,
311                                 ref(scalar($1), $2), scalar($4)); }
312         |       sexpr ADDOP '=' sexpr
313                         { $$ = newBINOP($2, OPf_STACKED,
314                                 ref(scalar($1), $2), scalar($4));}
315         |       sexpr SHIFTOP '=' sexpr
316                         { $$ = newBINOP($2, OPf_STACKED,
317                                 ref(scalar($1), $2), scalar($4)); }
318         |       sexpr BITANDOP '=' sexpr
319                         { $$ = newBINOP($2, OPf_STACKED,
320                                 ref(scalar($1), $2), scalar($4)); }
321         |       sexpr BITOROP '=' sexpr
322                         { $$ = newBINOP($2, OPf_STACKED,
323                                 ref(scalar($1), $2), scalar($4)); }
324         |       sexpr ANDAND '=' sexpr
325                         { $$ = newLOGOP(OP_ANDASSIGN, 0,
326                                 ref(scalar($1), OP_ANDASSIGN),
327                                 newUNOP(OP_SASSIGN, 0, scalar($4))); }
328         |       sexpr OROR '=' sexpr
329                         { $$ = newLOGOP(OP_ORASSIGN, 0,
330                                 ref(scalar($1), OP_ORASSIGN),
331                                 newUNOP(OP_SASSIGN, 0, scalar($4))); }
332
333
334         |       sexpr POWOP sexpr
335                         { $$ = newBINOP($2, 0, scalar($1), scalar($3)); }
336         |       sexpr MULOP sexpr
337                         {   if ($2 != OP_REPEAT)
338                                 scalar($1);
339                             $$ = newBINOP($2, 0, $1, scalar($3)); }
340         |       sexpr ADDOP sexpr
341                         { $$ = newBINOP($2, 0, scalar($1), scalar($3)); }
342         |       sexpr SHIFTOP sexpr
343                         { $$ = newBINOP($2, 0, scalar($1), scalar($3)); }
344         |       sexpr RELOP sexpr
345                         { $$ = newBINOP($2, 0, scalar($1), scalar($3)); }
346         |       sexpr EQOP sexpr
347                         { $$ = newBINOP($2, 0, scalar($1), scalar($3)); }
348         |       sexpr BITANDOP sexpr
349                         { $$ = newBINOP($2, 0, scalar($1), scalar($3)); }
350         |       sexpr BITOROP sexpr
351                         { $$ = newBINOP($2, 0, scalar($1), scalar($3)); }
352         |       sexpr DOTDOT sexpr
353                         { $$ = newRANGE($2, scalar($1), scalar($3));}
354         |       sexpr ANDAND sexpr
355                         { $$ = newLOGOP(OP_AND, 0, $1, $3); }
356         |       sexpr OROR sexpr
357                         { $$ = newLOGOP(OP_OR, 0, $1, $3); }
358         |       sexpr '?' sexpr ':' sexpr
359                         { $$ = newCONDOP(0, $1, $3, $5); }
360         |       sexpr MATCHOP sexpr
361                         { $$ = bind_match($2, $1, $3); }
362         |       term
363                         { $$ = $1; }
364         ;
365
366 term    :       '-' term %prec UMINUS
367                         { $$ = newUNOP(OP_NEGATE, 0, scalar($2)); }
368         |       '+' term %prec UMINUS
369                         { $$ = $2; }
370         |       '!' term
371                         { $$ = newUNOP(OP_NOT, 0, scalar($2)); }
372         |       '~' term
373                         { $$ = newUNOP(OP_COMPLEMENT, 0, scalar($2));}
374         |       REFGEN term
375                         { $$ = newUNOP(OP_REFGEN, 0, ref($2, OP_REFGEN)); }
376         |       term POSTINC
377                         { $$ = newUNOP(OP_POSTINC, 0,
378                                         ref(scalar($1), OP_POSTINC)); }
379         |       term POSTDEC
380                         { $$ = newUNOP(OP_POSTDEC, 0,
381                                         ref(scalar($1), OP_POSTDEC)); }
382         |       PREINC term
383                         { $$ = newUNOP(OP_PREINC, 0,
384                                         ref(scalar($2), OP_PREINC)); }
385         |       PREDEC term
386                         { $$ = newUNOP(OP_PREDEC, 0,
387                                         ref(scalar($2), OP_PREDEC)); }
388         |       LOCAL sexpr     %prec UNIOP
389                         { $$ = localize($2); }
390         |       '(' expr crp
391                         { $$ = sawparens($2); }
392         |       '(' ')'
393                         { $$ = newNULLLIST(); }
394         |       '[' expr crb                            %prec '('
395                         { $$ = newANONLIST($2); }
396         |       '[' ']'                                 %prec '('
397                         { $$ = newANONLIST(Nullop); }
398         |       HASHBRACK expr crhb                     %prec '('
399                         { $$ = newANONHASH($2); }
400         |       HASHBRACK ';' '}'                               %prec '('
401                         { $$ = newANONHASH(Nullop); }
402         |       scalar  %prec '('
403                         { $$ = $1; }
404         |       star    %prec '('
405                         { $$ = $1; }
406         |       scalar '[' expr ']'     %prec '('
407                         { $$ = newBINOP(OP_AELEM, 0, oopsAV($1), scalar($3)); }
408         |       term ARROW '[' expr ']' %prec '('
409                         { $$ = newBINOP(OP_AELEM, 0,
410                                         scalar(ref(newAVREF($1),OP_RV2AV)),
411                                         scalar($4));}
412         |       hsh     %prec '('
413                         { $$ = $1; }
414         |       ary     %prec '('
415                         { $$ = $1; }
416         |       arylen  %prec '('
417                         { $$ = newUNOP(OP_AV2ARYLEN, 0, ref($1, OP_AV2ARYLEN));}
418         |       scalar '{' expr ';' '}' %prec '('
419                         { $$ = newBINOP(OP_HELEM, 0, oopsHV($1), jmaybe($3));
420                             expect = XOPERATOR; }
421         |       term ARROW '{' expr ';' '}'     %prec '('
422                         { $$ = newBINOP(OP_HELEM, 0,
423                                         scalar(ref(newHVREF($1),OP_RV2HV)),
424                                         jmaybe($4));
425                             expect = XOPERATOR; }
426         |       '(' expr crp '[' expr ']'       %prec '('
427                         { $$ = newSLICEOP(0, $5, $2); }
428         |       '(' ')' '[' expr ']'    %prec '('
429                         { $$ = newSLICEOP(0, $4, Nullop); }
430         |       ary '[' expr ']'        %prec '('
431                         { $$ = prepend_elem(OP_ASLICE,
432                                 newOP(OP_PUSHMARK, 0),
433                                 list(
434                                     newLISTOP(OP_ASLICE, 0,
435                                         list($3),
436                                         ref($1, OP_ASLICE)))); }
437         |       ary '{' expr ';' '}'    %prec '('
438                         { $$ = prepend_elem(OP_HSLICE,
439                                 newOP(OP_PUSHMARK, 0),
440                                 list(
441                                     newLISTOP(OP_HSLICE, 0,
442                                         list($3),
443                                         ref(oopsHV($1), OP_HSLICE))));
444                             expect = XOPERATOR; }
445         |       DELETE scalar '{' expr ';' '}'  %prec '('
446                         { $$ = newBINOP(OP_DELETE, 0, oopsHV($2), jmaybe($4));
447                             expect = XOPERATOR; }
448         |       DELETE '(' scalar '{' expr ';' '}' ')'  %prec '('
449                         { $$ = newBINOP(OP_DELETE, 0, oopsHV($3), jmaybe($5));
450                             expect = XOPERATOR; }
451         |       THING   %prec '('
452                         { $$ = $1; }
453         |       amper
454                         { $$ = newUNOP(OP_ENTERSUBR, 0,
455                                 scalar($1)); }
456         |       amper '(' ')'
457                         { $$ = newUNOP(OP_ENTERSUBR, OPf_STACKED, scalar($1)); }
458         |       amper '(' expr crp
459                         { $$ = newUNOP(OP_ENTERSUBR, OPf_STACKED,
460                             list(prepend_elem(OP_LIST, scalar($1), $3))); }
461         |       DO sexpr        %prec UNIOP
462                         { $$ = newUNOP(OP_DOFILE, 0, scalar($2));
463                           allgvs = TRUE;}
464         |       DO block        %prec '('
465                         { $$ = newUNOP(OP_NULL, OPf_SPECIAL, scope($2)); }
466         |       DO WORD '(' ')'
467                         { $$ = newUNOP(OP_ENTERSUBR, OPf_SPECIAL|OPf_STACKED,
468                             list(prepend_elem(OP_LIST,
469                                 scalar(newCVREF(scalar($2))), newNULLLIST()))); }
470         |       DO WORD '(' expr crp
471                         { $$ = newUNOP(OP_ENTERSUBR, OPf_SPECIAL|OPf_STACKED,
472                             list(prepend_elem(OP_LIST,
473                                 scalar(newCVREF(scalar($2))),
474                                 $4))); }
475         |       DO scalar '(' ')'
476                         { $$ = newUNOP(OP_ENTERSUBR, OPf_SPECIAL|OPf_STACKED,
477                             list(prepend_elem(OP_LIST,
478                                 scalar(newCVREF(scalar($2))), newNULLLIST())));}
479         |       DO scalar '(' expr crp
480                         { $$ = newUNOP(OP_ENTERSUBR, OPf_SPECIAL|OPf_STACKED,
481                             list(prepend_elem(OP_LIST,
482                                 scalar(newCVREF(scalar($2))),
483                                 $4))); }
484         |       LOOPEX
485                         { $$ = newOP($1, OPf_SPECIAL); }
486         |       LOOPEX WORD
487                         { $$ = newPVOP($1, 0,
488                                 savestr(SvPVnx(((SVOP*)$2)->op_sv)));
489                             op_free($2); }
490         |       UNIOP
491                         { $$ = newOP($1, 0); }
492         |       UNIOP block
493                         { $$ = newUNOP($1, 0, $2); }
494         |       UNIOP sexpr
495                         { $$ = newUNOP($1, 0, $2); }
496         |       FUNC0
497                         { $$ = newOP($1, 0); }
498         |       FUNC0 '(' ')'
499                         { $$ = newOP($1, 0); }
500         |       FUNC1 '(' ')'
501                         { $$ = newOP($1, OPf_SPECIAL); }
502         |       FUNC1 '(' expr ')'
503                         { $$ = newUNOP($1, 0, $3); }
504         |       PMFUNC '(' sexpr ')'
505                         { $$ = pmruntime($1, $3, Nullop); }
506         |       PMFUNC '(' sexpr ',' sexpr ')'
507                         { $$ = pmruntime($1, $3, $5); }
508         |       WORD
509         |       listop
510         ;
511
512 listexpr:       /* NULL */
513                         { $$ = newNULLLIST(); }
514         |       expr
515                         { $$ = $1; }
516         ;
517
518 amper   :       '&' indirob
519                         { $$ = newCVREF($2); }
520         ;
521
522 scalar  :       '$' indirob
523                         { $$ = newSVREF($2); }
524         ;
525
526 ary     :       '@' indirob
527                         { $$ = newAVREF($2); }
528         ;
529
530 hsh     :       '%' indirob
531                         { $$ = newHVREF($2); }
532         ;
533
534 arylen  :       DOLSHARP indirob
535                         { $$ = newAVREF($2); }
536         ;
537
538 star    :       '*' indirob
539                         { $$ = newGVREF($2); }
540         ;
541
542 indirob :       WORD
543                         { $$ = scalar($1); }
544         |       scalar
545                         { $$ = scalar($1); }
546         |       block
547                         { $$ = scalar(scope($1)); }
548
549         ;
550
551 crp     :       ',' ')'
552                         { $$ = 1; }
553         |       ')'
554                         { $$ = 0; }
555         ;
556
557 crb     :       ',' ']'
558                         { $$ = 1; }
559         |       ']'
560                         { $$ = 0; }
561         ;
562
563 crhb    :       ',' ';' '}'
564                         { $$ = 1; }
565         |       ';' '}'
566                         { $$ = 0; }
567         ;
568
569 %% /* PROGRAM */