M2compiler-V3/compiler/src/AST.mod

IMPLEMENTATION MODULE AST;
(* Arena-backed abstract syntax tree (Stage A).

   Layout:
     - `arena` is a fixed array of nodes; live count `nNodes`.
     - each node stores kind/op/ty, a child count and child indices.
     - `pool` is a fixed text area; `poolOff[i]`/`poolLen[i]` delimit
       the i-th interned string (NUL-free, so no terminator needed).
   No dynamic allocation: the sizes mirror SymTab's fixed tables and
   are ample for the compiler's own source when self-hosting. *)

IMPORT FileIO;

CONST
  MaxNodes = 65536;
  MaxTxt   = 16384;
  PoolSize = 1048576;   (* 1 MiB of pooled text *)
  MaxTxtLen = 255;

  (* arena has MaxNodes slots, indices 0..MaxNodes-1 *)
  HighNode = MaxNodes - 1;
  HighTxt  = MaxTxt - 1;

TYPE
  NodeRec = RECORD
    kind   : INTEGER;
    op     : INTEGER;
    ty     : INTEGER;
    nch    : CARDINAL;
    child  : ARRAY [0 .. MaxChild - 1] OF Node;
  END;

VAR
  arena  : ARRAY [0 .. HighNode] OF NodeRec;
  nNodes : CARDINAL;
  pool   : ARRAY [0 .. PoolSize - 1] OF CHAR;
  poolUse: CARDINAL;
  poolOff: ARRAY [0 .. HighTxt] OF CARDINAL;
  poolLen: ARRAY [0 .. HighTxt] OF CARDINAL;
  nTxt   : CARDINAL;

PROCEDURE Init;
  VAR i: CARDINAL;
  BEGIN
    nNodes := 0;
    nTxt := 0;
    poolUse := 0;
    (* nodes are zeroed lazily via InitNode; nothing else needed *)
  END Init;

PROCEDURE AddTxt (s : ARRAY OF CHAR) : TxtIndex;
  VAR i, k, L, off: CARDINAL; dup: BOOLEAN;
  BEGIN
    L := 0;
    WHILE (L <= HIGH(s)) AND (s[L] # CHR(0)) DO INC(L) END;
    IF L > MaxTxtLen THEN L := MaxTxtLen END;
    (* dedupe *)
    i := 0;
    WHILE i < nTxt DO
      IF poolLen[i] = L THEN
        dup := TRUE;
        k := 0;
        WHILE (k < L) AND dup DO
          IF pool[poolOff[i] + k] # s[k] THEN dup := FALSE END;
          INC(k)
        END;
        IF dup THEN RETURN VAL(TxtIndex, i) END
      END;
      INC(i)
    END;
    IF (nTxt > HIGH(poolOff)) OR (poolUse + L > PoolSize) THEN
      RETURN NoTxt
    END;
    off := poolUse;
    k := 0;
    WHILE k < L DO pool[poolUse] := s[k]; INC(poolUse); INC(k) END;
    poolOff[nTxt] := off;
    poolLen[nTxt] := L;
    INC(nTxt);
    RETURN VAL(TxtIndex, nTxt - 1)
  END AddTxt;

PROCEDURE Txt (i : TxtIndex; VAR s : ARRAY OF CHAR);
  VAR k, L: CARDINAL;
  BEGIN
    s[0] := CHR(0);
    IF (i < 0) OR (i >= VAL(INTEGER, nTxt)) THEN RETURN END;
    L := poolLen[i];
    k := 0;
    WHILE (k < L) AND (k < HIGH(s)) DO
      s[k] := pool[poolOff[i] + k]; INC(k)
    END;
    s[k] := CHR(0)
  END Txt;

PROCEDURE TxtLen (i : TxtIndex) : CARDINAL;
  BEGIN
    IF (i < 0) OR (i >= VAL(INTEGER, nTxt)) THEN RETURN 0 END;
    RETURN poolLen[i]
  END TxtLen;

PROCEDURE InitNode (n : Node);
  VAR j: CARDINAL;
  BEGIN
    arena[n].kind := 0;
    arena[n].op := -1;
    arena[n].ty := -1;   (* SymTab.InvalidType, by value *)
    arena[n].nch := 0;
    j := 0;
    WHILE j < MaxChild DO arena[n].child[j] := NoNode; INC(j) END
  END InitNode;

PROCEDURE NewSlot (): Node;
  BEGIN
    IF nNodes > HighNode THEN RETURN NoNode END;
    InitNode(VAL(INTEGER, nNodes));
    INC(nNodes);
    RETURN VAL(INTEGER, nNodes - 1)
  END NewSlot;

PROCEDURE MakeNode (kind : INTEGER) : Node;
  VAR n: Node;
  BEGIN
    n := NewSlot();
    IF n # NoNode THEN arena[n].kind := kind END;
    RETURN n
  END MakeNode;

PROCEDURE MakeLeaf (kind : INTEGER; name : ARRAY OF CHAR) : Node;
  VAR n: Node;
  BEGIN
    n := MakeNode(kind);
    IF n # NoNode THEN
      arena[n].child[0] := VAL(INTEGER, AddTxt(name));
      arena[n].nch := 1
    END;
    RETURN n
  END MakeLeaf;

PROCEDURE MakeBin (kind, op : INTEGER; l, r : Node) : Node;
  VAR n: Node;
  BEGIN
    n := MakeNode(kind);
    IF n # NoNode THEN
      arena[n].op := op;
      arena[n].child[0] := l;
      arena[n].child[1] := r;
      arena[n].nch := 2
    END;
    RETURN n
  END MakeBin;

PROCEDURE MakeUn (kind, op : INTEGER; e : Node) : Node;
  VAR n: Node;
  BEGIN
    n := MakeNode(kind);
    IF n # NoNode THEN
      arena[n].op := op;
      arena[n].child[0] := e;
      arena[n].nch := 1
    END;
    RETURN n
  END MakeUn;

PROCEDURE Kind (n : Node) : INTEGER;
  BEGIN
    IF (n < 0) OR (n > VAL(INTEGER, nNodes) - 1) THEN RETURN -1 END;
    RETURN arena[n].kind
  END Kind;

PROCEDURE SetKind (n : Node; kind : INTEGER);
  BEGIN
    IF (n >= 0) AND (n <= VAL(INTEGER, nNodes) - 1) THEN
      arena[n].kind := kind END
  END SetKind;

PROCEDURE Op (n : Node) : INTEGER;
  BEGIN
    IF (n < 0) OR (n > VAL(INTEGER, nNodes) - 1) THEN RETURN -1 END;
    RETURN arena[n].op
  END Op;

PROCEDURE SetOp (n : Node; op : INTEGER);
  BEGIN
    IF (n >= 0) AND (n <= VAL(INTEGER, nNodes) - 1) THEN
      arena[n].op := op END
  END SetOp;

PROCEDURE Ty (n : Node) : INTEGER;
  BEGIN
    IF (n < 0) OR (n > VAL(INTEGER, nNodes) - 1) THEN RETURN -1 END;
    RETURN arena[n].ty
  END Ty;

PROCEDURE SetTy (n : Node; t : INTEGER);
  BEGIN
    IF (n >= 0) AND (n <= VAL(INTEGER, nNodes) - 1) THEN
      arena[n].ty := t END
  END SetTy;

PROCEDURE NChild (n : Node) : CARDINAL;
  BEGIN
    IF (n < 0) OR (n > VAL(INTEGER, nNodes) - 1) THEN RETURN 0 END;
    RETURN arena[n].nch
  END NChild;

PROCEDURE Child (n : Node; i : CARDINAL) : Node;
  BEGIN
    IF (n < 0) OR (n > VAL(INTEGER, nNodes) - 1)
       OR (i >= arena[n].nch) THEN
      RETURN NoNode
    END;
    RETURN arena[n].child[i]
  END Child;

PROCEDURE AddChild (n : Node; c : Node) : BOOLEAN;
  BEGIN
    IF (n < 0) OR (n > VAL(INTEGER, nNodes) - 1) THEN RETURN FALSE END;
    IF arena[n].nch >= MaxChild THEN RETURN FALSE END;
    arena[n].child[arena[n].nch] := c;
    INC(arena[n].nch);
    RETURN TRUE
  END AddChild;

PROCEDURE SetChild (n : Node; i : CARDINAL; c : Node);
  BEGIN
    IF (n < 0) OR (n > VAL(INTEGER, nNodes) - 1) THEN RETURN END;
    IF i < arena[n].nch THEN
      arena[n].child[i] := c
    ELSIF (i = arena[n].nch) AND (arena[n].nch < MaxChild) THEN
      arena[n].child[i] := c;
      INC(arena[n].nch)
    END
  END SetChild;

PROCEDURE WriteSp (d : CARDINAL);
  VAR i: CARDINAL;
  BEGIN
    i := 0;
    WHILE i < d DO
      FileIO.WriteString(FileIO.StdOut, "  "); INC(i)
    END
  END WriteSp;

PROCEDURE IsLeafKind (k : INTEGER) : BOOLEAN;
  BEGIN
    RETURN (k = NkIdent) OR (k = NkIntLit) OR (k = NkRealLit)
        OR (k = NkStrLit) OR (k = NkCharLit) OR (k = NkTypeIdent)
        OR (k = NkImport)
  END IsLeafKind;

PROCEDURE Dump (n : Node; depth : CARDINAL);
  VAR i: CARDINAL; s: ARRAY [0 .. MaxTxtLen] OF CHAR;
  BEGIN
    IF n = NoNode THEN
      WriteSp(depth); FileIO.WriteString(FileIO.StdOut, "(nil)");
      FileIO.WriteLn(FileIO.StdOut); RETURN
    END;
    WriteSp(depth);
    FileIO.WriteString(FileIO.StdOut, "kind=");
    FileIO.WriteInt(FileIO.StdOut, arena[n].kind, 1);
    FileIO.WriteString(FileIO.StdOut, " op=");
    FileIO.WriteInt(FileIO.StdOut, arena[n].op, 1);
    FileIO.WriteString(FileIO.StdOut, " ty=");
    FileIO.WriteInt(FileIO.StdOut, arena[n].ty, 1);
    IF IsLeafKind(arena[n].kind) AND (arena[n].nch > 0)
       AND (arena[n].child[0] # NoNode) THEN
      Txt(VAL(TxtIndex, arena[n].child[0]), s);
      FileIO.WriteString(FileIO.StdOut, " '");
      FileIO.WriteString(FileIO.StdOut, s);
      FileIO.WriteString(FileIO.StdOut, "'")
    END;
    FileIO.WriteLn(FileIO.StdOut);
    i := 0;
    WHILE i < arena[n].nch DO
      IF NOT IsLeafKind(arena[n].kind) THEN
        Dump(arena[n].child[i], depth + 1)
      END;
      INC(i)
    END
  END Dump;

BEGIN
  Init
END AST.