(* Copyright (C) 1992, Digital Equipment Corporation           *)
(* All rights reserved.                                        *)
(* See the file COPYRIGHT for a full description.              *)

(* File: Error.m3                                              *)
(* Last modified on Wed Apr 15 09:55:21 PDT 1992 by kalsow     *)
(*      modified on Fri Mar 22 08:29:36 1991 by muller         *)

MODULE Error;

IMPORT Fmt, String, MBuf, Host, Scanner;

TYPE
  Level = [0..3];

CONST
  Labels = ARRAY Level OF TEXT {
     ": info",     (* informational messages *)
     ": warning",  (* "fussy" warnings *)
     ": warning",  (* warnings *)
     ""            (* errors *)
  };

VAR
  count := ARRAY Level OF INTEGER {0, ..};

PROCEDURE Msg (msg: TEXT) =
  VAR wr := Header ();
  BEGIN
    Out (wr, msg);
    Trailer (wr);
  END Msg;

PROCEDURE Int (n: INTEGER;  msg: TEXT) =
  VAR wr := Header ();
  BEGIN
    Out (wr, msg);
    Out (wr, " (");
    Out (wr, Fmt.Int (n));
    Out (wr, ")");
    Trailer (wr);
  END Int;

PROCEDURE Str (s: String.T;  msg: TEXT) =
  VAR wr := Header ();
  BEGIN
    Out  (wr, msg);
    Out  (wr, " (");
    OutS (wr, s);
    Out  (wr, ")");
    Trailer (wr);
  END Str;

PROCEDURE QID (READONLY q: String.QID;  msg: TEXT) =
  VAR wr := Header ();
  BEGIN
    Out (wr, msg);
    Out (wr, " (");
    IF (q.module # NIL) THEN
      OutS (wr, q.module);
      Out  (wr, ".");
    END;
    OutS (wr, q.item);
    Out (wr, ")");
    Trailer (wr);
  END QID;

PROCEDURE ID (id, msg: TEXT) =
  VAR wr := Header ();
  BEGIN
    Out (wr, id);
    Out (wr, ": ");
    Out (wr, msg);
    Trailer (wr);
  END ID;

PROCEDURE Info (msg: TEXT) =
  BEGIN
    IF Toss (FIRST (Level)) THEN RETURN END;
    VAR wr := Header (FIRST (Level)); BEGIN
      Out (wr, msg);
      Trailer (wr);
    END;
  END Info;

PROCEDURE Warn (level: INTEGER;  msg: TEXT) =
  BEGIN
    IF Toss (level) THEN RETURN END;
    VAR wr := Header (level); BEGIN
      Out (wr, msg);
      Trailer (wr);
    END;
  END Warn;

PROCEDURE WarnStr (level: INTEGER;  s: String.T;  msg: TEXT) =
  BEGIN
    IF Toss (level) THEN RETURN END;
    VAR wr := Header (level); BEGIN
      Out  (wr, msg);
      Out  (wr, " (");
      OutS (wr, s);
      Out  (wr, ")");
      Trailer (wr);
    END;
  END WarnStr;

PROCEDURE Header (level: INTEGER := LAST (INTEGER)): MBuf.T =
  VAR file: String.T; line: INTEGER;  wr := MBuf.New ();
  BEGIN
    level := MAX (FIRST (Level), MIN (level, LAST (Level)));
    INC (count[level]);
    Scanner.Here (file, line);
    Out  (wr, "\"");
    OutS (wr, file);
    Out  (wr, "\", line ");
    Out  (wr, Fmt.Int (line));
    Out  (wr, Labels [level]);
    Out  (wr, ": ");
    RETURN wr;
  END Header;

PROCEDURE Trailer (wr: MBuf.T) =
  VAR n: INTEGER := 0;
  BEGIN
    Out (wr, "\n");
    MBuf.Flush (wr, Host.errors);
    IF (Host.errorDie >= 0) THEN
      FOR i := FIRST (count) TO LAST (count) DO INC (n, count[i]) END;
      IF (n >= Host.errorDie) THEN <* ASSERT FALSE *> END;
    END;
  END Trailer;

PROCEDURE Out (wr: MBuf.T;  t: TEXT) =
  BEGIN
    MBuf.PutText (wr, t);
  END Out;

PROCEDURE OutS (wr: MBuf.T;  s: String.T) =
  BEGIN
    String.Put (wr, s);
  END OutS;

PROCEDURE Count (VAR nErrors, nWarnings: INTEGER) =
  BEGIN
    nErrors := count [LAST (count)];
    nWarnings := 0;
    FOR i := FIRST (count) + 1 TO LAST (count) - 1 DO
      INC (nWarnings, count[i]);
    END;
  END Count;

TYPE IgnoreCell = UNTRACED REF RECORD offs: INTEGER; next: IgnoreCell END;
VAR ignores: IgnoreCell := NIL;

PROCEDURE IgnoreWarning (offset: INTEGER) =
  BEGIN
    WITH i = NEW (IgnoreCell) DO
      i.offs := offset;
      i.next := ignores;
      ignores := i;
    END;
  END IgnoreWarning;

PROCEDURE Toss (level: INTEGER): BOOLEAN =
  VAR i: IgnoreCell;  here: INTEGER;
  BEGIN
    IF (level < Host.warnings) THEN RETURN TRUE END;
    here := Scanner.offset;
    i := ignores;
    WHILE (i # NIL) DO
      IF (i.offs = here) THEN RETURN TRUE END;
      i := i.next;
    END;
    RETURN FALSE;
  END Toss;

PROCEDURE Reset () =
  BEGIN
    ignores := NIL;
    FOR i := FIRST (count) TO LAST (count) DO count[i] := 0 END;
  END Reset;

BEGIN
END Error.