cra.pas

一个Pascal语言分析器

    p := lista;
    WHILE p <> NIL DO BEGIN
      NEW(t); t^.theState := p^.theState; AddTarget(t, listb); p := p^.next
    END
  END;

(* NewMelted            Generate new info about a melted state
------------------------------------------------------------------------*) 

FUNCTION NewMelted (sset : CRTable.CRTSet; s : INTEGER) : Melted;
  VAR
    melt : Melted;
  BEGIN
    NEW(melt);
    melt^.sset := sset; melt^.theState := s; melt^.next := firstMelted;
    firstMelted := melt; NewMelted := melt
  END;

(* NewState             Return a new state node
------------------------------------------------------------------------*) 

FUNCTION NewState : INTEGER;
  BEGIN
    INC(lastState);
    IF lastState > maxStates THEN CRTable.Restriction(7, maxStates);
    stateArray[lastState].firstAction := NIL;
    stateArray[lastState].endOf := CRTable.noSym;
    stateArray[lastState].ctx := FALSE;
    NewState := lastState
  END;

(* NewTransition        Generate transition (gn.theState, gn.p1) --> toState
------------------------------------------------------------------------*) 

PROCEDURE NewTransition (from : INTEGER; gn : CRTable.GraphNode; toState : INTEGER);
  VAR
    a : Action;
    t : Target;
  BEGIN
    IF toState = rootState THEN SemErr(21);
    NEW(t); t^.theState := toState; t^.next := NIL;
    NEW(a); a^.typ := gn.typ; a^.sym := gn.p1; a^.tc := gn.p2; a^.target := t;
    AddAction(a, stateArray[from].firstAction)
  END;

(* NewComment           Define new comment
-------------------------------------------------------------------------*) 

PROCEDURE NewComment (start, stop : INTEGER; nested : BOOLEAN);
  VAR
    com : Comment;

  PROCEDURE MakeStr (gp : INTEGER; VAR s : STRING2);
    VAR
      i, n : INTEGER;
      gn : CRTable.GraphNode;
      sset : CRTable.CRTSet;
    BEGIN
      i := 1;
      WHILE gp <> 0 DO BEGIN
        CRTable.GetNode(gp, gn);
        IF gn.typ = CRTable.chart
          THEN
            BEGIN IF i < 3 THEN s[i] := CHR(gn.p1); INC(i) END
          ELSE IF gn.typ = CRTable.class THEN
            BEGIN
              CRTable.GetClass(gn.p1, sset);
              IF Sets.Elements(sset, n) <> 1 THEN SemErr(26);
              IF i < 3 THEN s[i] := CHR(n);
              INC(i)
            END
          ELSE SemErr(22);
        gp := gn.next
      END;
      IF (i = 1) OR (i > 3) THEN SemErr(25) ELSE s[0] := CHR(i-1)
    END;

  BEGIN
    NEW(com);
    MakeStr(start, com^.start);
    MakeStr(stop, com^.stop);
    com^.nested := nested;
    com^.next := firstComment;
    firstComment := com
  END;

(* DeleteTargetList     Delete a target list
-------------------------------------------------------------------------*) 

PROCEDURE DeleteTargetList (list : Target);
  BEGIN
    IF list <> NIL THEN BEGIN DeleteTargetList(list^.next); DISPOSE(list) END;
  END;

(* DeleteActionList     Delete an action list
-------------------------------------------------------------------------*) 

PROCEDURE DeleteActionList (anAction : Action);
  BEGIN
    IF anAction <> NIL THEN
      BEGIN
        DeleteActionList(anAction^.next);
        DeleteTargetList(anAction^.target);
        DISPOSE(anAction)
      END
  END;

(* MakeSet              Expand action symbol into symbol set
-------------------------------------------------------------------------*) 

PROCEDURE MakeSet (p : Action; VAR sset : CRTable.CRTSet);
  BEGIN
    IF p^.typ = CRTable.class
      THEN CRTable.GetClass(p^.sym, sset)
      ELSE BEGIN Sets.Clear(sset); Sets.Incl(sset, p^.sym) END
  END;

(* ChangeAction         Change the action symbol to set
-------------------------------------------------------------------------*) 

PROCEDURE ChangeAction (a : Action; sset : CRTable.CRTSet);
  VAR
    nr : INTEGER;

  BEGIN
    IF Sets.Elements(sset, nr) = 1
      THEN BEGIN a^.typ := CRTable.chart; a^.sym := nr END
      ELSE
        BEGIN
          nr := CRTable.ClassWithSet(sset);
          IF nr < 0 THEN nr := CRTable.NewClass('##', sset);
          a^.typ := CRTable.class; a^.sym := nr
        END
  END;

(* CombineShifts     Combine shifts with different symbols into same state
-------------------------------------------------------------------------*) 

PROCEDURE CombineShifts;
  VAR
    s : INTEGER;
    a, b, c : Action;
    seta, setb : CRTable.CRTSet;

  BEGIN
    s := rootState;
    WHILE s <= lastState DO BEGIN
      a := stateArray[s].firstAction;
      WHILE a <> NIL DO BEGIN
        b := a^.next;
        WHILE b <> NIL DO BEGIN
          IF (a^.target^.theState = b^.target^.theState) AND (a^.tc = b^.tc)
            THEN
              BEGIN
                MakeSet(a, seta); MakeSet(b, setb);
                Sets.Unite(seta, setb);
                ChangeAction(a, seta);
                c := b; b := b^.next;
                DetachAction(c, a)
              END
            ELSE b := b^.next
        END;
        a := a^.next
      END;
      INC(s)
    END
  END;

(* DeleteRedundantStates   Delete unused and equal states
-------------------------------------------------------------------------*) 

PROCEDURE DeleteRedundantStates;
  VAR
    anAction : Action;
    s, s2, next : INTEGER;
    used : Sets.BITARRAY;
    {ARRAY [0 .. maxStates DIV Sets.size] OF BITSET } (*KJG*)
    newStateNr : ARRAY [0 .. maxStates] OF INTEGER;

  PROCEDURE FindUsedStates (s : INTEGER);
    VAR
      anAction : Action;
    BEGIN
      IF Sets.IsIn(used, s) THEN EXIT;
      Sets.Incl(used, s);
      anAction := stateArray[s].firstAction;
      WHILE anAction <> NIL DO BEGIN
        FindUsedStates(anAction^.target^.theState);
        anAction := anAction^.next
      END
    END;

  BEGIN
    Sets.Clear(used);
    FindUsedStates(rootState);
    (*---------- combine equal final states ------------*) 
    s := rootState + 1;
    (*root state cannot be final*) 
    WHILE s <= lastState DO BEGIN
      IF Sets.IsIn(used, s) AND (stateArray[s].endOf <> CRTable.noSym) THEN
        IF (stateArray[s].firstAction = NIL) AND NOT stateArray[s].ctx THEN
          BEGIN
            s2 := s + 1;
            WHILE s2 <= lastState DO BEGIN
              IF Sets.IsIn(used, s2) AND (stateArray[s].endOf = stateArray[s2].endOf) THEN
                IF (stateArray[s2].firstAction = NIL) AND NOT stateArray[s2].ctx THEN
                  BEGIN Sets.Excl(used, s2); newStateNr[s2] := s END;
              INC(s2)
            END
          END;
      INC(s)
    END;
    s := rootState;
    (* + 1 ?  PDT - was rootState, but Oberon had .next ie +1
                    seems to work both ways?? *) 
    WHILE s <= lastState DO BEGIN
      IF Sets.IsIn(used, s) THEN
        BEGIN
          anAction := stateArray[s].firstAction;
          WHILE anAction <> NIL DO BEGIN
            IF NOT Sets.IsIn(used, anAction^.target^.theState) THEN
              anAction^.target^.theState := newStateNr[anAction^.target^.theState];
            anAction := anAction^.next
          END
        END;
      INC(s)
    END;
    (*-------- delete unused states --------*) 
    s := rootState + 1;
    next := s;
    WHILE s <= lastState DO BEGIN
      IF Sets.IsIn(used, s)
        THEN
          BEGIN
            IF next < s THEN stateArray[next] := stateArray[s];
            newStateNr[s] := next;
            INC(next)
          END
        ELSE DeleteActionList(stateArray[s].firstAction);
      INC(s)
    END;
    lastState := next - 1;
    s := rootState;
    WHILE s <= lastState DO BEGIN
      anAction := stateArray[s].firstAction;
      WHILE anAction <> NIL DO BEGIN
        anAction^.target^.theState := newStateNr[anAction^.target^.theState];
        anAction := anAction^.next
      END;
      INC(s)
    END
  END;

(* ConvertToStates    Convert the TDG in gp into a subautomaton of the DFA
------------------------------------------------------------------------*) 

PROCEDURE ConvertToStates (gp0, sp : INTEGER);
(*note: gn.line is abused as a state number!*) 

  VAR
    visited: CRTable.MarkList;

  PROCEDURE NumberNodes (gp, snr : INTEGER);
    VAR
      gn : CRTable.GraphNode;
    BEGIN
      IF gp = 0 THEN EXIT; (*end of graph*)
      CRTable.GetNode(gp, gn);
      IF gn.line >= 0 THEN EXIT; (*already visited*)
      IF snr < rootState THEN snr := NewState;
      gn.line := snr; CRTable.PutNode(gp, gn);
      IF CRTable.DelGraph(gp) THEN stateArray[snr].endOf := sp;
      (*snr is end state*) 
      CASE gn.typ OF
        CRTable.class, CRTable.chart :
          BEGIN NumberNodes(ABS(gn.next), rootState - 1) END;
        CRTable.opt :
          BEGIN NumberNodes(ABS(gn.next), rootState - 1); NumberNodes(gn.p1, snr) END;
        CRTable.iter :
          BEGIN NumberNodes(ABS(gn.next), snr); NumberNodes(gn.p1, snr) END;
        CRTable.alt :
          BEGIN NumberNodes(gn.p1, snr); NumberNodes(gn.p2, snr) END;
      END;
    END;

  FUNCTION TheState (gp : INTEGER) : INTEGER;
    VAR
      s : INTEGER;
      gn : CRTable.GraphNode;
    BEGIN
      IF gp = 0
        THEN BEGIN s := NewState; stateArray[s].endOf := sp; TheState := s END
        ELSE BEGIN CRTable.GetNode(gp, gn); TheState := gn.line END
    END;

  PROCEDURE Step (from, gp : INTEGER);
    VAR
      gn : CRTable.GraphNode;
    BEGIN
      IF gp = 0 THEN EXIT;
      CRTable.GetNode(gp, gn);
      CASE gn.typ OF
        CRTable.class, CRTable.chart :
          BEGIN NewTransition(from, gn, TheState(ABS(gn.next))) END;
        CRTable.alt :
          BEGIN Step(from, gn.p1); Step(from, gn.p2) END;
        CRTable.opt, CRTable.iter :
          BEGIN Step(from, ABS(gn.next)); Step(from, gn.p1) END;
      END
    END;

  PROCEDURE FindTrans (gp : INTEGER; start : BOOLEAN);
    VAR
      gn : CRTable.GraphNode;
    BEGIN
      IF (gp = 0) OR CRTable.IsInMarkList(visited, gp) THEN EXIT;
      CRTable.InclMarkList(visited, gp); CRTable.GetNode(gp, gn);
      IF start THEN Step(gn.line, gp); (* start of group of equally numbered nodes *)
      CASE gn.typ OF
        CRTable.class, CRTable.chart :
          BEGIN FindTrans(ABS(gn.next), TRUE) END;
        CRTable.opt :
          BEGIN FindTrans(ABS(gn.next), TRUE); FindTrans(gn.p1, FALSE) END;
        CRTable.iter :
          BEGIN FindTrans(ABS(gn.next), FALSE); FindTrans(gn.p1, FALSE) END;
        CRTable.alt :
          BEGIN FindTrans(gn.p1, FALSE); FindTrans(gn.p2, FALSE) END;
      END;
    END;

  VAR
    gn : CRTable.GraphNode;
    i : INTEGER;

  BEGIN
    IF CRTable.DelGraph(gp0) THEN SemErr(20);
    FOR i := 0 TO CRTable.nNodes DO BEGIN
      CRTable.GetNode(i, gn); gn.line :=  -1; CRTable.PutNode(i, gn)
    END;
    NumberNodes(gp0, rootState);
    CRTable.ClearMarkList(visited);
    FindTrans(gp0, TRUE)
  END;

(* MatchesDFA         TRUE, if the string str can be recognized by the DFA
------------------------------------------------------------------------*)
{ fossil from modula - maybe we should delete
PROCEDURE MatchesDFA (str: STRING; VAR matchedSp: INTEGER): BOOLEAN;
  VAR
    len: INTEGER;

  PROCEDURE Match (p: INTEGER; s: INTEGER): BOOLEAN;
    VAR
      ch:    CHAR;
      a:     Action;
      equal: BOOLEAN;
      sset:   CRTable.CRTSet;
    BEGIN
      IF p >= len THEN
        IF stateArray[s].endOf # CRTable.noSym
          THEN matchedSp := stateArray[s].endOf; RETURN TRUE
          ELSE RETURN FALSE
        END
      END;
      a := stateArray[s].firstAction; ch := str[p];
      WHILE a # NIL DO
        CASE a^.typ OF
          CRTable.char:
            equal := VAL(INTEGER, ORD(ch)) = a^.sym
        | CRTable.class:
            CRTable.GetClass(a^.sym, sset); equal := Sets.IsIn(sset, ORD(ch))
        END;
        IF equal THEN RETURN Match(p + 1, a^.target^.theState) END;
        a := a^.next