This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
yyparse: reindent
[perl5.git] / perly.c
1 /*    perly.c
2  *
3  *    Copyright (c) 2004, 2005, 2006, 2007, 2008,
4  *    2009, 2010, 2011 by Larry Wall and others
5  *
6  *    You may distribute under the terms of either the GNU General Public
7  *    License or the Artistic License, as specified in the README file.
8  * 
9  *    Note that this file was originally generated as an output from
10  *    GNU bison version 1.875, but now the code is statically maintained
11  *    and edited; the bits that are dependent on perly.y are now
12  *    #included from the files perly.tab and perly.act.
13  *
14  *    Here is an important copyright statement from the original, generated
15  *    file:
16  *
17  *      As a special exception, when this file is copied by Bison into a
18  *      Bison output file, you may use that output file without
19  *      restriction.  This special exception was added by the Free
20  *      Software Foundation in version 1.24 of Bison.
21  *
22  */
23
24 #include "EXTERN.h"
25 #define PERL_IN_PERLY_C
26 #include "perl.h"
27 #include "feature.h"
28 #include "keywords.h"
29
30 typedef unsigned char yytype_uint8;
31 typedef signed char yytype_int8;
32 typedef unsigned short int yytype_uint16;
33 typedef short int yytype_int16;
34 typedef signed char yysigned_char;
35
36 /* YYINITDEPTH -- initial size of the parser's stacks.  */
37 #define YYINITDEPTH 200
38
39 #ifdef YYDEBUG
40 #  undef YYDEBUG
41 #endif
42 #ifdef DEBUGGING
43 #  define YYDEBUG 1
44 #else
45 #  define YYDEBUG 0
46 #endif
47
48 #ifndef YY_NULL
49 # define YY_NULL 0
50 #endif
51
52 #ifndef YY_NULLPTR
53 # define YY_NULLPTR NULL
54 #endif
55
56 /* contains all the parser state tables; auto-generated from perly.y */
57 #include "perly.tab"
58
59 # define YYSIZE_T size_t
60
61 #define YYEOF           0
62 #define YYTERROR        1
63
64 #define YYACCEPT        goto yyacceptlab
65 #define YYABORT         goto yyabortlab
66 #define YYERROR         goto yyerrlab1
67
68 /* Enable debugging if requested.  */
69 #ifdef DEBUGGING
70
71 #  define yydebug (DEBUG_p_TEST)
72
73 #  define YYFPRINTF PerlIO_printf
74
75 #  define YYDPRINTF(Args)                       \
76 do {                                            \
77     if (yydebug)                                \
78         YYFPRINTF Args;                         \
79 } while (0)
80
81 #  define YYDSYMPRINTF(Title, Token, Value)                     \
82 do {                                                            \
83     if (yydebug) {                                              \
84         YYFPRINTF (Perl_debug_log, "%s ", Title);               \
85         yysymprint (aTHX_ Perl_debug_log,  Token, Value);       \
86         YYFPRINTF (Perl_debug_log, "\n");                       \
87     }                                                           \
88 } while (0)
89
90 /*--------------------------------.
91 | Print this symbol on YYOUTPUT.  |
92 `--------------------------------*/
93
94 static void
95 yysymprint(pTHX_ PerlIO * const yyoutput, int yytype, const YYSTYPE * const yyvaluep)
96 {
97     PERL_UNUSED_CONTEXT;
98     if (yytype < YYNTOKENS) {
99         YYFPRINTF (yyoutput, "token %s (", yytname[yytype]);
100 #   ifdef YYPRINT
101         YYPRINT (yyoutput, yytoknum[yytype], *yyvaluep);
102 #   else
103         YYFPRINTF (yyoutput, "0x%" UVxf, (UV)yyvaluep->ival);
104 #   endif
105     }
106     else
107         YYFPRINTF (yyoutput, "nterm %s (", yytname[yytype]);
108
109     YYFPRINTF (yyoutput, ")");
110 }
111
112
113 /*  yy_stack_print()
114  *  print the top 8 items on the parse stack.
115  */
116
117 static void
118 yy_stack_print (pTHX_ const yy_parser *parser)
119 {
120     const yy_stack_frame *ps, *min;
121
122     min = parser->ps - 8 + 1;
123     if (min <= parser->stack)
124         min = parser->stack + 1;
125
126     PerlIO_printf(Perl_debug_log, "\nindex:");
127     for (ps = min; ps <= parser->ps; ps++)
128         PerlIO_printf(Perl_debug_log, " %8d", (int)(ps - parser->stack));
129
130     PerlIO_printf(Perl_debug_log, "\nstate:");
131     for (ps = min; ps <= parser->ps; ps++)
132         PerlIO_printf(Perl_debug_log, " %8d", ps->state);
133
134     PerlIO_printf(Perl_debug_log, "\ntoken:");
135     for (ps = min; ps <= parser->ps; ps++)
136         PerlIO_printf(Perl_debug_log, " %8.8s", ps->name);
137
138     PerlIO_printf(Perl_debug_log, "\nvalue:");
139     for (ps = min; ps <= parser->ps; ps++) {
140         switch (yy_type_tab[yystos[ps->state]]) {
141         case toketype_opval:
142             PerlIO_printf(Perl_debug_log, " %8.8s",
143                   ps->val.opval
144                     ? PL_op_name[ps->val.opval->op_type]
145                     : "(Nullop)"
146             );
147             break;
148         case toketype_ival:
149             PerlIO_printf(Perl_debug_log, " %8" IVdf, (IV)ps->val.ival);
150             break;
151         default:
152             PerlIO_printf(Perl_debug_log, " %8" UVxf, (UV)ps->val.ival);
153         }
154     }
155     PerlIO_printf(Perl_debug_log, "\n\n");
156 }
157
158 #  define YY_STACK_PRINT(parser)        \
159 do {                                    \
160     if (yydebug && DEBUG_v_TEST)        \
161         yy_stack_print (aTHX_ parser);  \
162 } while (0)
163
164
165 /*------------------------------------------------.
166 | Report that the YYRULE is going to be reduced.  |
167 `------------------------------------------------*/
168
169 static void
170 yy_reduce_print (pTHX_ int yyrule)
171 {
172     int yyi;
173     const unsigned int yylineno = yyrline[yyrule];
174     YYFPRINTF (Perl_debug_log, "Reducing stack by rule %d (line %u), ",
175                           yyrule - 1, yylineno);
176     /* Print the symbols being reduced, and their result.  */
177 #if PERL_BISON_VERSION >= 30000 /* 3.0+ */
178     for (yyi = 0; yyi < yyr2[yyrule]; yyi++)
179         YYFPRINTF (Perl_debug_log, "%s ",
180             yytname [yystos[(PL_parser->ps)[yyi + 1 - yyr2[yyrule]].state]]);
181 #else
182     for (yyi = yyprhs[yyrule]; 0 <= yyrhs[yyi]; yyi++)
183         YYFPRINTF (Perl_debug_log, "%s ", yytname [yyrhs[yyi]]);
184 #endif
185     YYFPRINTF (Perl_debug_log, "-> %s\n", yytname [yyr1[yyrule]]);
186 }
187
188 #  define YY_REDUCE_PRINT(Rule)         \
189 do {                                    \
190     if (yydebug)                        \
191         yy_reduce_print (aTHX_ Rule);           \
192 } while (0)
193
194 #else /* !DEBUGGING */
195 #  define YYDPRINTF(Args)
196 #  define YYDSYMPRINTF(Title, Token, Value)
197 #  define YY_STACK_PRINT(parser)
198 #  define YY_REDUCE_PRINT(Rule)
199 #endif /* !DEBUGGING */
200
201 /* called during cleanup (via SAVEDESTRUCTOR_X) to free any items on the
202  * parse stack, thus avoiding leaks if we die  */
203
204 static void
205 S_clear_yystack(pTHX_  const yy_parser *parser)
206 {
207     yy_stack_frame *ps     = parser->ps;
208     int i = 0;
209
210     if (!parser->stack)
211         return;
212
213     YYDPRINTF ((Perl_debug_log, "clearing the parse stack\n"));
214
215     for (i=0; i< parser->yylen; i++) {
216         SvREFCNT_dec(ps[-i].compcv);
217     }
218     ps -= parser->yylen;
219
220     /* now free whole the stack, including the just-reduced ops */
221
222     while (ps > parser->stack) {
223         LEAVE_SCOPE(ps->savestack_ix);
224         if (yy_type_tab[yystos[ps->state]] == toketype_opval
225             && ps->val.opval)
226         {
227             if (ps->compcv && (ps->compcv != PL_compcv)) {
228                 PL_compcv = ps->compcv;
229                 PAD_SET_CUR_NOSAVE(CvPADLIST(PL_compcv), 1);
230                 PL_comppad_name = PadlistNAMES(CvPADLIST(PL_compcv));
231             }
232             YYDPRINTF ((Perl_debug_log, "(freeing op)\n"));
233             op_free(ps->val.opval);
234         }
235         SvREFCNT_dec(ps->compcv);
236         ps--;
237     }
238
239     Safefree(parser->stack);
240 }
241
242
243 /*----------.
244 | yyparse.  |
245 `----------*/
246
247 int
248 Perl_yyparse (pTHX_ int gramtype)
249 {
250     dVAR;
251     int yystate;
252     int yyn;
253     int yyresult;
254
255     /* Lookahead token as an internal (translated) token number.  */
256     int yytoken = 0;
257
258     yy_parser *parser;      /* the parser object */
259     yy_stack_frame  *ps;   /* current parser stack frame */
260
261 #define YYPOPSTACK   parser->ps = --ps
262 #define YYPUSHSTACK  parser->ps = ++ps
263
264     /* The variable used to return semantic value and location from the
265           action routines: ie $$.  */
266     YYSTYPE yyval;
267
268     YYDPRINTF ((Perl_debug_log, "Starting parse\n"));
269
270     parser = PL_parser;
271
272     ENTER;  /* force parser state cleanup/restoration before we return */
273     SAVEPPTR(parser->yylval.pval);
274     SAVEINT(parser->yychar);
275     SAVEINT(parser->yyerrstatus);
276     SAVEINT(parser->yylen);
277     SAVEVPTR(parser->stack);
278     SAVEVPTR(parser->stack_max1);
279     SAVEVPTR(parser->ps);
280
281     /* initialise state for this parse */
282     parser->yychar = gramtype;
283     parser->yyerrstatus = 0;
284     parser->yylen = 0;
285     Newx(parser->stack, YYINITDEPTH, yy_stack_frame);
286     parser->stack_max1 = parser->stack + YYINITDEPTH - 1;
287     ps = parser->ps = parser->stack;
288     ps->state = 0;
289     SAVEDESTRUCTOR_X(S_clear_yystack, parser);
290
291     while (1) {
292         /* main loop: shift some tokens, then reduce when possible */
293
294         while (1) {
295             /* shift a token, or quit when it's possible to reduce */
296
297             yystate = ps->state;
298
299             YYDPRINTF ((Perl_debug_log, "Entering state %d\n", yystate));
300
301             parser->yylen = 0;
302
303             {
304                 /* grow the stack? We always leave 1 spare slot,
305                  * in case of a '' -> 'foo' reduction.
306                  * Note that stack_max1 points to the (top-1)th allocated stack
307                  * element to make this check fast */
308
309                 if (ps >= parser->stack_max1) {
310                     Size_t pos = ps - parser->stack;
311                     Size_t newsize = 2 * (parser->stack_max1 + 2 - parser->stack);
312                     /* this will croak on insufficient memory */
313                     Renew(parser->stack, newsize, yy_stack_frame);
314                     ps = parser->ps = parser->stack + pos;
315                     parser->stack_max1 = parser->stack + newsize - 1;
316
317                     YYDPRINTF((Perl_debug_log,
318                                     "parser stack size increased to %lu frames\n",
319                                     (unsigned long int)newsize));
320                 }
321             }
322
323         /* Do appropriate processing given the current state.  */
324         /* Read a lookahead token if we need one and don't already have one.  */
325
326             /* First try to decide what to do without reference to lookahead token.  */
327
328             yyn = yypact[yystate];
329             if (yyn == YYPACT_NINF)
330                 goto yydefault;
331
332             /* Not known => get a lookahead token if don't already have one.  */
333
334             /* YYCHAR is either YYEMPTY or YYEOF or a valid lookahead symbol.  */
335             if (parser->yychar == YYEMPTY) {
336                 YYDPRINTF ((Perl_debug_log, "Reading a token:\n"));
337                 parser->yychar = yylex();
338             }
339
340             if (parser->yychar <= YYEOF) {
341                 parser->yychar = yytoken = YYEOF;
342                 YYDPRINTF ((Perl_debug_log, "Now at end of input.\n"));
343             }
344             else {
345                 /* perly.tab is shipped based on an ASCII system, so need to index it
346                  * with characters translated to ASCII.  Although it's not designed for
347                  * this purpose, we can use NATIVE_TO_UNI here.  It returns its
348                  * argument on ASCII platforms, and on EBCDIC translates native to
349                  * ascii in the 0-255 range, leaving everything else unchanged.  This
350                  * jibes with yylex() returning some bare characters in that range, but
351                  * all tokens it returns are either 0, or above 255.  There could be a
352                  * problem if NULs weren't 0, or were ever returned as raw chars by
353                  * yylex() */
354                 yytoken = YYTRANSLATE (NATIVE_TO_UNI(parser->yychar));
355                 YYDSYMPRINTF ("Next token is", yytoken, &parser->yylval);
356             }
357
358             /* If the proper action on seeing token YYTOKEN is to reduce or to
359              * detect an error, take that action.
360              * Casting yyn to unsigned allows a >=0 test to be included as
361              * part of the  <=YYLAST test for speed */
362             yyn += yytoken;
363             if ((unsigned int)yyn > YYLAST || yycheck[yyn] != yytoken) {
364               yydefault:
365                 /* do the default action for the current state. */
366                 yyn = yydefact[yystate];
367                 if (yyn == 0)
368                     goto yyerrlab;
369                 break; /* time to reduce */
370             }
371
372             yyn = yytable[yyn];
373             if (yyn <= 0) {
374                 if (yyn == 0 || yyn == YYTABLE_NINF)
375                     goto yyerrlab;
376                 yyn = -yyn;
377                 break; /* time to reduce */
378             }
379
380             if (yyn == YYFINAL)
381                 YYACCEPT;
382
383             /* Shift the lookahead token.  */
384             YYDPRINTF ((Perl_debug_log, "Shifting token %s, ", yytname[yytoken]));
385
386             /* Discard the token being shifted unless it is eof.  */
387             if (parser->yychar != YYEOF)
388                 parser->yychar = YYEMPTY;
389
390             YYPUSHSTACK;
391             ps->state   = yyn;
392             ps->val     = parser->yylval;
393             ps->compcv  = (CV*)SvREFCNT_inc(PL_compcv);
394             ps->savestack_ix = PL_savestack_ix;
395 #ifdef DEBUGGING
396             ps->name    = (const char *)(yytname[yytoken]);
397 #endif
398
399             /* Count tokens shifted since error; after three, turn off error
400                   status.  */
401             if (parser->yyerrstatus)
402                 parser->yyerrstatus--;
403
404         }
405
406         /* Do a reduction */
407
408         /* yyn is the number of a rule to reduce with.  */
409         parser->yylen = yyr2[yyn];
410
411         /* If YYLEN is nonzero, implement the default value of the action:
412           "$$ = $1".
413
414           Otherwise, the following line sets YYVAL to garbage.
415           This behavior is undocumented and Bison
416           users should not rely upon it.  Assigning to YYVAL
417           unconditionally makes the parser a bit smaller, and it avoids a
418           GCC warning that YYVAL may be used uninitialized.  */
419         yyval = ps[1-parser->yylen].val;
420
421         YY_STACK_PRINT(parser);
422         YY_REDUCE_PRINT (yyn);
423
424         switch (yyn) {
425
426     /* contains all the rule actions; auto-generated from perly.y */
427 #include "perly.act"
428
429         }
430
431         {
432             int i;
433             for (i=0; i< parser->yylen; i++) {
434                 SvREFCNT_dec(ps[-i].compcv);
435             }
436         }
437
438         parser->ps = ps -= (parser->yylen-1);
439
440         /* Now shift the result of the reduction.  Determine what state
441               that goes to, based on the state we popped back to and the rule
442               number reduced by.  */
443
444         ps->val     = yyval;
445         ps->compcv  = (CV*)SvREFCNT_inc(PL_compcv);
446         ps->savestack_ix = PL_savestack_ix;
447 #ifdef DEBUGGING
448         ps->name    = (const char *)(yytname [yyr1[yyn]]);
449 #endif
450
451         yyn = yyr1[yyn];
452
453         yystate = yypgoto[yyn - YYNTOKENS] + ps[-1].state;
454         if (0 <= yystate && yystate <= YYLAST && yycheck[yystate] == ps[-1].state)
455             yystate = yytable[yystate];
456         else
457             yystate = yydefgoto[yyn - YYNTOKENS];
458         ps->state = yystate;
459
460         continue;
461
462
463       /*------------------------------------.
464       | yyerrlab -- here on detecting error |
465       `------------------------------------*/
466       yyerrlab:
467         /* If not already recovering from an error, report this error.  */
468         if (!parser->yyerrstatus) {
469             yyerror ("syntax error");
470         }
471
472
473         if (parser->yyerrstatus == 3) {
474             /* If just tried and failed to reuse lookahead token after an
475                   error, discard it.  */
476
477             /* Return failure if at end of input.  */
478             if (parser->yychar == YYEOF) {
479                 /* Pop the error token.  */
480                 SvREFCNT_dec(ps->compcv);
481                 YYPOPSTACK;
482                 /* Pop the rest of the stack.  */
483                 while (ps > parser->stack) {
484                     YYDSYMPRINTF ("Error: popping", yystos[ps->state], &ps->val);
485                     LEAVE_SCOPE(ps->savestack_ix);
486                     if (yy_type_tab[yystos[ps->state]] == toketype_opval
487                             && ps->val.opval)
488                     {
489                         YYDPRINTF ((Perl_debug_log, "(freeing op)\n"));
490                         if (ps->compcv != PL_compcv) {
491                             PL_compcv = ps->compcv;
492                             PAD_SET_CUR_NOSAVE(CvPADLIST(PL_compcv), 1);
493                         }
494                         op_free(ps->val.opval);
495                     }
496                     SvREFCNT_dec(ps->compcv);
497                     YYPOPSTACK;
498                 }
499                 YYABORT;
500             }
501
502             YYDSYMPRINTF ("Error: discarding", yytoken, &parser->yylval);
503             parser->yychar = YYEMPTY;
504
505         }
506
507         /* Else will try to reuse lookahead token after shifting the error
508               token.  */
509         goto yyerrlab1;
510
511
512       /*----------------------------------------------------.
513       | yyerrlab1 -- error raised explicitly by an action.  |
514       `----------------------------------------------------*/
515       yyerrlab1:
516         parser->yyerrstatus = 3;        /* Each real token shifted decrements this.  */
517
518         for (;;) {
519             yyn = yypact[yystate];
520             if (yyn != YYPACT_NINF) {
521                 yyn += YYTERROR;
522                 if (0 <= yyn && yyn <= YYLAST && yycheck[yyn] == YYTERROR) {
523                     yyn = yytable[yyn];
524                     if (0 < yyn)
525                         break;
526                 }
527             }
528
529             /* Pop the current state because it cannot handle the error token.  */
530             if (ps == parser->stack)
531                 YYABORT;
532
533             YYDSYMPRINTF ("Error: popping", yystos[ps->state], &ps->val);
534             LEAVE_SCOPE(ps->savestack_ix);
535             if (yy_type_tab[yystos[ps->state]] == toketype_opval && ps->val.opval) {
536                 YYDPRINTF ((Perl_debug_log, "(freeing op)\n"));
537                 if (ps->compcv != PL_compcv) {
538                     PL_compcv = ps->compcv;
539                     PAD_SET_CUR_NOSAVE(CvPADLIST(PL_compcv), 1);
540                 }
541                 op_free(ps->val.opval);
542             }
543             SvREFCNT_dec(ps->compcv);
544             YYPOPSTACK;
545             yystate = ps->state;
546
547             YY_STACK_PRINT(parser);
548         }
549
550         if (yyn == YYFINAL)
551             YYACCEPT;
552
553         YYDPRINTF ((Perl_debug_log, "Shifting error token, "));
554
555         YYPUSHSTACK;
556         ps->state   = yyn;
557         ps->val     = parser->yylval;
558         ps->compcv  = (CV*)SvREFCNT_inc(PL_compcv);
559         ps->savestack_ix = PL_savestack_ix;
560 #ifdef DEBUGGING
561         ps->name    ="<err>";
562 #endif
563
564     } /* main loop */
565
566
567   /*-------------------------------------.
568   | yyacceptlab -- YYACCEPT comes here.  |
569   `-------------------------------------*/
570   yyacceptlab:
571     yyresult = 0;
572     for (ps=parser->ps; ps > parser->stack; ps--) {
573         SvREFCNT_dec(ps->compcv);
574     }
575     parser->ps = parser->stack; /* disable cleanup */
576     goto yyreturn;
577
578   /*-----------------------------------.
579   | yyabortlab -- YYABORT comes here.  |
580   `-----------------------------------*/
581   yyabortlab:
582     yyresult = 1;
583     goto yyreturn;
584
585   yyreturn:
586     LEAVE;      /* force parser stack cleanup before we return */
587     return yyresult;
588 }
589
590 /*
591  * ex: set ts=8 sts=4 sw=4 et:
592  */