Execute Brain****/Modula-3

From Rosetta Code
Execute Brain****/Modula-3 is an implementation of Brainf***. Other implementations of Brainf***.
Execute Brain****/Modula-3 is part of RCBF. You may find other members of RCBF at Category:RCBF.

This interpreter (in Modula-3) is a translation of the Ada RCBF interpreter, and has the same limits.

MODULE Bfi EXPORTS Main;

IMPORT Stdio, Wr, Rd, Params, FileRd, Text;

<*FATAL ANY*>

TYPE TData = [Bottom..LAST(INTEGER)];

CONST
  Bottom = -1;
  MemLast = 30000;
  ProgLast = 30000;

VAR
  M := ARRAY [0..MemLast] OF TData {0, ..};
  progName := Params.Get(1);
  program: FileRd.T;
  P: ARRAY [0..ProgLast] OF CHAR;
  Px: TEXT; (* workaround for char arrays. *)
  mp, pp, progLen, level: INTEGER;
  data: CHAR;
  OK: BOOLEAN;
  endInput := FALSE;
  endOutput := FALSE;

PROCEDURE MsgErr(msg: TEXT) =
  BEGIN
    Wr.PutText(Stdio.stdout, "\n");
    Wr.PutText(Stdio.stderr, "** Error: " & msg & "\n");
    OK := FALSE;
  END MsgErr;

BEGIN
  program := FileRd.Open(progName);
  Px := Rd.GetText(program, LAST(P));
  Rd.Close(program);
  progLen := Text.Length(Px);
  
  (* Px has type TEXT, but we want ARRAY OF CHAR, so we write
     the characters of Px into the char array P. *)
  Text.SetChars(P, Px);
  
  pp := 0;
  mp := 0;
  OK := TRUE;
  WHILE OK AND (pp < progLen) DO
    CASE P[pp] OF
    | '+' =>
      M[mp] := M[mp] + 1;
    | '-' =>
      IF M[mp] <= Bottom THEN
        MsgErr("Arithmetic underflow");
      ELSE
        M[mp] := M[mp] - 1;
      END;
    | '.' =>
      IF endOutput THEN
        MsgErr("Attempt to write past EOF");
      ELSIF M[mp] < 0 THEN
        endOutput := TRUE;
      ELSE
        Wr.PutChar(Stdio.stdout, VAL(M[mp], CHAR));
      END;
    | ',' =>
      IF endInput THEN
        MsgErr("Attempt to read past EOF");
      ELSE
        LOOP
          IF Rd.EOF(Stdio.stdin) THEN
            M[mp] := Bottom;
            endInput := TRUE;
            EXIT;
          ELSE
            data := Rd.GetChar(Stdio.stdin);
            M[mp] := ORD(data);
            IF data >= ' ' THEN
              EXIT;
            END;
          END;
        END;
      END;
    | '>' =>
      mp := mp + 1;
      IF mp > MemLast THEN
        MsgErr("Memory pointer overflow");
      END;
    | '<' =>
      mp := mp - 1;
      IF mp < 0 THEN
        MsgErr("Memory pointer underflow");
      END;
    | '[' =>
      IF M[mp] = 0 THEN
        pp := pp + 1;
        level := 0;
        WHILE pp < progLen AND (level > 0 OR P[pp] # ']') DO
          IF P[pp] = '[' THEN
            level := level + 1;
          END;
          IF P[pp] = ']' THEN
            level := level - 1;
          END;
          pp := pp + 1;
        END;
        IF pp >= progLen THEN
          MsgErr("No matching ']'");
        END;
      END;
    | ']' =>
      IF M[mp] # 0 THEN
        pp := pp - 1;
        level := 0;
        WHILE pp >= 0 AND (level > 0 OR P[pp] # '[') DO
          IF P[pp] = ']' THEN
            level := level + 1;
          END;
          IF P[pp] = '[' THEN
            level := level - 1;
          END;
          pp := pp - 1;
        END;
        IF pp < 0 THEN
          MsgErr("No matching '['");
        END;
      END;
    ELSE
      (* ignore *)
    END;
    pp := pp + 1;
  END;

Wr.PutText(Stdio.stdout, "\n");
END Bfi.