Theia-Modula-2/grammars/Blaise/TextFilter.mod

MODULE TextFilter;
(* Pre-scan filter for the Blaise validator: rewrites TEXT_BLOCK literals
 * (''' ... ''') into plain string-shaped placeholders so the Coco/R
 * scanner (which cannot distinguish '''-open from string-escape in its
 * merged DFA) never sees triple quotes.
 *
 * Length- and newline-preserving: every rewritten block keeps the exact
 * byte length and all newline positions, so parser diagnostics keep
 * correct line/column positions. Only well-formed blocks (opening '''
 * directly followed by a newline, outside strings/comments) are
 * rewritten; anything else passes through untouched.
 *
 * Usage: TextFilter <input.pas> <output.pas> *)

  FROM FileIO IMPORT File, NextParameter, Open, Okay, Close, Length,
                     StdOut, WriteString, WriteLn, Reset, EndOfFile;
  IMPORT FileIO;
  FROM Storage IMPORT ALLOCATE;

  VAR
    srcName, dstName: ARRAY [0..255] OF CHAR;
    src, dst: File;
    buf: POINTER TO ARRAY [0..16777215] OF CHAR;
    len: CARDINAL;
    i, n: CARDINAL;

  PROCEDURE At (p: CARDINAL): CHAR;
    BEGIN
      RETURN buf^[p]
    END At;

  PROCEDURE Put (p: CARDINAL; c: CHAR);
    BEGIN
      buf^[p] := c
    END Put;

  PROCEDURE IsNl (c: CHAR): BOOLEAN;
    BEGIN
      RETURN (c = CHR(10)) OR (c = CHR(13))
    END IsNl;

  PROCEDURE SkipString;
    (* buf[i] = opening quote; skip through closing quote (''-aware). *)
    BEGIN
      INC(i);
      WHILE (i < len) & (At(i) # "'") & ~ IsNl(At(i)) DO
        IF (At(i) = "'") & (i + 1 < len) & (At(i + 1) = "'") THEN
          INC(i, 2)
        ELSE
          INC(i)
        END
      END;
      IF (i < len) & (At(i) = "'") THEN INC(i) END
    END SkipString;

  PROCEDURE SkipBrace;
    (* buf[i] = "{"; skip through "}". *)
    BEGIN
      INC(i);
      WHILE (i < len) & (At(i) # "}") DO INC(i) END;
      IF (i < len) THEN INC(i) END
    END SkipBrace;

  PROCEDURE SkipLine;
    (* buf[i..] starts "//"; skip through newline (exclusive). *)
    BEGIN
      INC(i, 2);
      WHILE (i < len) & ~ IsNl(At(i)) DO INC(i) END
    END SkipLine;

  PROCEDURE SkipParen;
    (* buf[i..] starts "(*"; skip through matching "*)" (nested). *)
    VAR depth: INTEGER;
    BEGIN
      depth := 1; INC(i, 2);
      WHILE (i < len) & (depth > 0) DO
        IF (At(i) = "(") & (i + 1 < len) & (At(i + 1) = "*") THEN
          INC(depth); INC(i, 2)
        ELSIF (At(i) = "*") & (i + 1 < len) & (At(i + 1) = ")") THEN
          DEC(depth); INC(i, 2)
        ELSE
          INC(i)
        END
      END
    END SkipParen;

  PROCEDURE TryTextBlock (): BOOLEAN;
    (* buf[i..i+2] = "'''", not preceded by a quote. If directly followed
       by a newline, blank the whole block to a string-shaped placeholder
       (same length, newlines kept) and return TRUE. *)
    VAR j, k: CARDINAL; nl: BOOLEAN;
    BEGIN
      IF (i + 2 >= len) THEN RETURN FALSE END;
      IF (At(i) # "'") OR (At(i + 1) # "'") OR (At(i + 2) # "'") THEN
        RETURN FALSE
      END;
      IF (i > 0) & (At(i - 1) = "'") THEN RETURN FALSE END;
      j := i + 3;
      nl := FALSE;
      IF (j < len) & (At(j) = CHR(13)) THEN
        INC(j);
        IF (j < len) & (At(j) = CHR(10)) THEN INC(j) END;
        nl := TRUE
      ELSIF (j < len) & (At(j) = CHR(10)) THEN
        INC(j);
        nl := TRUE
      END;
      IF ~ nl THEN RETURN FALSE END;
      k := j;
      WHILE (k + 2 < len) & ~ ((At(k) = "'") & (At(k + 1) = "'") & (At(k + 2) = "'")) DO
        INC(k)
      END;
      IF (k + 2 >= len) THEN RETURN FALSE END;
      Put(i + 1, " "); Put(i + 2, " ");
      WHILE j < k DO
        IF ~ IsNl(At(j)) THEN Put(j, " ") END;
        INC(j)
      END;
      Put(k, " "); Put(k + 1, " ");
      i := k + 3;
      RETURN TRUE
    END TryTextBlock;

  PROCEDURE Run;
    BEGIN
      i := 0;
      WHILE i < len DO
        IF (At(i) = "'") THEN
          IF ~ TryTextBlock() THEN SkipString END
        ELSIF (At(i) = "{") THEN SkipBrace
        ELSIF (At(i) = "/") & (i + 1 < len) & (At(i + 1) = "/") THEN SkipLine
        ELSIF (At(i) = "(") & (i + 1 < len) & (At(i + 1) = "*") THEN SkipParen
        ELSE INC(i)
        END
      END
    END Run;

  PROCEDURE ReadAll;
    VAR c: CHAR;
    BEGIN
      len := VAL(CARDINAL, Length(src));
      ALLOCATE(buf, len + 1);
      Reset(src);
      n := 0;
      WHILE ~ EndOfFile(src) & (n < len) DO
        FileIO.Read(src, c);
        Put(n, c);
        INC(n)
      END
    END ReadAll;

  PROCEDURE WriteAll;
    VAR m: CARDINAL;
    BEGIN
      Open(dst, dstName, TRUE);
      IF ~ Okay THEN
        WriteString(StdOut, "Could not open output file"); WriteLn(StdOut);
        HALT
      END;
      m := 0;
      WHILE m < len DO
        FileIO.Write(dst, At(m));
        INC(m)
      END;
      Close(dst)
    END WriteAll;

  BEGIN
    NextParameter(srcName);
    NextParameter(dstName);
    IF (srcName[0] = 0C) OR (dstName[0] = 0C) THEN
      WriteString(StdOut, "Usage: TextFilter <input> <output>"); WriteLn(StdOut);
      HALT
    END;
    Open(src, srcName, FALSE);
    IF ~ Okay THEN
      WriteString(StdOut, "Could not open input file"); WriteLn(StdOut);
      HALT
    END;
    ReadAll;
    Close(src);
    Run;
    WriteAll
  END TextFilter.