home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / compcomp / tpyacc / yyparse.cod < prev   
Text File  |  1991-06-17  |  4KB  |  185 lines
  1.  
  2. (* Yacc parser template (TP Yacc V3.0), V1.2 6-17-91 AG *)
  3.  
  4. (* global definitions: *)
  5. %%
  6.  
  7. var yylval : YYSType;
  8.  
  9. function yylex : Integer; forward;
  10.  
  11. function yyparse : Integer;
  12.  
  13. var yystate, yysp, yyn : Integer;
  14.     yys : array [1..yymaxdepth] of Integer;
  15.     yyv : array [1..yymaxdepth] of YYSType;
  16.     yyval : YYSType;
  17.  
  18. procedure yyaction ( yyruleno : Integer );
  19.   (* local definitions: *)
  20. %%
  21. begin
  22.   (* actions: *)
  23.   case yyruleno of
  24. %%
  25.   end;
  26. end(*yyaction*);
  27.  
  28. (* parse table: *)
  29. %%
  30.  
  31. const _error = 256; (* error token *)
  32.  
  33. function yyact(state, sym : Integer; var act : Integer) : Boolean;
  34.   (* search action table *)
  35.   var k : Integer;
  36.   begin
  37.     k := yyal[state];
  38.     while (k<=yyah[state]) and (yya[k].sym<>sym) do inc(k);
  39.     if k>yyah[state] then
  40.       yyact := false
  41.     else
  42.       begin
  43.         act := yya[k].act;
  44.         yyact := true;
  45.       end;
  46.   end(*yyact*);
  47.  
  48. function yygoto(state, sym : Integer; var nstate : Integer) : Boolean;
  49.   (* search goto table *)
  50.   var k : Integer;
  51.   begin
  52.     k := yygl[state];
  53.     while (k<=yygh[state]) and (yyg[k].sym<>sym) do inc(k);
  54.     if k>yygh[state] then
  55.       yygoto := false
  56.     else
  57.       begin
  58.         nstate := yyg[k].act;
  59.         yygoto := true;
  60.       end;
  61.   end(*yygoto*);
  62.  
  63. label parse, next, error, errlab, shift, reduce, accept, abort;
  64.  
  65. begin(*yyparse*)
  66.  
  67.   (* initialize: *)
  68.  
  69.   yystate := 0; yychar := -1; yynerrs := 0; yyerrflag := 0; yysp := 0;
  70.  
  71. {$ifdef yydebug}
  72.   yydebug := true;
  73. {$else}
  74.   yydebug := false;
  75. {$endif}
  76.  
  77. parse:
  78.  
  79.   (* push state and value: *)
  80.  
  81.   inc(yysp);
  82.   if yysp>yymaxdepth then
  83.     begin
  84.       yyerror('yyparse stack overflow');
  85.       goto abort;
  86.     end;
  87.   yys[yysp] := yystate; yyv[yysp] := yyval;
  88.  
  89. next:
  90.  
  91.   if (yyd[yystate]=0) and (yychar=-1) then
  92.     (* get next symbol *)
  93.     begin
  94.       yychar := yylex; if yychar<0 then yychar := 0;
  95.     end;
  96.  
  97.   if yydebug then writeln('state ', yystate, ', char ', yychar);
  98.  
  99.   (* determine parse action: *)
  100.  
  101.   yyn := yyd[yystate];
  102.   if yyn<>0 then goto reduce; (* simple state *)
  103.  
  104.   (* no default action; search parse table *)
  105.  
  106.   if not yyact(yystate, yychar, yyn) then goto error
  107.   else if yyn>0 then                      goto shift
  108.   else if yyn<0 then                      goto reduce
  109.   else                                    goto accept;
  110.  
  111. error:
  112.  
  113.   (* error; start error recovery: *)
  114.  
  115.   if yyerrflag=0 then yyerror('syntax error');
  116.  
  117. errlab:
  118.  
  119.   if yyerrflag=0 then inc(yynerrs);     (* new error *)
  120.  
  121.   if yyerrflag<=2 then                  (* incomplete recovery; try again *)
  122.     begin
  123.       yyerrflag := 3;
  124.       (* uncover a state with shift action on error token *)
  125.       while (yysp>0) and not ( yyact(yys[yysp], _error, yyn) and
  126.                                (yyn>0) ) do
  127.         begin
  128.           if yydebug then
  129.             if yysp>1 then
  130.               writeln('error recovery pops state ', yys[yysp], ', uncovers ',
  131.                       yys[yysp-1])
  132.             else
  133.               writeln('error recovery fails ... abort');
  134.           dec(yysp);
  135.         end;
  136.       if yysp=0 then goto abort; (* parser has fallen from stack; abort *)
  137.       yystate := yyn;            (* simulate shift on error *)
  138.       goto parse;
  139.     end
  140.   else                                  (* no shift yet; discard symbol *)
  141.     begin
  142.       if yydebug then writeln('error recovery discards char ', yychar);
  143.       if yychar=0 then goto abort; (* end of input; abort *)
  144.       yychar := -1; goto next;     (* clear lookahead char and try again *)
  145.     end;
  146.  
  147. shift:
  148.  
  149.   (* go to new state, clear lookahead character: *)
  150.  
  151.   yystate := yyn; yychar := -1; yyval := yylval;
  152.   if yyerrflag>0 then dec(yyerrflag);
  153.  
  154.   goto parse;
  155.  
  156. reduce:
  157.  
  158.   (* execute action, pop rule from stack, and go to next state: *)
  159.  
  160.   if yydebug then writeln('reduce ', -yyn);
  161.  
  162.   yyflag := yyfnone; yyaction(-yyn);
  163.   dec(yysp, yyr[-yyn].len);
  164.   if yygoto(yys[yysp], yyr[-yyn].sym, yyn) then yystate := yyn;
  165.  
  166.   (* handle action calls to yyaccept, yyabort and yyerror: *)
  167.  
  168.   case yyflag of
  169.     yyfaccept : goto accept;
  170.     yyfabort  : goto abort;
  171.     yyferror  : goto errlab;
  172.   end;
  173.  
  174.   goto parse;
  175.  
  176. accept:
  177.  
  178.   yyparse := 0; exit;
  179.  
  180. abort:
  181.  
  182.   yyparse := 1; exit;
  183.  
  184. end(*yyparse*);
  185.