yacctabl.pas

Yacc例子代码

      begin
        if sym_table^[type_table^[k]].pname^<symbol then
          l := succ(k)
        else
          r := pred(k);
        k := l + (r-l) div 2;
      end;
    search_type := (k<=n_types) and (sym_table^[type_table^[k]].pname^=symbol);
  end(*search_type*);

(* Precedence table routines: *)

function new_prec_level ( prec_type : PrecType ) : Integer;
  begin
    inc(n_prec);
    if n_prec>max_prec then fatal(prec_table_overflow);
    prec_table^[n_prec] := prec_type;
    new_prec_level := n_prec;
  end(*new_prec_level*);

(* State table: *)

procedure new_state;
  begin
    inc(n_states);
    if n_states>max_states then fatal(state_table_overflow);
    state_table^[n_states-1].item_lo := n_items+1;
  end(*new_state*);

procedure add_item ( rule_no, pos_no : Integer );
  begin
    inc(n_items);
    if n_items>max_items then fatal(item_table_overflow);
    item_table^[n_items].rule_no := rule_no;
    item_table^[n_items].pos_no  := pos_no;
    item_table^[n_items].next    := 0;
  end(*add_item*);

function add_state : Integer;
  function state_key ( s : Integer ) : Integer;
    (* determines a hash key for state s *)
    const max_key = 4001;
      (* should be prime number s.t. hash keys are distributed
         evenly *)
    var i, k : Integer;
    begin
      with state_table^[s] do
        begin
          k := 0;
          for i := item_lo to item_hi do
            with item_table^[i] do
              inc(k, rule_no+pos_no);
          state_key := k mod max_key;
        end;
    end(*state_key*);
  function search_state ( s, lo, hi : Integer; var t : Integer ) : Boolean;
    (* searches the range lo..hi in the state table for a state with the
       same kernel items as s; returns true if found, and then the
       corresponding state number in t *)
    function eq_items(s, t : Integer) : Boolean;
      (* compares kernel item sets of states s and t *)
      var i, i_s, i_t : Integer;
      begin
        if n_state_items(s)<>n_state_items(t) then
          eq_items := false
        else
          begin
            i_s := state_table^[s].item_lo;
            i_t := state_table^[t].item_lo;
            for i := 0 to n_state_items(s)-1 do
              if (item_table^[i_s+i].rule_no<>item_table^[i_t+i].rule_no) or
                 (item_table^[i_s+i].pos_no<>item_table^[i_t+i].pos_no) then
                begin
                  eq_items := false;
                  exit;
                end;
            eq_items := true;
          end
      end(*eq_items*);
    var t1 : Integer;
    begin
      with state_table^[s] do
        for t1 := lo to hi do
          if (key=state_table^[t1].key) and
             eq_items(s, t1) then
            begin
              search_state := true;
              t := t1;
              exit;
            end;
      search_state := false;
    end(*search_state*);
  var s : Integer;
  begin
    with state_table^[n_states-1] do
      begin
        item_hi := n_items;
        key := state_key(n_states-1);
        if search_state(n_states-1, 0, n_states-2, s) then
          begin
            n_items := item_lo;
            dec(n_states);
            add_state := s;
          end
        else
          add_state := n_states-1;
      end;
  end(*add_state*);

procedure start_trans;
  begin
    state_table^[act_state].trans_lo := n_trans+1;
  end(*start_trans*);

procedure add_trans ( sym, next_state : Integer );
  begin
    inc(n_trans);
    if n_trans>max_trans then fatal(trans_table_overflow);
    trans_table^[n_trans].sym        := sym;
    trans_table^[n_trans].next_state := next_state;
  end(*add_trans*);

procedure end_trans;
  begin
    state_table^[act_state].trans_hi := n_trans;
  end(*end_trans*);

procedure start_redns;
  begin
    state_table^[act_state].redns_lo := n_redns+1;
  end(*start_redns*);

procedure add_redn ( symset : IntSetPtr; rule_no : Integer );
  begin
    inc(n_redns);
    if n_redns>max_redns then fatal(redn_table_overflow);
    redn_table^[n_redns].symset  := symset;
    redn_table^[n_redns].rule_no := rule_no;
  end(*add_redn*);

procedure end_redns;
  begin
    state_table^[act_state].redns_hi := n_redns;
  end(*end_redns*);

function n_state_items ( s : Integer ) : Integer;
  begin
    with state_table^[s] do
      n_state_items := item_hi-item_lo+1
  end(*n_state_items*);

function n_state_trans ( s : Integer ) : Integer;
  begin
    with state_table^[s] do
      n_state_trans := trans_hi-trans_lo+1
  end(*n_state_trans*);

function n_state_redns ( s : Integer ) : Integer;
  begin
    with state_table^[s] do
      n_state_redns := redns_hi-redns_lo+1
  end(*n_state_redns*);

function find_item( s : Integer; rule_no, pos_no : Integer ) : Integer;
  var i : Integer;
  begin
    with state_table^[s] do
      for i := item_lo to item_hi do
        if (item_table^[i].rule_no=rule_no) and
           (item_table^[i].pos_no=pos_no) then
          begin
            find_item := i;
            exit;
          end;
    find_item := 0;
  end(*find_item*);

(* Item set routines: *)

procedure empty_item_set ( var item_set : ItemSet );
  begin
    item_set.n_items := 0;
  end(*empty_item_set*);

procedure include_item_set ( var item_set : ItemSet;
                             rule_no, pos_no : Integer);
  begin
    with item_set do
      begin
        inc(n_items);
        if n_items>max_set_items then fatal(item_table_overflow);
        item[n_items].rule_no := rule_no;
        item[n_items].pos_no  := pos_no;
      end;
  end(*include_item_set*);

procedure get_item_set ( s : Integer; var item_set : ItemSet);
  begin
    with state_table^[s], item_set do
      begin
        n_items := n_state_items(s);
        move(item_table^[item_lo], item, n_items*sizeOf(ItemRec));
      end
  end(*get_item_set*);

procedure closure ( var item_set : ItemSet );
  var i, j : Integer;
      nt_syms0, nt_syms : IntSet;
  begin
    with item_set do
      begin
        (* get the nonterminals at current positions in items: *)
        empty(nt_syms0);
        for i := 1 to n_items do
          with item[i], rule_table^[rule_no]^ do
            if (pos_no<=rhs_len) and (rhs_sym[pos_no]<0) then
              include(nt_syms0, rhs_sym[pos_no]);
        nt_syms := nt_syms0;
        (* add closure symbols: *)
        for i := 1 to size(nt_syms0) do
          setunion(nt_syms, closure_table^[-nt_syms0[i]]^);
        (* add the nonkernel items for the nonterminal symbols: *)
        for i := 1 to size(nt_syms) do
          with rule_offs^[-nt_syms[i]] do
            for j := rule_lo to rule_hi do
              include_item_set(item_set, rule_no^[j], 1);
      end;
  end(*closure*);

var sort_items : ItemSet;

(* comparison and swap routines for sort_item_set: *)

{$ifndef fpc}{$F+}{$endif}
function items_less ( i, j : Integer ) : Boolean;
{$ifndef fpc}{$F-}{$endif}
  begin
    with sort_items do
      if item[i].pos_no=item[j].pos_no then
        items_less := item[i].rule_no<item[j].rule_no
      else
        items_less := item[i].pos_no>item[j].pos_no
  end(*items_less*);

{$ifndef fpc}{$F+}{$endif}
procedure items_swap ( i, j : Integer );
{$ifndef fpc}{$F-}{$endif}
  var x : ItemRec;
  begin
    with sort_items do
      begin
        x := item[i]; item[i] := item[j]; item[j] := x;
      end
  end(*items_swap*);

procedure sort_item_set ( var item_set : ItemSet );
  begin
    sort_items := item_set;
    quicksort(1, sort_items.n_items, {$ifdef fpc}@{$endif}items_less,
	      {$ifdef fpc}@{$endif}items_swap);
    item_set := sort_items;
  end(*sort_item_set*);

var i : Integer;

begin

  verbose          := false;
  debug            := false;
  startnt          := 0;

{$IFNDEF Win32}
  max_bytes := memAvail;
{$ENDIF}

  n_nts            := 1;
  n_lits           := 257;
  n_rules          := 0;
  n_types          := 0;
  n_prec           := 0;
  n_states         := 0;
  n_items          := 0;
  n_trans          := 0;
  n_redns          := 0;

  (* allocate tables: *)

  new(sym_table);
  new(sym_key);
  new(rule_table);
  new(rule_no);
  new(rule_offs);
  new(type_table);
  new(sym_type);
  new(prec_table);
  new(sym_prec);
  new(rule_prec);
  new(closure_table);
  new(first_set_table);
  new(nullable);
  new(state_table);
  new(item_table);
  new(trans_table);
  new(redn_table);
  new(lookahead_table);
  new(prop_table);

  (* initialize symbol table: *)

  for i := 1 to max_keys do
    with sym_table^[i] do
      begin
        pname := nil;
        deff  := false;
      end;

  (* enter predefined error symbol into symbol table: *)

  def_key(get_key('error'), 256);

  (* initialize type and precedence tables: *)

  for i := -max_nts to max_lits-1 do sym_type^[i] := 0;
  for i := 0 to max_lits-1 do sym_prec^[i] := 0;
  for i := 1 to max_rules do rule_prec^[i] := 0;

end(*YaccTables*).