perl 5.0 alpha 3
[perl.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 PRIVATEREF
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 NOAMP
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($2, &main_start);
115                         }
116         ;
117
118 block   :       '{' remember lineseq '}'
119                         { $$ = scalarseq($3);
120                           if (copline > (line_t)$1)
121                               copline = $1;
122                           leave_scope($2);
123                           pad_leavemy(comppadnamefill);
124                           expect = XBLOCK; }
125         ;
126
127 remember:       /* NULL */      /* in case they push a package name */
128                         { $$ = savestack_ix; SAVEINT(comppadnamefill); }
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); }
166         |       expr UNTIL expr
167                         { $$ = newLOOPOP(0, 1, invert(scalar($3)), $1);}
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         |       SUB WORD ';'
270                         { newSUB($1, $2, Nullop); }
271         ;
272
273 package :       PACKAGE WORD ';'
274                         { package($2); }
275         |       PACKAGE ';'
276                         { package(Nullop); }
277         ;
278
279 expr    :       expr ',' sexpr
280                         { $$ = append_elem(OP_LIST, $1, $3); }
281         |       sexpr
282         ;
283
284 listop  :       LSTOP indirob listexpr
285                         { $$ = convert($1, OPf_STACKED,
286                                 prepend_elem(OP_LIST, newGVREF($2), $3) ); }
287         |       FUNC '(' indirob listexpr ')'
288                         { $$ = convert($1, OPf_STACKED,
289                                 prepend_elem(OP_LIST, newGVREF($3), $4) ); }
290         |       indirob ARROW LSTOP listexpr
291                         { $$ = convert($3, OPf_STACKED,
292                                 prepend_elem(OP_LIST, newGVREF($1), $4) ); }
293         |       indirob ARROW FUNC '(' listexpr ')'
294                         { $$ = convert($3, OPf_STACKED,
295                                 prepend_elem(OP_LIST, newGVREF($1), $5) ); }
296         |       term ARROW METHOD '(' listexpr ')'
297                         { $$ = convert(OP_ENTERSUBR, OPf_STACKED|OPf_SPECIAL,
298                                 prepend_elem(OP_LIST, newMETHOD($1,$3), $5)); }
299         |       METHOD indirob listexpr
300                         { $$ = convert(OP_ENTERSUBR, OPf_STACKED|OPf_SPECIAL,
301                                 prepend_elem(OP_LIST, newMETHOD($2,$1), $3)); }
302         |       LSTOP listexpr
303                         { $$ = convert($1, 0, $2); }
304         |       FUNC '(' listexpr ')'
305                         { $$ = convert($1, 0, $3); }
306         ;
307
308 sexpr   :       sexpr '=' sexpr
309                         { $$ = newASSIGNOP(OPf_STACKED, $1, $3); }
310         |       sexpr POWOP '=' sexpr
311                         { $$ = newBINOP($2, OPf_STACKED,
312                                 ref(scalar($1), $2), scalar($4)); }
313         |       sexpr MULOP '=' sexpr
314                         { $$ = newBINOP($2, OPf_STACKED,
315                                 ref(scalar($1), $2), scalar($4)); }
316         |       sexpr ADDOP '=' sexpr
317                         { $$ = newBINOP($2, OPf_STACKED,
318                                 ref(scalar($1), $2), scalar($4));}
319         |       sexpr SHIFTOP '=' sexpr
320                         { $$ = newBINOP($2, OPf_STACKED,
321                                 ref(scalar($1), $2), scalar($4)); }
322         |       sexpr BITANDOP '=' sexpr
323                         { $$ = newBINOP($2, OPf_STACKED,
324                                 ref(scalar($1), $2), scalar($4)); }
325         |       sexpr BITOROP '=' sexpr
326                         { $$ = newBINOP($2, OPf_STACKED,
327                                 ref(scalar($1), $2), scalar($4)); }
328         |       sexpr ANDAND '=' sexpr
329                         { $$ = newLOGOP(OP_ANDASSIGN, 0,
330                                 ref(scalar($1), OP_ANDASSIGN),
331                                 newUNOP(OP_SASSIGN, 0, scalar($4))); }
332         |       sexpr OROR '=' sexpr
333                         { $$ = newLOGOP(OP_ORASSIGN, 0,
334                                 ref(scalar($1), OP_ORASSIGN),
335                                 newUNOP(OP_SASSIGN, 0, scalar($4))); }
336
337
338         |       sexpr POWOP sexpr
339                         { $$ = newBINOP($2, 0, scalar($1), scalar($3)); }
340         |       sexpr MULOP sexpr
341                         {   if ($2 != OP_REPEAT)
342                                 scalar($1);
343                             $$ = newBINOP($2, 0, $1, scalar($3)); }
344         |       sexpr ADDOP sexpr
345                         { $$ = newBINOP($2, 0, scalar($1), scalar($3)); }
346         |       sexpr SHIFTOP sexpr
347                         { $$ = newBINOP($2, 0, scalar($1), scalar($3)); }
348         |       sexpr RELOP sexpr
349                         { $$ = newBINOP($2, 0, scalar($1), scalar($3)); }
350         |       sexpr EQOP sexpr
351                         { $$ = newBINOP($2, 0, scalar($1), scalar($3)); }
352         |       sexpr BITANDOP sexpr
353                         { $$ = newBINOP($2, 0, scalar($1), scalar($3)); }
354         |       sexpr BITOROP sexpr
355                         { $$ = newBINOP($2, 0, scalar($1), scalar($3)); }
356         |       sexpr DOTDOT sexpr
357                         { $$ = newRANGE($2, scalar($1), scalar($3));}
358         |       sexpr ANDAND sexpr
359                         { $$ = newLOGOP(OP_AND, 0, $1, $3); }
360         |       sexpr OROR sexpr
361                         { $$ = newLOGOP(OP_OR, 0, $1, $3); }
362         |       sexpr '?' sexpr ':' sexpr
363                         { $$ = newCONDOP(0, $1, $3, $5); }
364         |       sexpr MATCHOP sexpr
365                         { $$ = bind_match($2, $1, $3); }
366         |       term
367                         { $$ = $1; }
368         ;
369
370 term    :       '-' term %prec UMINUS
371                         { $$ = newUNOP(OP_NEGATE, 0, scalar($2)); }
372         |       '+' term %prec UMINUS
373                         { $$ = $2; }
374         |       '!' term
375                         { $$ = newUNOP(OP_NOT, 0, scalar($2)); }
376         |       '~' term
377                         { $$ = newUNOP(OP_COMPLEMENT, 0, scalar($2));}
378         |       REFGEN term
379                         { $$ = newUNOP(OP_REFGEN, 0, ref($2, OP_REFGEN)); }
380         |       term POSTINC
381                         { $$ = newUNOP(OP_POSTINC, 0,
382                                         ref(scalar($1), OP_POSTINC)); }
383         |       term POSTDEC
384                         { $$ = newUNOP(OP_POSTDEC, 0,
385                                         ref(scalar($1), OP_POSTDEC)); }
386         |       PREINC term
387                         { $$ = newUNOP(OP_PREINC, 0,
388                                         ref(scalar($2), OP_PREINC)); }
389         |       PREDEC term
390                         { $$ = newUNOP(OP_PREDEC, 0,
391                                         ref(scalar($2), OP_PREDEC)); }
392         |       LOCAL sexpr     %prec UNIOP
393                         { $$ = localize($2,$1); }
394         |       '(' expr crp
395                         { $$ = sawparens($2); }
396         |       '(' ')'
397                         { $$ = newNULLLIST(); }
398         |       '[' expr crb                            %prec '('
399                         { $$ = newANONLIST($2); }
400         |       '[' ']'                                 %prec '('
401                         { $$ = newANONLIST(Nullop); }
402         |       HASHBRACK expr crhb                     %prec '('
403                         { $$ = newANONHASH($2); }
404         |       HASHBRACK ';' '}'                               %prec '('
405                         { $$ = newANONHASH(Nullop); }
406         |       scalar  %prec '('
407                         { $$ = $1; }
408         |       star    %prec '('
409                         { $$ = $1; }
410         |       scalar '[' expr ']'     %prec '('
411                         { $$ = newBINOP(OP_AELEM, 0, oopsAV($1), scalar($3)); }
412         |       term ARROW '[' expr ']' %prec '('
413                         { $$ = newBINOP(OP_AELEM, 0,
414                                         scalar(ref(newAVREF($1),OP_RV2AV)),
415                                         scalar($4));}
416         |       hsh     %prec '('
417                         { $$ = $1; }
418         |       ary     %prec '('
419                         { $$ = $1; }
420         |       arylen  %prec '('
421                         { $$ = newUNOP(OP_AV2ARYLEN, 0, ref($1, OP_AV2ARYLEN));}
422         |       scalar '{' expr ';' '}' %prec '('
423                         { $$ = newBINOP(OP_HELEM, 0, oopsHV($1), jmaybe($3));
424                             expect = XOPERATOR; }
425         |       term ARROW '{' expr ';' '}'     %prec '('
426                         { $$ = newBINOP(OP_HELEM, 0,
427                                         scalar(ref(newHVREF($1),OP_RV2HV)),
428                                         jmaybe($4));
429                             expect = XOPERATOR; }
430         |       '(' expr crp '[' expr ']'       %prec '('
431                         { $$ = newSLICEOP(0, $5, $2); }
432         |       '(' ')' '[' expr ']'    %prec '('
433                         { $$ = newSLICEOP(0, $4, Nullop); }
434         |       ary '[' expr ']'        %prec '('
435                         { $$ = prepend_elem(OP_ASLICE,
436                                 newOP(OP_PUSHMARK, 0),
437                                 list(
438                                     newLISTOP(OP_ASLICE, 0,
439                                         list($3),
440                                         ref($1, OP_ASLICE)))); }
441         |       ary '{' expr ';' '}'    %prec '('
442                         { $$ = prepend_elem(OP_HSLICE,
443                                 newOP(OP_PUSHMARK, 0),
444                                 list(
445                                     newLISTOP(OP_HSLICE, 0,
446                                         list($3),
447                                         ref(oopsHV($1), OP_HSLICE))));
448                             expect = XOPERATOR; }
449         |       DELETE scalar '{' expr ';' '}'  %prec '('
450                         { $$ = newBINOP(OP_DELETE, 0, oopsHV($2), jmaybe($4));
451                             expect = XOPERATOR; }
452         |       DELETE '(' scalar '{' expr ';' '}' ')'  %prec '('
453                         { $$ = newBINOP(OP_DELETE, 0, oopsHV($3), jmaybe($5));
454                             expect = XOPERATOR; }
455         |       THING   %prec '('
456                         { $$ = $1; }
457         |       amper
458                         { $$ = newUNOP(OP_ENTERSUBR, 0,
459                                 scalar($1)); }
460         |       amper '(' ')'
461                         { $$ = newUNOP(OP_ENTERSUBR, OPf_STACKED, scalar($1)); }
462         |       amper '(' expr crp
463                         { $$ = newUNOP(OP_ENTERSUBR, OPf_STACKED,
464                             list(prepend_elem(OP_LIST, scalar($1), $3))); }
465         |       NOAMP WORD listexpr
466                         { $$ = newUNOP(OP_ENTERSUBR, OPf_STACKED,
467                             list(prepend_elem(OP_LIST,
468                                 newCVREF(scalar($2)), $3))); }
469         |       DO sexpr        %prec UNIOP
470                         { $$ = newUNOP(OP_DOFILE, 0, scalar($2));
471                           allgvs = TRUE;}
472         |       DO block        %prec '('
473                         { $$ = newUNOP(OP_NULL, OPf_SPECIAL, scope($2)); }
474         |       DO WORD '(' ')'
475                         { $$ = newUNOP(OP_ENTERSUBR, OPf_SPECIAL|OPf_STACKED,
476                             list(prepend_elem(OP_LIST,
477                                 scalar(newCVREF(scalar($2))), newNULLLIST()))); }
478         |       DO WORD '(' expr crp
479                         { $$ = newUNOP(OP_ENTERSUBR, OPf_SPECIAL|OPf_STACKED,
480                             list(prepend_elem(OP_LIST,
481                                 scalar(newCVREF(scalar($2))),
482                                 $4))); }
483         |       DO scalar '(' ')'
484                         { $$ = newUNOP(OP_ENTERSUBR, OPf_SPECIAL|OPf_STACKED,
485                             list(prepend_elem(OP_LIST,
486                                 scalar(newCVREF(scalar($2))), newNULLLIST())));}
487         |       DO scalar '(' expr crp
488                         { $$ = newUNOP(OP_ENTERSUBR, OPf_SPECIAL|OPf_STACKED,
489                             list(prepend_elem(OP_LIST,
490                                 scalar(newCVREF(scalar($2))),
491                                 $4))); }
492         |       LOOPEX
493                         { $$ = newOP($1, OPf_SPECIAL); }
494         |       LOOPEX WORD
495                         { $$ = newPVOP($1, 0,
496                                 savestr(SvPVnx(((SVOP*)$2)->op_sv)));
497                             op_free($2); }
498         |       UNIOP
499                         { $$ = newOP($1, 0); }
500         |       UNIOP block
501                         { $$ = newUNOP($1, 0, $2); }
502         |       UNIOP sexpr
503                         { $$ = newUNOP($1, 0, $2); }
504         |       FUNC0
505                         { $$ = newOP($1, 0); }
506         |       FUNC0 '(' ')'
507                         { $$ = newOP($1, 0); }
508         |       FUNC1 '(' ')'
509                         { $$ = newOP($1, OPf_SPECIAL); }
510         |       FUNC1 '(' expr ')'
511                         { $$ = newUNOP($1, 0, $3); }
512         |       PMFUNC '(' sexpr ')'
513                         { $$ = pmruntime($1, $3, Nullop); }
514         |       PMFUNC '(' sexpr ',' sexpr ')'
515                         { $$ = pmruntime($1, $3, $5); }
516         |       WORD
517         |       listop
518         ;
519
520 listexpr:       /* NULL */
521                         { $$ = newNULLLIST(); }
522         |       expr
523                         { $$ = $1; }
524         ;
525
526 amper   :       '&' indirob
527                         { $$ = newCVREF($2); }
528         ;
529
530 scalar  :       '$' indirob
531                         { $$ = newSVREF($2); }
532         ;
533
534 ary     :       '@' indirob
535                         { $$ = newAVREF($2); }
536         ;
537
538 hsh     :       '%' indirob
539                         { $$ = newHVREF($2); }
540         ;
541
542 arylen  :       DOLSHARP indirob
543                         { $$ = newAVREF($2); }
544         ;
545
546 star    :       '*' indirob
547                         { $$ = newGVREF($2); }
548         ;
549
550 indirob :       WORD
551                         { $$ = scalar($1); }
552         |       scalar
553                         { $$ = scalar($1); }
554         |       block
555                         { $$ = scalar(scope($1)); }
556
557         |       PRIVATEREF
558                         { $$ = $1; }
559         ;
560
561 crp     :       ',' ')'
562                         { $$ = 1; }
563         |       ')'
564                         { $$ = 0; }
565         ;
566
567 crb     :       ',' ']'
568                         { $$ = 1; }
569         |       ']'
570                         { $$ = 0; }
571         ;
572
573 crhb    :       ',' ';' '}'
574                         { $$ = 1; }
575         |       ';' '}'
576                         { $$ = 0; }
577         ;
578
579 %% /* PROGRAM */