lextable.pas

Yacc例子代码

  begin
    inc(n_pos);
    if n_pos>max_pos then fatal(pos_table_overflow);
    pos_table^[n_pos].follow_pos     := newIntSet;
    pos_table^[n_pos].pos_type       := cclass_pos;
    pos_table^[n_pos].cc             := cc;
  end(*addCClassPos*);

procedure addMarkPos(rule, pos : Integer);
  begin
    inc(n_pos);
    if n_pos>max_pos then fatal(pos_table_overflow);
    pos_table^[n_pos].follow_pos     := newIntSet;
    pos_table^[n_pos].pos_type       := mark_pos;
    pos_table^[n_pos].rule           := rule;
    pos_table^[n_pos].pos            := pos;
  end(*addMarkPos*);

(* Routines to build the state table: *)

function newState(POS : IntSetPtr) : Integer;
  begin
    if n_states>=max_states then fatal(state_table_overflow);
    newState := n_states;
    with state_table^[n_states] do
      begin
        state_pos := POS;
        final     := false;
      end;
    inc(n_states);
  end(*newState*);

function addState(POS : IntSetPtr) : Integer;
  var i : Integer;
  begin
    for i := 0 to pred(n_states) do
      if equal(POS^, state_table^[i].state_pos^) then
        begin
          addState := i;
          exit;
        end;
    addState := newState(POS);
  end(*addState*);

procedure startStateTrans;
  begin
    state_table^[act_state].trans_lo := succ(n_trans);
  end(*startStateTrans*);

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

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

(* Construction of the transition table:
   This implementation here uses a simple optimization which tries to avoid
   the construction of different transitions for each individual character
   in large character classes by MERGING transitions whenever possible. The
   transitions, at any time, will be partitioned into transitions on disjoint
   character classes. When adding a new transition on character class cc, we
   repartition the transitions as follows:
   1. If the current character class cc equals an existing one, we can
      simply add the new follow set to the existing one.
   2. Otherwise, for some existing transition on some character class
      cc1 with cc*cc1<>[], we replace the existing transition by a new
      transition on cc*cc1 with follow set = cc1's follow set + cc's follow
      set, and, if necessary (i.e. if cc1-cc is nonempty), a transition on
      cc1-cc with follow set = cc1's follow set. We then remove the elements
      of cc1 from cc, and proceed again with step 1.
   We may stop this process as soon as cc becomes empty (then all characters
   in cc have been distributed among the existing partitions). If cc does
   NOT become empty, we have to construct a new transition for the remaining
   character class (which then will be disjoint from all other character
   classes in the transition table). *)

procedure addTrans(cc : CClass; FOLLOW : IntSetPtr);
  var
    i : Integer;
    cc0, cc1, cc2 : CClass;
  begin
    for i := state_table^[act_state].trans_lo to n_trans do
      if trans_table^[i].cc^=cc then
        begin
          setunion(trans_table^[i].follow_pos^, FOLLOW^);
          exit
        end
      else
        begin
          cc0 := cc*trans_table^[i].cc^;
          if cc0<>[] then
            begin
              cc1 := trans_table^[i].cc^-cc;
              cc2 := cc-trans_table^[i].cc^;
              if cc1<>[] then
                begin
                  trans_table^[i].cc^ := cc1;
                  inc(n_trans);
                  if n_trans>max_trans then fatal(trans_table_overflow);
                  trans_table^[n_trans].cc := newCClass(cc0);
                  trans_table^[n_trans].follow_pos := newIntSet;
                  trans_table^[n_trans].follow_pos^ :=
                    trans_table^[i].follow_pos^;
                  setunion(trans_table^[n_trans].follow_pos^, FOLLOW^);
                end
              else
                begin
                  trans_table^[i].cc^ := cc0;
                  setunion(trans_table^[i].follow_pos^, FOLLOW^);
                end;
              cc := cc2;
              if cc=[] then exit;
            end
        end;
    inc(n_trans);
    if n_trans>max_trans then fatal(trans_table_overflow);
    trans_table^[n_trans].cc          := newCClass(cc);
    trans_table^[n_trans].follow_pos  := newIntSet;
    trans_table^[n_trans].follow_pos^ := FOLLOW^;
  end(*addCharTrans*);

(* comparison and swap procedures for sorting transitions: *)
{$ifndef fpc}{$F+}{$endif}
function transLessNextState(i, j : Integer) : Boolean;
{$ifndef fpc}{$F-}{$endif}
  (* compare transitions based on next states (used in mergeCharTrans) *)
  begin
    transLessNextState := trans_table^[i].next_state<
                          trans_table^[j].next_state
  end(*transLessNextState*);
{$ifndef fpc}{$F+}{$endif}
function transLess(i, j : Integer) : Boolean;
{$ifndef fpc}{$F-}{$endif}
  (* lexical order on transitions *)
  var c : Char; xi, xj : Boolean;
  begin
    for c := #0 to #255 do
      begin
        xi := c in trans_table^[i].cc^;
        xj := c in trans_table^[j].cc^;
        if xi<>xj then
          begin
            transLess := ord(xi)>ord(xj);
            exit
          end;
      end;
    transLess := false
  end(*transLess*);
{$ifndef fpc}{$F+}{$endif}
procedure transSwap(i, j : Integer);
{$ifndef fpc}{$F-}{$endif}
  (* swap transitions i and j *)
  var x : TransTableEntry;
  begin
    x := trans_table^[i];
    trans_table^[i] := trans_table^[j];
    trans_table^[j] := x;
  end(*transSwap*);

procedure mergeTrans;
  var
    i, j, n_deleted : Integer;
  begin
    (* sort transitions w.r.t. next states: *)
    quicksort(state_table^[act_state].trans_lo,
              n_trans,
              {$ifdef fpc}@{$endif}transLessNextState,
              {$ifdef fpc}@{$endif}transSwap);
    (* merge transitions for the same next state: *)
    n_deleted := 0;
    for i := state_table^[act_state].trans_lo to n_trans do
    if trans_table^[i].cc<>nil then
      begin
        j := succ(i);
        while (j<=n_trans) and
              (trans_table^[i].next_state =
               trans_table^[j].next_state) do
          begin
            (* merge cclasses of transitions i and j, then mark
               transition j as deleted *)
            trans_table^[i].cc^ := trans_table^[i].cc^+
                                   trans_table^[j].cc^;
            trans_table^[j].cc  := nil;
            inc(n_deleted);
            inc(j);
          end;
      end;
    (* remove deleted transitions: *)
    j := state_table^[act_state].trans_lo;
    for i := state_table^[act_state].trans_lo to n_trans do
      if trans_table^[i].cc<>nil then
        if i<>j then
          begin
            trans_table^[j] := trans_table^[i];
            inc(j);
          end
        else
          inc(j);
    (* update transition count: *)
    dec(n_trans, n_deleted);
  end(*mergeTrans*);

procedure sortTrans;
  begin
    quicksort(state_table^[act_state].trans_lo,
              n_trans,
              {$ifdef fpc}@{$endif}transLess,
              {$ifdef fpc}@{$endif}transSwap);
  end(*sortTrans*);

var i : Integer;

begin

  verbose          := false;
  optimize         := false;

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

  n_pos            := 0;
  n_states         := 0;
  n_trans          := 0;
  n_start_states   := 0;

  (* allocate tables: *)

  new(sym_table);
  new(pos_table);
  new(first_pos_table);
  new(state_table);
  new(trans_table);

  (* initialize symbol table: *)

  for i := 1 to max_keys do sym_table^[i].pname := nil;

end(*LexTables*).