yaccpars.pas

Yacc例子代码

        for i := redns_lo to redns_hi do
          with redn_table^[i] do
            reduced[rule_no] := true;

        if verbose then

          begin

            (* List kernel items. *)

            writeln(yylst);
            get_item_set(s, item_set);
            closure(item_set);
            sort_item_set(item_set);
            with item_set do
              begin
                for i := 1 to n_items do
                  with item[i], rule_table^[rule_no]^ do
                    if (rule_no=1) or (pos_no>1) or (rhs_len=0) then
                      if pos_no>rhs_len then
                        writeln(yylst, tab,
                                       itemStr(item_set, i), tab,
                                       '(', rule_no-1, ')')
                      else
                        writeln(yylst, tab, itemStr(item_set, i));
              end;

            (* List parse actions. *)

            (* shift, reduce and default actions: *)

            if (n_shifts+n_errors=0) and (n_reductions=1) then
              (* default action is the reduction *)
              with redn_table^[redns_lo] do
                begin
                  writeln(yylst);
                  writeln(yylst, tab, '.', tab, 'reduce ', rule_no-1 );
                end
            else
              (* default action is error *)
              begin
                writeln(yylst);
                for i := trans_lo to trans_hi do with trans_table^[i] do
                  if next_state<>-1 then
                    if sym=0 then
                      (* accept action *)
                      writeln(yylst, tab, pname(sym), tab, 'accept')
                    else if sym>0 then
                      (* shift action *)
                      writeln(yylst, tab,
                                     pname(sym), tab, 'shift ', next_state);
                for i := redns_lo to redns_hi do
                  with redn_table^[i] do
                    for j := 1 to size(symset^) do
                      (* reduce action *)
                      writeln(yylst, tab,
                                     pname(symset^[j]), tab, 'reduce ',
                                     rule_no-1);
                (* error action *)
                writeln(yylst, tab, '.', tab, 'error');
              end;

            (* goto actions: *)

            if n_gotos>0 then
              begin
                writeln(yylst);
                for i := trans_lo to trans_hi do with trans_table^[i] do
                  if sym<0 then
                    writeln(yylst, tab,
                                   pname(sym), tab, 'goto ', next_state);
              end;

          end;

      end;

    for i := 2 to n_rules do
      if not reduced[i] then inc(never_reduced);

    if verbose then
      begin
        writeln(yylst);
        if shift_reduce>0 then
          writeln(yylst, shift_reduce, ' shift/reduce conflicts.');
        if reduce_reduce>0 then
          writeln(yylst, reduce_reduce, ' reduce/reduce conflicts.');
        if never_reduced>0 then
          writeln(yylst, never_reduced, ' rules never reduced.');
      end;

    (* report rules never reduced: *)

    if (never_reduced>0) and verbose then
      begin
        writeln(yylst);
        writeln(yylst, '*** rules never reduced:');
        for i := 2 to n_rules do if not reduced[i] then
          begin
            writeln(yylst);
            writeln(yylst, ruleStr(i), tab, '(', i-1, ')');
          end;
      end;

  end(*build*);

procedure counters;

  (* initialize counters and offsets *)

  var s, i : Integer;

  begin

    yynstates := n_states; yynacts := 0; yyngotos := 0;

    for s := 0 to n_states-1 do with state_table^[s] do
      begin
        yyal[s] := yynacts+1; yygl[s] := yyngotos+1;
        if yyd[s]=0 then
          begin
            for i := trans_lo to trans_hi do with trans_table^[i] do
              if (sym>=0) and (next_state<>-1) then
                inc(yynacts);
            for i := redns_lo to redns_hi do with redn_table^[i] do
              inc(yynacts, size(symset^));
          end;
        for i := trans_lo to trans_hi do with trans_table^[i] do
          if sym<0 then
            inc(yyngotos);
        yyah[s] := yynacts; yygh[s] := yyngotos;
      end;

  end(*counters*);

procedure tables;

  (* write tables to output file *)

  var s, i, j, count : Integer;

  begin

    writeln(yyout);
    writeln(yyout, 'type YYARec = record');
    writeln(yyout, '                sym, act : Integer;');
    writeln(yyout, '              end;');
    writeln(yyout, '     YYRRec = record');
    writeln(yyout, '                len, sym : Integer;');
    writeln(yyout, '              end;');
    writeln(yyout);
    writeln(yyout, 'const');

    (* counters: *)

    writeln(yyout);
    writeln(yyout, 'yynacts   = ', yynacts, ';');
    writeln(yyout, 'yyngotos  = ', yyngotos, ';');
    writeln(yyout, 'yynstates = ', yynstates, ';');
    writeln(yyout, 'yynrules  = ', n_rules-1, ';');

    (* shift/reduce table: *)

    writeln(yyout);
    writeln(yyout, 'yya : array [1..yynacts] of YYARec = (');
    count := 0;
    for s := 0 to n_states-1 do with state_table^[s] do
      begin
        writeln(yyout, '{ ', s, ': }');
        if yyd[s]=0 then
          begin
            for i := trans_lo to trans_hi do with trans_table^[i] do
              if (next_state<>-1) and (sym>=0) then
                begin
                  inc(count);
                  if sym=0 then
                    write(yyout, '  ( sym: 0; act: 0 )')
                  else
                    write(yyout, '  ( sym: ', sym, '; act: ',
                                 next_state, ' )');
                  if count<yynacts then write(yyout, ',');
                  writeln(yyout);
                end;
            for i := redns_lo to redns_hi do with redn_table^[i] do
              for j := 1 to size(symset^) do
                begin
                  inc(count);
                  write(yyout, '  ( sym: ', symset^[j], '; act: ',
                               -(rule_no-1), ' )');
                  if count<yynacts then write(yyout, ',');
                  writeln(yyout);
                end;
        end;
      end;
    writeln(yyout, ');');

    (* goto table: *)

    writeln(yyout);
    writeln(yyout, 'yyg : array [1..yyngotos] of YYARec = (');
    count := 0;
    for s := 0 to n_states-1 do with state_table^[s] do
      begin
        writeln(yyout, '{ ', s, ': }');
        for i := trans_lo to trans_hi do with trans_table^[i] do
          if sym<0 then
            begin
              inc(count);
              write(yyout, '  ( sym: ', sym, '; act: ', next_state, ' )');
              if count<yyngotos then write(yyout, ',');
              writeln(yyout);
            end;
      end;
    writeln(yyout, ');');

    (* default action table: *)

    writeln(yyout);
    writeln(yyout, 'yyd : array [0..yynstates-1] of Integer = (');
    for s := 0 to n_states-1 do
      begin
        write(yyout, '{ ', s, ': } ', yyd[s]);
        if s<n_states-1 then write(yyout, ',');
        writeln(yyout);
      end;
    writeln(yyout, ');');

    (* offset tables: *)

    writeln(yyout);
    writeln(yyout, 'yyal : array [0..yynstates-1] of Integer = (');
    for s := 0 to n_states-1 do
      begin
        write(yyout, '{ ', s, ': } ', yyal[s]);
        if s<n_states-1 then write(yyout, ',');
        writeln(yyout);
      end;
    writeln(yyout, ');');
    writeln(yyout);
    writeln(yyout, 'yyah : array [0..yynstates-1] of Integer = (');
    for s := 0 to n_states-1 do
      begin
        write(yyout, '{ ', s, ': } ', yyah[s]);
        if s<n_states-1 then write(yyout, ',');
        writeln(yyout);
      end;
    writeln(yyout, ');');
    writeln(yyout);
    writeln(yyout, 'yygl : array [0..yynstates-1] of Integer = (');
    for s := 0 to n_states-1 do
      begin
        write(yyout, '{ ', s, ': } ', yygl[s]);
        if s<n_states-1 then write(yyout, ',');
        writeln(yyout);
      end;
    writeln(yyout, ');');
    writeln(yyout);
    writeln(yyout, 'yygh : array [0..yynstates-1] of Integer = (');
    for s := 0 to n_states-1 do
      begin
        write(yyout, '{ ', s, ': } ', yygh[s]);
        if s<n_states-1 then write(yyout, ',');
        writeln(yyout);
      end;
    writeln(yyout, ');');

    (* rule table: *)

    writeln(yyout);
    writeln(yyout, 'yyr : array [1..yynrules] of YYRRec = (');
    for i := 2 to n_rules do with rule_table^[i]^ do
      begin
        write(yyout, '{ ', i-1, ': } ', '( len: ', rhs_len,
                                        '; sym: ', lhs_sym, ' )');
        if i<n_rules then write(yyout, ',');
        writeln(yyout);
      end;
    writeln(yyout, ');');

    writeln(yyout);

  end(*tables*);

procedure parse_table;
  begin
    build; counters; tables;
  end(*parse_table*);

end(*YaccParseTable*).