home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / compcomp / tpyacc / src / yaccpars.pas < prev    next >
Pascal/Delphi Source File  |  1991-04-30  |  18KB  |  555 lines
  1.  
  2. unit YaccParseTable;
  3.  
  4. (* 3-1-91 AG *)
  5.  
  6. (* Copyright (c) 1990,91 by Albert Graef, Schillerstr. 18,
  7.    6509 Schornsheim/Germany
  8.    All rights reserved *)
  9.  
  10. interface
  11.  
  12. (* Yacc parse table construction. *)
  13.  
  14. procedure parse_table;
  15.  
  16.   (* Constructs the parse table from the information in the state,
  17.      transition and reduction table, and writes parse and rule table
  18.      information to the output file.
  19.  
  20.      Rules never reduced are detected, and parsing conflicts resolved
  21.      according to the usual disambiguting rules:
  22.  
  23.      - by default, shift/reduce conflicts are resolved in favour of
  24.        shift, and reduce/reduce conflicts are resolved in favour of
  25.        the rule appearing first in the grammar
  26.  
  27.      - in the presence of precedence information, shift/reduce conflicts
  28.        are resolved as follows:
  29.        - if the rule has higher precedence than the input symbol,
  30.          reduce
  31.        - if the input symbol has higher precedence than the rule,
  32.          shift
  33.        - if rule and input symbol have the same precedence, use
  34.          associativity to resolve the conflict: if the symbol is
  35.          left-associative, reduce; if right-associative, shift;
  36.          if nonassociative, error.
  37.  
  38.      The default action for any state is error, unless the state
  39.      only has a single reduce action, and no shift (or nonassoc-induced
  40.      error) actions, in which case the default action is the reduction.
  41.      An accept action is generated for the shift-endmarker action.
  42.  
  43.      If the verbose option is enabled, the parse_table routine also writes
  44.      a readable listing of the generated parser to the .LST file, including
  45.      descriptions of parse conflicts and rules never reduced.
  46.  
  47.      Parse table actions are encoded as follows:
  48.      - positive: next state (shift or goto action)
  49.      - negative: rule to reduce (reduce action)
  50.      - 0: error (in default action table) or accept (in shift/reduce
  51.           action table)
  52.  
  53.      The tables are written out as a collection of typed array constants:
  54.  
  55.      type YYARec = record { action record }
  56.                      sym, act : Integer; { symbol and action }
  57.                    end;
  58.           YYRRec = record { rule record }
  59.                      len, sym : Integer; { length and lhs symbol }
  60.                    end;
  61.  
  62.      const
  63.  
  64.      yynacts   = ...; { number of parse table (shift and reduce) actions }
  65.      yyngotos  = ...; { number of goto actions }
  66.      yynstates = ...; { number of states }
  67.      yynrules  = ...; { number of rules }
  68.  
  69.      yya : array [1..yynacts] of YYARec = ...;
  70.        { shift and reduce actions }
  71.      yyg : array [1..yyngotos] of YYARec = ...;
  72.        { goto actions }
  73.      yyd : array [0..yynstates-1] of Integer = ...;
  74.        { default actions }
  75.      yyal, yyah,
  76.      yygl, yygh : array [0..yynstates-1] of Integer = ...;
  77.        { offsets into action and goto table }
  78.  
  79.      yyr : array [1..yynrules] of YYRRec = ...;
  80.  
  81.   *)
  82.  
  83. var shift_reduce, reduce_reduce, never_reduced : Integer;
  84.   (* number of parsing conflicts and unreduced rules detected during
  85.      parse table generation *)
  86.  
  87. implementation
  88.  
  89. uses YaccBase, YaccTables;
  90.  
  91. var reduced : array [1..max_rules] of Boolean;
  92.  
  93. var yynacts, yyngotos, yynstates : Integer;
  94.     yyd : array [0..max_states-1] of Integer;
  95.     yyal, yyah, yygl, yygh : array [0..max_states-1] of Integer;
  96.  
  97. function ruleStr ( i : Integer ) : String;
  98.   (* returns print representation of rule number i *)
  99.   var str : String; j : Integer;
  100.   begin
  101.     with rule_table^[i]^ do
  102.       begin
  103.         str := pname(lhs_sym)+' :';
  104.         for j := 1 to rhs_len do
  105.           str := str+' '+pname(rhs_sym[j]);
  106.       end;
  107.     ruleStr := str;
  108.   end(*ruleStr*);
  109.  
  110. function itemStr ( var item_set : ItemSet; i : Integer ) : String;
  111.   (* returns print representation of item number i in item_set *)
  112.   var str : String; j : Integer;
  113.   begin
  114.     with item_set, item[i], rule_table^[rule_no]^ do
  115.       begin
  116.         str := pname(lhs_sym)+' :';
  117.         for j := 1 to pos_no-1 do
  118.           str := str+' '+pname(rhs_sym[j]);
  119.         str := str+' _';
  120.         for j := pos_no to rhs_len do
  121.           str := str+' '+pname(rhs_sym[j]);
  122.       end;
  123.     itemStr := str;
  124.   end(*itemStr*);
  125.  
  126. procedure build;
  127.  
  128.   (* build the parse table, resolve conflicts *)
  129.  
  130.   var
  131.  
  132.     i, j, k, s,
  133.     n_errors,
  134.     n_shifts,
  135.     n_gotos,
  136.     n_reductions,
  137.     n_conflicts : Integer;
  138.  
  139.   item_set : ItemSet;
  140.  
  141.   begin
  142.  
  143.     (* initialize: *)
  144.  
  145.     shift_reduce := 0; reduce_reduce := 0; never_reduced := 0;
  146.     for i := 1 to n_rules do reduced[i] := false;
  147.  
  148.     (* traverse the state table: *)
  149.  
  150.     for s := 0 to n_states-1 do with state_table^[s] do
  151.  
  152.       begin
  153.  
  154.         if verbose then
  155.           begin
  156.             writeln(yylst);
  157.             writeln(yylst, 'state ', s, ':');
  158.           end;
  159.  
  160.         (* Check shift and reduce actions, resolve conflicts.
  161.            The number of error actions generated by nonassoc's is counted
  162.            in n_errors, the number of conflicts reported in n_conflicts.
  163.            Shift actions ruled out by disambiguating rules are flagged by
  164.            setting the corresponding next_state to -1. *)
  165.  
  166.         n_errors := 0; n_conflicts := 0;
  167.  
  168.         for i := trans_lo to trans_hi do with trans_table^[i] do
  169.           if sym>=0 then
  170.             for j := redns_lo to redns_hi do with redn_table^[j] do
  171.               if member(sym, symset^) then
  172.                 if (sym_prec^[sym]>0) and (rule_prec^[rule_no]>0) then
  173.                   (* resolve conflict using precedence: *)
  174.                   if rule_prec^[rule_no]=sym_prec^[sym] then
  175.                     case prec_table^[sym_prec^[sym]] of
  176.                       left     : (* reduce *)
  177.                                  next_state := -1;
  178.                       right    : (* shift *)
  179.                                  exclude(symset^, sym);
  180.                       nonassoc : (* error *)
  181.                                  begin
  182.                                    inc(n_errors);
  183.                                    next_state := -1;
  184.                                    exclude(symset^, sym);
  185.                                  end;
  186.                     end
  187.                   else if rule_prec^[rule_no]>sym_prec^[sym] then
  188.                     (* reduce *)
  189.                     next_state := -1
  190.                   else
  191.                     (* shift *)
  192.                     exclude(symset^, sym)
  193.                 else
  194.                   (* shift/reduce conflict: *)
  195.                   begin
  196.                     if verbose then
  197.                       begin
  198.                         if n_conflicts=0 then
  199.                           begin
  200.                             writeln(yylst);
  201.                             writeln(yylst, tab, '*** conflicts:');
  202.                             writeln(yylst);
  203.                           end;
  204.                         writeln(yylst, tab,
  205.                                        'shift ', next_state, ', ',
  206.                                        'reduce ', rule_no-1, ' on ',
  207.                                        pname(sym));
  208.                       end;
  209.                     inc(n_conflicts); inc(shift_reduce);
  210.                     exclude(symset^, sym);
  211.                   end;
  212.  
  213.         for i := redns_lo to redns_hi do 
  214.           for j := i+1 to redns_hi do with redn_table^[j] do
  215.             begin
  216.               for k := 1 to size(symset^) do
  217.                 if member(symset^[k], redn_table^[i].symset^) then
  218.                   (* reduce/reduce conflict: *)
  219.                   begin
  220.                     if verbose then
  221.                       begin
  222.                         if n_conflicts=0 then
  223.                           begin
  224.                             writeln(yylst);
  225.                             writeln(yylst, tab, '*** conflicts:');
  226.                             writeln(yylst);
  227.                           end;
  228.                         writeln(yylst, tab,
  229.                                        'reduce ',
  230.                                        redn_table^[i].rule_no-1, ', ',
  231.                                        'reduce ', rule_no-1, ' on ',
  232.                                        pname(symset^[k]));
  233.                       end;
  234.                     inc(n_conflicts); inc(reduce_reduce);
  235.                   end;
  236.               setminus(symset^, redn_table^[i].symset^);
  237.             end;
  238.  
  239.         (* Count goto, shift and reduce actions to generate. *)
  240.  
  241.         n_gotos := 0; n_shifts := 0; n_reductions := 0;
  242.  
  243.         for i := trans_lo to trans_hi do with trans_table^[i] do
  244.           if next_state<>-1 then
  245.             if sym<0 then
  246.               inc(n_gotos)
  247.             else
  248.               inc(n_shifts);
  249.  
  250.         for i := redns_lo to redns_hi do with redn_table^[i] do
  251.           if size(symset^)>0 then
  252.             inc(n_reductions);
  253.  
  254.         (* Determine default action. *)
  255.  
  256.         if (n_shifts+n_errors=0) and (n_reductions=1) then
  257.           (* default action is the reduction *)
  258.           with redn_table^[redns_lo] do
  259.             yyd[s] := -(rule_no-1)
  260.         else
  261.           (* default action is error *)
  262.           yyd[s] := 0;
  263.  
  264.         (* Flag reduced rules. *)
  265.  
  266.         for i := redns_lo to redns_hi do
  267.           with redn_table^[i] do
  268.             reduced[rule_no] := true;
  269.  
  270.         if verbose then
  271.  
  272.           begin
  273.  
  274.             (* List kernel items. *)
  275.  
  276.             writeln(yylst);
  277.             get_item_set(s, item_set);
  278.             closure(item_set);
  279.             sort_item_set(item_set);
  280.             with item_set do
  281.               begin
  282.                 for i := 1 to n_items do
  283.                   with item[i], rule_table^[rule_no]^ do
  284.                     if (rule_no=1) or (pos_no>1) or (rhs_len=0) then
  285.                       if pos_no>rhs_len then
  286.                         writeln(yylst, tab,
  287.                                        itemStr(item_set, i), tab,
  288.                                        '(', rule_no-1, ')')
  289.                       else
  290.                         writeln(yylst, tab, itemStr(item_set, i));
  291.               end;
  292.  
  293.             (* List parse actions. *)
  294.  
  295.             (* shift, reduce and default actions: *)
  296.  
  297.             if (n_shifts+n_errors=0) and (n_reductions=1) then
  298.               (* default action is the reduction *)
  299.               with redn_table^[redns_lo] do
  300.                 begin
  301.                   writeln(yylst);
  302.                   writeln(yylst, tab, '.', tab, 'reduce ', rule_no-1 );
  303.                 end
  304.             else
  305.               (* default action is error *)
  306.               begin
  307.                 writeln(yylst);
  308.                 for i := trans_lo to trans_hi do with trans_table^[i] do
  309.                   if next_state<>-1 then
  310.                     if sym=0 then
  311.                       (* accept action *)
  312.                       writeln(yylst, tab, pname(sym), tab, 'accept')
  313.                     else if sym>0 then
  314.                       (* shift action *)
  315.                       writeln(yylst, tab,
  316.                                      pname(sym), tab, 'shift ', next_state);
  317.                 for i := redns_lo to redns_hi do
  318.                   with redn_table^[i] do
  319.                     for j := 1 to size(symset^) do
  320.                       (* reduce action *)
  321.                       writeln(yylst, tab,
  322.                                      pname(symset^[j]), tab, 'reduce ',
  323.                                      rule_no-1);
  324.                 (* error action *)
  325.                 writeln(yylst, tab, '.', tab, 'error');
  326.               end;
  327.  
  328.             (* goto actions: *)
  329.  
  330.             if n_gotos>0 then
  331.               begin
  332.                 writeln(yylst);
  333.                 for i := trans_lo to trans_hi do with trans_table^[i] do
  334.                   if sym<0 then
  335.                     writeln(yylst, tab,
  336.                                    pname(sym), tab, 'goto ', next_state);
  337.               end;
  338.  
  339.           end;
  340.  
  341.       end;
  342.  
  343.     for i := 2 to n_rules do
  344.       if not reduced[i] then inc(never_reduced);
  345.  
  346.     if verbose then
  347.       begin
  348.         writeln(yylst);
  349.         if shift_reduce>0 then
  350.           writeln(yylst, shift_reduce, ' shift/reduce conflicts.');
  351.         if reduce_reduce>0 then
  352.           writeln(yylst, reduce_reduce, ' reduce/reduce conflicts.');
  353.         if never_reduced>0 then
  354.           writeln(yylst, never_reduced, ' rules never reduced.');
  355.       end;
  356.  
  357.     (* report rules never reduced: *)
  358.  
  359.     if (never_reduced>0) and verbose then
  360.       begin
  361.         writeln(yylst);
  362.         writeln(yylst, '*** rules never reduced:');
  363.         for i := 2 to n_rules do if not reduced[i] then
  364.           begin
  365.             writeln(yylst);
  366.             writeln(yylst, ruleStr(i), tab, '(', i-1, ')');
  367.           end;
  368.       end;
  369.  
  370.   end(*build*);
  371.  
  372. procedure counters;
  373.  
  374.   (* initialize counters and offsets *)
  375.  
  376.   var s, i : Integer;
  377.  
  378.   begin
  379.  
  380.     yynstates := n_states; yynacts := 0; yyngotos := 0;
  381.  
  382.     for s := 0 to n_states-1 do with state_table^[s] do
  383.       begin
  384.         yyal[s] := yynacts+1; yygl[s] := yyngotos+1;
  385.         if yyd[s]=0 then
  386.           begin
  387.             for i := trans_lo to trans_hi do with trans_table^[i] do
  388.               if (sym>=0) and (next_state<>-1) then
  389.                 inc(yynacts);
  390.             for i := redns_lo to redns_hi do with redn_table^[i] do
  391.               inc(yynacts, size(symset^));
  392.           end;
  393.         for i := trans_lo to trans_hi do with trans_table^[i] do
  394.           if sym<0 then
  395.             inc(yyngotos);
  396.         yyah[s] := yynacts; yygh[s] := yyngotos;
  397.       end;
  398.  
  399.   end(*counters*);
  400.  
  401. procedure tables;
  402.  
  403.   (* write tables to output file *)
  404.  
  405.   var s, i, j, count : Integer;
  406.  
  407.   begin
  408.  
  409.     writeln(yyout);
  410.     writeln(yyout, 'type YYARec = record');
  411.     writeln(yyout, '                sym, act : Integer;');
  412.     writeln(yyout, '              end;');
  413.     writeln(yyout, '     YYRRec = record');
  414.     writeln(yyout, '                len, sym : Integer;');
  415.     writeln(yyout, '              end;');
  416.     writeln(yyout);
  417.     writeln(yyout, 'const');
  418.  
  419.     (* counters: *)
  420.  
  421.     writeln(yyout);
  422.     writeln(yyout, 'yynacts   = ', yynacts, ';');
  423.     writeln(yyout, 'yyngotos  = ', yyngotos, ';');
  424.     writeln(yyout, 'yynstates = ', yynstates, ';');
  425.     writeln(yyout, 'yynrules  = ', n_rules-1, ';');
  426.  
  427.     (* shift/reduce table: *)
  428.  
  429.     writeln(yyout);
  430.     writeln(yyout, 'yya : array [1..yynacts] of YYARec = (');
  431.     count := 0;
  432.     for s := 0 to n_states-1 do with state_table^[s] do
  433.       begin
  434.         writeln(yyout, '{ ', s, ': }');
  435.         if yyd[s]=0 then
  436.           begin
  437.             for i := trans_lo to trans_hi do with trans_table^[i] do
  438.               if (next_state<>-1) and (sym>=0) then
  439.                 begin
  440.                   inc(count);
  441.                   if sym=0 then
  442.                     write(yyout, '  ( sym: 0; act: 0 )')
  443.                   else
  444.                     write(yyout, '  ( sym: ', sym, '; act: ',
  445.                                  next_state, ' )');
  446.                   if count<yynacts then write(yyout, ',');
  447.                   writeln(yyout);
  448.                 end;
  449.             for i := redns_lo to redns_hi do with redn_table^[i] do
  450.               for j := 1 to size(symset^) do
  451.                 begin
  452.                   inc(count);
  453.                   write(yyout, '  ( sym: ', symset^[j], '; act: ',
  454.                                -(rule_no-1), ' )');
  455.                   if count<yynacts then write(yyout, ',');
  456.                   writeln(yyout);
  457.                 end;
  458.         end;
  459.       end;
  460.     writeln(yyout, ');');
  461.  
  462.     (* goto table: *)
  463.  
  464.     writeln(yyout);
  465.     writeln(yyout, 'yyg : array [1..yyngotos] of YYARec = (');
  466.     count := 0;
  467.     for s := 0 to n_states-1 do with state_table^[s] do
  468.       begin
  469.         writeln(yyout, '{ ', s, ': }');
  470.         for i := trans_lo to trans_hi do with trans_table^[i] do
  471.           if sym<0 then
  472.             begin
  473.               inc(count);
  474.               write(yyout, '  ( sym: ', sym, '; act: ', next_state, ' )');
  475.               if count<yyngotos then write(yyout, ',');
  476.               writeln(yyout);
  477.             end;
  478.       end;
  479.     writeln(yyout, ');');
  480.  
  481.     (* default action table: *)
  482.  
  483.     writeln(yyout);
  484.     writeln(yyout, 'yyd : array [0..yynstates-1] of Integer = (');
  485.     for s := 0 to n_states-1 do
  486.       begin
  487.         write(yyout, '{ ', s, ': } ', yyd[s]);
  488.         if s<n_states-1 then write(yyout, ',');
  489.         writeln(yyout);
  490.       end;
  491.     writeln(yyout, ');');
  492.  
  493.     (* offset tables: *)
  494.  
  495.     writeln(yyout);
  496.     writeln(yyout, 'yyal : array [0..yynstates-1] of Integer = (');
  497.     for s := 0 to n_states-1 do
  498.       begin
  499.         write(yyout, '{ ', s, ': } ', yyal[s]);
  500.         if s<n_states-1 then write(yyout, ',');
  501.         writeln(yyout);
  502.       end;
  503.     writeln(yyout, ');');
  504.     writeln(yyout);
  505.     writeln(yyout, 'yyah : array [0..yynstates-1] of Integer = (');
  506.     for s := 0 to n_states-1 do
  507.       begin
  508.         write(yyout, '{ ', s, ': } ', yyah[s]);
  509.         if s<n_states-1 then write(yyout, ',');
  510.         writeln(yyout);
  511.       end;
  512.     writeln(yyout, ');');
  513.     writeln(yyout);
  514.     writeln(yyout, 'yygl : array [0..yynstates-1] of Integer = (');
  515.     for s := 0 to n_states-1 do
  516.       begin
  517.         write(yyout, '{ ', s, ': } ', yygl[s]);
  518.         if s<n_states-1 then write(yyout, ',');
  519.         writeln(yyout);
  520.       end;
  521.     writeln(yyout, ');');
  522.     writeln(yyout);
  523.     writeln(yyout, 'yygh : array [0..yynstates-1] of Integer = (');
  524.     for s := 0 to n_states-1 do
  525.       begin
  526.         write(yyout, '{ ', s, ': } ', yygh[s]);
  527.         if s<n_states-1 then write(yyout, ',');
  528.         writeln(yyout);
  529.       end;
  530.     writeln(yyout, ');');
  531.  
  532.     (* rule table: *)
  533.  
  534.     writeln(yyout);
  535.     writeln(yyout, 'yyr : array [1..yynrules] of YYRRec = (');
  536.     for i := 2 to n_rules do with rule_table^[i]^ do
  537.       begin
  538.         write(yyout, '{ ', i-1, ': } ', '( len: ', rhs_len,
  539.                                         '; sym: ', lhs_sym, ' )');
  540.         if i<n_rules then write(yyout, ',');
  541.         writeln(yyout);
  542.       end;
  543.     writeln(yyout, ');');
  544.  
  545.     writeln(yyout);
  546.  
  547.   end(*tables*);
  548.  
  549. procedure parse_table;
  550.   begin
  551.     build; counters; tables;
  552.   end(*parse_table*);
  553.  
  554. end(*YaccParseTable*).
  555.