cra.mod

一个Modula-2语言分析器

IMPLEMENTATION MODULE CRA;

(* CRA     Automaton and Scanner Generation
   ===     ================================

  (1) ConvertToStates translates a top-down graph into a NFA.
      MatchDFA tries to match literal strings against the DFA
  (2) MakeDeterministic converts the NFA into a DFA
  (3) WriteScanner generates the scanner source file

  ----------------------------------------------------------------*)

(* IMPORT ProgArgs; for gpm version *)

IMPORT CRS, CRT, FileIO, Sets, Storage;
IMPORT SYSTEM (* for TSIZE only *);

CONST
  maxStates = 500;
  cr = 15C;

TYPE
  Action     = POINTER TO ActionNode;
  Target     = POINTER TO TargetNode;

  State = RECORD          (* state of finite automaton *)
    firstAction: Action;  (* to first action of this state *)
    endOf:       INTEGER; (* nr. of recognized token if state is final *)
    ctx:         BOOLEAN; (* TRUE: state reached by contextTrans *)
  END;
  ActionNode = RECORD     (* action of finite automaton *)
    typ:    INTEGER;      (* type of action symbol: char, class *)
    sym:    INTEGER;      (* action symbol *)
    tc:     INTEGER;      (* transition code: normTrans, contextTrans *)
    target: Target;       (* states after transition with input symbol *)
    next:   Action;
  END;
  TargetNode = RECORD     (* state after transition with input symbol *)
    state:  INTEGER;      (* target state *)
    next:   Target;
  END;

  Comment    = POINTER TO CommentNode;
  CommentNode = RECORD    (* info about a comment syntax *)
    start,stop: ARRAY [0 .. 1] OF CHAR;
    nested:     BOOLEAN;
    next:       Comment;
  END;

  Melted     = POINTER TO MeltedNode;
  MeltedNode = RECORD     (* info about melted states *)
    set:   CRT.Set;       (* set of old states *)
    state: INTEGER;       (* new state *)
    next:  Melted;
  END;

VAR
  state:         ARRAY [0 .. maxStates] OF State;
  lastSimState:  INTEGER;     (* last non melted state *)
  lastState:     INTEGER;     (* last allocated state  *)
  rootState:     INTEGER;     (* start state of DFA    *)
  firstMelted:   Melted;      (* list of melted states *)
  firstComment:  Comment;     (* list of comments      *)
  scanner,                    (* generated scanner *)
  out:           FileIO.File; (* current output file   *)
  fram:          FileIO.File; (* scanner frame         *)
  NewLine:       BOOLEAN;

PROCEDURE SemErr (nr: INTEGER);
  BEGIN
    CRS.Error(nr + 100, CRS.line, CRS.col, CRS.pos)
  END SemErr;

PROCEDURE Put (ch: CHAR);
  BEGIN
    FileIO.Write(out, ch)
  END Put;

PROCEDURE PutLn;
  BEGIN
    FileIO.WriteLn(out)
  END PutLn;

PROCEDURE PutB (n: INTEGER);
  BEGIN
    FileIO.WriteText(out, "", n);
  END PutB;

PROCEDURE Indent (n: INTEGER);
  BEGIN
    IF NewLine THEN PutB(n) ELSE NewLine := TRUE END;
  END Indent;

PROCEDURE PutS (s: ARRAY OF CHAR);
  VAR
    i: CARDINAL;
  BEGIN
    i := 0;
    WHILE (i <= HIGH(s)) & (s[i] # 0C) DO
      IF s[i] = "$"
        THEN FileIO.WriteLn(out)
        ELSE FileIO.Write(out, s[i])
      END;
      INC(i)
    END
  END PutS;

PROCEDURE PutI (i: INTEGER);
  BEGIN
    FileIO.WriteInt(out, i, 1)
  END PutI;

PROCEDURE PutI2 (i, n: INTEGER);
  BEGIN
    FileIO.WriteInt(out, i, n)
  END PutI2;

PROCEDURE PutC (ch: CHAR);
  BEGIN
    CASE ch OF
      0C .. 37C, 177C .. 377C :
         PutS("CHR("); PutI(ORD(ch)); Put(")")
    | '"' :
         Put("'"); Put(ch); Put("'")
    ELSE Put('"'); Put(ch); Put('"')
    END
  END PutC;

PROCEDURE PutSN (i: INTEGER);
  VAR
    sn: CRT.SymbolNode;
  BEGIN
    CRT.GetSym(i, sn);
    IF FileIO.SLENGTH(sn.constant) > 0 THEN
      PutS(sn.constant);
    ELSE
      PutI(i);
    END;
  END PutSN;

PROCEDURE PutSE (i: INTEGER);
  BEGIN
    PutS("sym := "); PutSN(i); PutS("; ");
  END PutSE;

PROCEDURE PutRange (s: CRT.Set; indent:CARDINAL);
  VAR
    lo, hi: ARRAY [0 .. 31] OF CHAR;
    top, i: INTEGER;
    s1: CRT.Set;
  BEGIN
    (*----- fill lo and hi *)
    top := -1; i := 0;
    WHILE i < 256 (*PDT*) DO
      IF Sets.In(s, i) THEN
        INC(top); lo[top] := CHR(i); INC(i);
        WHILE (i < 256 (*PDT*) ) & Sets.In(s, i) DO INC(i) END;
        hi[top] := CHR(i - 1)
      ELSE INC(i)
      END
    END;
    (*----- print ranges *)
    IF (top = 1) & (lo[0] = 0C) & (hi[1] = 377C (*PDT*))
        & (CHR(ORD(hi[0]) + 2) = lo[1]) THEN
      Sets.Fill(s1); Sets.Differ(s1, s);
      PutS("~ ("); PutRange(s1, indent); Put(")")
    ELSE
      i := 0;
      WHILE i <= top DO
        IF hi[i] = lo[i] THEN   PutS("(ch = "); PutC(lo[i])
          ELSIF lo[i] = 0C THEN PutS("(ch <= "); PutC(hi[i])
          ELSIF hi[i] = 377C (*PDT*) THEN PutS("(ch >= "); PutC(lo[i])
          ELSE PutS("(ch >= "); PutC(lo[i]); PutS(") & (ch <= ");
               PutC(hi[i])
        END;
        Put(")");
        IF i < top THEN PutS(" OR$"); PutB(indent) END;
        INC(i)
      END
    END
  END PutRange;

PROCEDURE PutChCond (ch: CHAR);
  BEGIN
    PutS("(ch = "); PutC(ch); Put(")")
  END PutChCond;

(* PrintSymbol          Print a symbol for tracing
-------------------------------------------------------------------------*)
PROCEDURE PrintSymbol (typ, val, width: INTEGER);
  VAR
    name: CRT.Name;
    len: INTEGER;
  BEGIN
    IF typ = CRT.class THEN
      CRT.GetClassName(val, name); PutS(name);
      len := FileIO.SLENGTH(name)
    ELSIF (val >= VAL(INTEGER, ORD(" "))) & (val < 127) & (val # 34) THEN
      Put('"'); Put(CHR(val)); Put('"'); len := 3
    ELSE
      PutS("CHR("); PutI2(val, 2); Put(")"); len := 7
    END;
    WHILE len < width DO Put(" "); INC(len) END
  END PrintSymbol;

(* PrintStates          List the automaton for tracing
-------------------------------------------------------------------------*)
PROCEDURE PrintStates;
  VAR
    action: Action;
    first: BOOLEAN;
    s, i: INTEGER;
    targ: Target;
    set: CRT.Set;
    name: CRT.Name;
  BEGIN
    out := CRS.lst;
    PutS("$-------- states ---------$");
    s := rootState;
    WHILE s <= lastState DO
      action := state[s].firstAction; first := TRUE;
      IF state[s].endOf = CRT.noSym THEN PutS("     ")
      ELSE PutS("E("); PutI2(state[s].endOf, 2); Put(")")
      END;
      PutI2(s, 3); Put(":"); IF action = NIL THEN PutS(" $") END;
      WHILE action # NIL DO
        IF first
          THEN Put(" "); first := FALSE
          ELSE PutS("          ")
        END;
        PrintSymbol(action^.typ, action^.sym, 0); Put(" ");
        targ := action^.target;
        WHILE targ # NIL DO
          PutI(targ^.state); Put(" "); targ := targ^.next;
        END;
        IF action^.tc = CRT.contextTrans
          THEN PutS(" context$")
          ELSE PutS(" $")
        END;
        action := action^.next
      END;
      INC(s)
    END;
    PutS("$-------- character classes ---------$");
    i := 0;
    WHILE i <= CRT.maxC DO
      CRT.GetClass(i, set); CRT.GetClassName(i, name);
      FileIO.WriteText(out, name, 10);
      FileIO.WriteString(out, ": "); Sets.Print(out, set, 80, 13);
      FileIO.WriteLn(out);
      INC(i)
    END
  END PrintStates;

(* AddAction            Add a action to the action list of a state
------------------------------------------------------------------------*)
PROCEDURE AddAction (act: Action; VAR head: Action);
  VAR
    a,lasta: Action;
  BEGIN
    a := head; lasta := NIL;
    LOOP
      IF (a = NIL) OR (act^.typ < a^.typ) THEN
        (*collecting classes at the front improves performance*)
        act^.next := a;
        IF lasta = NIL THEN head := act ELSE lasta^.next := act END;
        EXIT;
      END;
      lasta := a; a := a^.next;
    END;
  END AddAction;

(* DetachAction         Detach action a from list L
------------------------------------------------------------------------*)
PROCEDURE DetachAction (a: Action; VAR L: Action);
  BEGIN
    IF L = a THEN L := a^.next
      ELSIF L # NIL THEN DetachAction(a, L^.next)
    END
  END DetachAction;

PROCEDURE TheAction (state: State; ch: CHAR): Action;
  VAR
    a: Action;
    set: CRT.Set;
  BEGIN
    a := state.firstAction;
    WHILE a # NIL DO
      IF a^.typ = CRT.char THEN
        IF VAL(INTEGER, ORD(ch)) = a^.sym THEN RETURN a END
      ELSIF a^.typ = CRT.class THEN
        CRT.GetClass(a^.sym, set);
        IF Sets.In(set, ORD(ch)) THEN RETURN a END
      END;
      a := a^.next
    END;
    RETURN NIL
  END TheAction;

PROCEDURE AddTargetList (VAR lista, listb: Target);
  VAR
    p,t: Target;

  PROCEDURE AddTarget (t: Target; VAR list: Target);
    VAR
      p,lastp: Target;
    BEGIN
      p := list; lastp := NIL;
      LOOP
        IF (p = NIL) OR (t^.state < p^.state) THEN EXIT END;
        IF p^.state = t^.state THEN
          Storage.DEALLOCATE(t, SYSTEM.TSIZE(TargetNode)); RETURN
        END;
        lastp := p; p := p^.next
      END;
      t^.next := p;
      IF lastp=NIL THEN list := t ELSE lastp^.next := t END
    END AddTarget;

  BEGIN
    p := lista;
    WHILE p # NIL DO
      Storage.ALLOCATE(t, SYSTEM.TSIZE(TargetNode));
      t^.state := p^.state; AddTarget(t, listb);
      p := p^.next
    END
  END AddTargetList;

(* NewMelted            Generate new info about a melted state
------------------------------------------------------------------------*)
PROCEDURE NewMelted (set: CRT.Set; s: INTEGER): Melted;
  VAR
    melt: Melted;
  BEGIN
    Storage.ALLOCATE(melt, SYSTEM.TSIZE(MeltedNode));
    melt^.set := set; melt^.state := s;
    melt^.next := firstMelted; firstMelted := melt;
    RETURN melt
  END NewMelted;

(* NewState             Return a new state node
------------------------------------------------------------------------*)
PROCEDURE NewState (): INTEGER;
  BEGIN
    INC(lastState);
    IF lastState > maxStates THEN CRT.Restriction(7, maxStates) END;
    state[lastState].firstAction := NIL;
    state[lastState].endOf := CRT.noSym;
    state[lastState].ctx := FALSE;
    RETURN lastState
  END NewState;

(* NewTransition        Generate transition (gn.state, gn.p1) --> toState
------------------------------------------------------------------------*)
PROCEDURE NewTransition (from: INTEGER; gn: CRT.GraphNode;
                         toState: INTEGER);
  VAR
    a: Action;
    t: Target;
  BEGIN
    IF toState = rootState THEN SemErr(21) END;
    Storage.ALLOCATE(t, SYSTEM.TSIZE(TargetNode));
    t^.state := toState; t^.next := NIL;
    Storage.ALLOCATE(a, SYSTEM.TSIZE(ActionNode));
    a^.typ := gn.typ; a^.sym := gn.p1; a^.tc := gn.p2; a^.target := t;
    AddAction(a, state[from].firstAction)
  END NewTransition;

(* NewComment           Define new comment
-------------------------------------------------------------------------*)
PROCEDURE NewComment (from, to: INTEGER; nested: BOOLEAN);
  VAR
    com: Comment;

  PROCEDURE MakeStr (gp: INTEGER; VAR s: ARRAY OF CHAR);
    VAR
      i, n: INTEGER;
      gn: CRT.GraphNode;
      set: CRT.Set;
    BEGIN
      i := 0;
      WHILE gp # 0 DO
        CRT.GetNode(gp, gn);
        IF gn.typ = CRT.char THEN
          IF i < 2 THEN s[i] := CHR(gn.p1) END; INC(i)
        ELSIF gn.typ = CRT.class THEN
          CRT.GetClass(gn.p1, set);
          IF Sets.Elements(set, n) # 1 THEN SemErr(26) END;
          IF i < 2 THEN s[i] := CHR(n) END; INC(i)
        ELSE SemErr(22)
        END;
        gp := gn.next
      END;
      IF (i = 0) OR (i > 2) THEN SemErr(25) ELSIF i < 2 THEN s[i] := 0C END
    END MakeStr;

  BEGIN
    Storage.ALLOCATE(com, SYSTEM.TSIZE(CommentNode));
    MakeStr(from, com^.start); MakeStr(to, com^.stop);
    com^.nested := nested;
    com^.next := firstComment; firstComment := com
  END NewComment;

(* DeleteTargetList     Delete a target list
-------------------------------------------------------------------------*)
PROCEDURE DeleteTargetList (list: Target);
  BEGIN
    IF list # NIL THEN
      DeleteTargetList(list^.next);
      Storage.DEALLOCATE(list, SYSTEM.TSIZE(TargetNode))
    END;
  END DeleteTargetList;

(* DeleteActionList     Delete an action list
-------------------------------------------------------------------------*)
PROCEDURE DeleteActionList (action: Action);
  BEGIN
    IF action # NIL THEN
      DeleteActionList(action^.next);
      DeleteTargetList(action^.target);
      Storage.DEALLOCATE(action, SYSTEM.TSIZE(ActionNode))
    END
  END DeleteActionList;

(* MakeSet              Expand action symbol into symbol set
-------------------------------------------------------------------------*)
PROCEDURE MakeSet (p: Action; VAR set: CRT.Set);
  BEGIN
    IF p^.typ = CRT.class THEN
    CRT.GetClass(p^.sym, set)
    ELSE Sets.Clear(set); Sets.Incl(set, p^.sym)
    END
  END MakeSet;

(* ChangeAction         Change the action symbol to set
-------------------------------------------------------------------------*)
PROCEDURE ChangeAction (a: Action; set: CRT.Set);
  VAR
    nr: INTEGER;
  BEGIN
    IF Sets.Elements(set, nr) = 1 THEN a^.typ := CRT.char; a^.sym := nr
    ELSE
      nr := CRT.ClassWithSet(set);
      IF nr < 0 THEN nr := CRT.NewClass("##", set) END;
      a^.typ := CRT.class; a^.sym := nr
    END
  END ChangeAction;

(* CombineShifts     Combine shifts with different symbols into same state
-------------------------------------------------------------------------*)
PROCEDURE CombineShifts;
  VAR
    s: INTEGER;
    a, b, c: Action;
    seta, setb: CRT.Set;
  BEGIN
    s := rootState;
    WHILE s <= lastState DO
      a := state[s].firstAction;
      WHILE a # NIL DO