cra.mod

一个Modula-2语言分析器

        b := a^.next;
        WHILE b # NIL DO
          IF (a^.target^.state = b^.target^.state) & (a^.tc = b^.tc) THEN
            MakeSet(a, seta); MakeSet(b, setb); Sets.Unite(seta, setb);
            ChangeAction(a, seta);
            c := b; b := b^.next; DetachAction(c, a)
          ELSE b := b^.next
          END
        END;
        a := a^.next
      END;
      INC(s)
    END
  END CombineShifts;

(* DeleteRedundantStates   Delete unused and equal states
-------------------------------------------------------------------------*)
PROCEDURE DeleteRedundantStates;
  VAR
    action: Action;
    s, s2, next: INTEGER;
    used: ARRAY [0 .. maxStates DIV Sets.size] OF BITSET (*KJG*);
    newStateNr: ARRAY [0 .. maxStates] OF INTEGER;

  PROCEDURE FindUsedStates (s: INTEGER);
    VAR
      action: Action;
    BEGIN
      IF Sets.In(used, s) THEN RETURN END;
      Sets.Incl(used, s);
      action := state[s].firstAction;
      WHILE action # NIL DO
        FindUsedStates(action^.target^.state);
        action := action^.next
      END
    END FindUsedStates;

  BEGIN
    Sets.Clear(used); FindUsedStates(rootState);
    (*---------- combine equal final states ------------*)
    s := rootState + 1; (*root state cannot be final*)
    WHILE s <= lastState DO
      IF Sets.In(used, s) & (state[s].endOf # CRT.noSym) THEN
        IF (state[s].firstAction = NIL) & ~ state[s].ctx THEN
          s2 := s + 1;
          WHILE s2 <= lastState DO
            IF Sets.In(used, s2) & (state[s].endOf = state[s2].endOf) THEN
              IF (state[s2].firstAction = NIL) AND ~ state[s2].ctx THEN
                Sets.Excl(used, s2); newStateNr[s2] := s
              END
            END;
            INC(s2)
          END
        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
      IF Sets.In(used, s) THEN
        action := state[s].firstAction;
        WHILE action # NIL DO
          IF ~ Sets.In(used, action^.target^.state) THEN
            action^.target^.state := newStateNr[action^.target^.state]
          END;
          action := action^.next
        END
      END;
      INC(s)
    END;
    (*-------- delete unused states --------*)
    s := rootState + 1; next := s;
    WHILE s <= lastState DO
      IF Sets.In(used, s) THEN
        IF next < s THEN state[next] := state[s] END;
        newStateNr[s] := next; INC(next)
      ELSE
        DeleteActionList(state[s].firstAction)
      END;
      INC(s)
    END;
    lastState := next - 1;
    s := rootState;
    WHILE s <= lastState DO
      action := state[s].firstAction;
      WHILE action # NIL DO
        action^.target^.state := newStateNr[action^.target^.state];
        action := action^.next
      END;
      INC(s)
    END
  END DeleteRedundantStates;

(* 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: CRT.MarkList;

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

  PROCEDURE TheState (gp: INTEGER): INTEGER;
    VAR
      s: INTEGER;
      gn: CRT.GraphNode;
    BEGIN
      IF gp = 0 THEN s := NewState(); state[s].endOf := sp; RETURN s
      ELSE CRT.GetNode(gp, gn); RETURN gn.line
      END
    END TheState;

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

  PROCEDURE FindTrans (gp: INTEGER; start: BOOLEAN);
    VAR
      gn: CRT.GraphNode;
    BEGIN
      IF (gp = 0) OR Sets.In(visited, gp) THEN RETURN END;
      Sets.Incl(visited, gp); CRT.GetNode(gp, gn);
      IF start THEN Step(gn.line, gp) END; (* start of group of equally numbered nodes *)
      CASE gn.typ OF
        CRT.class, CRT.char:
          FindTrans(ABS(gn.next), TRUE);
      | CRT.opt:
          FindTrans(ABS(gn.next), TRUE); FindTrans(gn.p1, FALSE)
      | CRT.iter:
          FindTrans(ABS(gn.next), FALSE); FindTrans(gn.p1, FALSE)
      | CRT.alt:
          FindTrans(gn.p1, FALSE); FindTrans(gn.p2, FALSE)
      END;
    END FindTrans;

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

(* MatchesDFA         TRUE, if the string str can be recognized by the DFA
------------------------------------------------------------------------*)
(*--++
PROCEDURE MatchesDFA (str: ARRAY OF CHAR; VAR matchedSp: INTEGER): BOOLEAN;
  VAR
    len: CARDINAL;

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

  BEGIN
    len := FileIO.SLENGTH(str) - 1; (*strip quotes*)
    RETURN Match(1, rootState)
  END MatchesDFA;
++--*)

  PROCEDURE MatchDFA (str: ARRAY OF CHAR; sp: INTEGER;
                      VAR matchedSp: INTEGER);
    VAR
      s, to: INTEGER (*State*);
      a: Action;
      gn:CRT.GraphNode;
      i, len: INTEGER;
    BEGIN (* s with quotes *)
      s := rootState; i := 1; len := FileIO.SLENGTH(str) - 1;
      LOOP (* try to match str against existing DFA *)
        IF i = len THEN EXIT END;
        a := TheAction(state[s], str[i]);
        IF a = NIL THEN EXIT END;
        s := a^.target^.state; INC(i)
      END;
      WHILE i < len DO (* make new DFA for str[i..len-1] *)
        to := NewState();
        gn.typ := CRT.char; gn.p1 := ORD(str[i]); gn.p2 := CRT.normTrans;
        NewTransition(s, gn, to); (* PDT Tue  01-11-94 *)
        s := to; INC(i)
      END;
      matchedSp := state[s].endOf;
      IF state[s].endOf = CRT.noSym THEN state[s].endOf := sp END
    END MatchDFA;

(* SplitActions     Generate unique actions from two overlapping actions
-----------------------------------------------------------------------*)
PROCEDURE SplitActions (a, b: Action);
  VAR
    c: Action;
    seta, setb, setc: CRT.Set;

  PROCEDURE CombineTransCodes (t1, t2: INTEGER; VAR result: INTEGER);
    BEGIN
      IF t1 = CRT.contextTrans THEN result := t1 ELSE result := t2 END
    END CombineTransCodes;

  BEGIN
    MakeSet(a, seta); MakeSet(b, setb);
    IF Sets.Equal(seta, setb) THEN
      AddTargetList(b^.target, a^.target);
      DeleteTargetList(b^.target);
      CombineTransCodes(a^.tc, b^.tc, a^.tc);
      DetachAction(b, a);
      Storage.DEALLOCATE(b, SYSTEM.TSIZE(ActionNode))
    ELSIF Sets.Includes(seta, setb) THEN
      setc := seta; Sets.Differ(setc, setb);
      AddTargetList(a^.target, b^.target);
      CombineTransCodes(a^.tc, b^.tc, b^.tc);
      ChangeAction(a, setc)
    ELSIF Sets.Includes(setb, seta) THEN
      setc := setb; Sets.Differ(setc, seta);
      AddTargetList(b^.target, a^.target);
      CombineTransCodes(a^.tc, b^.tc, a^.tc);
      ChangeAction(b, setc)
    ELSE
      Sets.Intersect(seta, setb, setc);
      Sets.Differ(seta, setc);
      Sets.Differ(setb, setc);
      ChangeAction(a, seta);
      ChangeAction(b, setb);
      Storage.ALLOCATE(c, SYSTEM.TSIZE(ActionNode)); c^.target := NIL;
      CombineTransCodes(a^.tc, b^.tc, c^.tc);
      AddTargetList(a^.target, c^.target);
      AddTargetList(b^.target, c^.target);
      ChangeAction(c, setc);
      AddAction(c, a)
    END
  END SplitActions;

(* MakeUnique           Make all actions in this state unique
-------------------------------------------------------------------------*)
PROCEDURE MakeUnique (s: INTEGER; VAR changed: BOOLEAN);
  VAR
    a, b: Action;

  PROCEDURE Overlap (a, b: Action): BOOLEAN;
    VAR
      seta, setb: CRT.Set;
    BEGIN
      IF a^.typ = CRT.char THEN
        IF b^.typ = CRT.char
          THEN RETURN a^.sym = b^.sym
          ELSE CRT.GetClass(b^.sym, setb); RETURN Sets.In(setb, a^.sym)
        END
      ELSE
        CRT.GetClass(a^.sym, seta);
        IF b^.typ = CRT.char
          THEN RETURN Sets.In(seta, b^.sym)
          ELSE CRT.GetClass(b^.sym, setb);
               RETURN ~ Sets.Different(seta, setb)
        END
      END
    END Overlap;

  BEGIN
    a := state[s].firstAction; changed := FALSE;
    WHILE a # NIL DO
      b := a^.next;
      WHILE b # NIL DO
        IF Overlap(a, b) THEN
          SplitActions(a, b); changed := TRUE; RETURN
          (* originally no RETURN.  FST blows up if we leave RETURN out.
             Somewhere there is a field that is not properly set, but I
             have not chased this down completely Fri  08-20-1993 *)
        END;
        b := b^.next;
      END;
      a := a^.next
    END;
  END MakeUnique;

(* MeltStates       Melt states appearing with a shift of the same symbol
-----------------------------------------------------------------------*)
PROCEDURE MeltStates (s: INTEGER; VAR correct: BOOLEAN);
  VAR
    action: Action;
    ctx: BOOLEAN;
    endOf: INTEGER;
    melt: Melted;
    set: CRT.Set;
    s1: INTEGER;
    changed: BOOLEAN;

  PROCEDURE AddMeltedSet (nr: INTEGER; VAR set: CRT.Set);
    VAR
      m: Melted;
    BEGIN
      m := firstMelted;
      WHILE (m # NIL) & (m^.state # nr) DO m := m^.next END;
      IF m = NIL THEN CRT.Restriction(-1, 0) (* compiler error *) END;
      Sets.Unite(set, m^.set);
    END AddMeltedSet;

  PROCEDURE GetStateSet (t: Target; VAR set: CRT.Set; VAR endOf: INTEGER;
                         VAR ctx: BOOLEAN);
  (* Modified back to match Oberon version Fri  08-20-1993
     This seemed to cause problems with some larger automata *)
     (* new bug fix Wed  11-24-1993  from ETHZ incorporated *)
    VAR
      lastS: INTEGER;
    BEGIN
      Sets.Clear(set); endOf := CRT.noSym; ctx := FALSE;
      lastS := lastState; (* Fri  08-20-1993 *)
      WHILE t # NIL DO
        IF t^.state <= lastSimState THEN Sets.Incl(set, t^.state);
        ELSE AddMeltedSet(t^.state, set);
        END;
        IF state[t^.state].endOf # CRT.noSym THEN
          IF (endOf = CRT.noSym) OR (endOf = state[t^.state].endOf) THEN
             endOf := state[t^.state].endOf; lastS := t^.state
          ELSE
            PutS("$Tokens "); PutI(endOf); PutS(" and ");
            PutI(state[t^.state].endOf);
            PutS(" cannot be distinguished.$");
            correct := FALSE;
          END;
        END;
        IF state[t^.state].ctx THEN
          ctx := TRUE;
          IF state[t^.state].endOf # CRT.noSym THEN
            PutS("$Ambiguous CONTEXT clause.$"); correct := FALSE
          END
        END;
(* ======= originally the last bit read as follows
        IF endOf = CRT.noSym THEN
          endOf := state[t^.state].endOf;
        ELSIF (state[t^.state].endOf # CRT.noSym) &
              (state[t^.state].endOf # endOf) THEN
          PutS("$Tokens "); PutI(endOf); PutS(" and ");
          PutI(state[t^.state].endOf);
          PutS(" cannot be distinguished.$");
          correct := FALSE;
        END;
  (*========= *)
        ctx := ctx OR state[t^.state].ctx;
======== *)
        t := t^.next
      END
    END GetStateSet;

  PROCEDURE FillWithActions (s: INTEGER; targ: Target);
    VAR
      action, a: Action;
    BEGIN
      WHILE targ # NIL DO
        action := state[targ^.state].firstAction;
        WHILE action # NIL DO
          Storage.ALLOCATE(a, SYSTEM.TSIZE(ActionNode));
          a^ := action^; a^.target := NIL;
          AddTargetList(action^.target, a^.target);
          AddAction(a, state[s].firstAction);
          action := action^.next
        END;
        targ := targ^.next
      END;
    END FillWithActions;

  PROCEDURE KnownMelted (set: CRT.Set; VAR melt: Melted): BOOLEAN;
    BEGIN
      melt := firstMelted;
      WHILE melt # NIL DO
        IF Sets.Equal(set, melt^.set) THEN RETURN TRUE END;
        melt := melt^.next
      END;
      RETURN FALSE
    END KnownMelted;

  BEGIN
    action := state[s].firstAction;
    WHILE action # NIL DO
      IF action^.target^.next # NIL THEN
        GetStateSet(action^.target, set, endOf, ctx);
        IF ~ KnownMelted(set, melt) THEN
          s1 := NewState();
          state[s1].endOf := endOf; state[s1].ctx := ctx;
          FillWithActions(s1, action^.target);
          REPEAT MakeUnique(s1, changed) UNTIL ~ changed;
          melt := NewMelted(set, s1);
        END;
        DeleteTargetList(action^.target^.next);
        action^.target^.next := NIL;
        action^.target^.state := melt^.state
      END;
      action := action^.next
    END
  END MeltStates;

(* MakeDeterministic     Make NDFA --> DFA
------------------------------------------------------------------------*)
PROCEDURE MakeDeterministic (VAR correct: BOOLEAN);
  VAR
    s: INTEGER;
    changed: BOOLEAN;

  PROCEDURE FindCtxStates;