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

(* File: Error.m3                                              *)
(* Last modified on Wed Jul 18 01:30:34 1990 by muller         *)
(*      modified on Wed Feb 14 13:09:58 1990 by kalsow         *)



MODULE Error;

IMPORT Text, Fmt, String, Wr, Host, Scanner;

TYPE
  Level = [0..3];

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

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

PROCEDURE Msg (msg: Text.T) =
  BEGIN
    Header ();
    Out (msg);
    Trailer ();
  END Msg;

PROCEDURE Int (n: INTEGER;  msg: Text.T) =
  BEGIN
    Header ();
    Out (msg);
    Out (" (");
    Out (Fmt.Int (n));
    Out (")");
    Trailer ();
  END Int;

PROCEDURE Str (s: String.T;  msg: Text.T) =
  BEGIN
    Header ();
    Out  (msg);
    Out  (" (");
    OutS (s);
    Out  (")");
    Trailer ();
  END Str;

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

PROCEDURE ID (id, msg: Text.T) =
  BEGIN
    Header ();
    Out (id);
    Out (": ");
    Out (msg);
    Trailer ();
  END ID;

PROCEDURE Info (msg: Text.T) =
  BEGIN
    IF Toss (FIRST (Level)) THEN RETURN END;
    Header (FIRST (Level));
    Out (msg);
    Trailer ();
  END Info;

PROCEDURE Warn (level: INTEGER;  msg: Text.T) =
  BEGIN
    IF Toss (level) THEN RETURN END;
    Header (level);
    Out (msg);
    Trailer ();
  END Warn;

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

PROCEDURE WarnNonStandard (feature: Text.T) =
  VAR level: INTEGER;
  BEGIN
    IF (Host.standard)
      THEN level := LAST (Level);
      ELSE level := LAST (Level) - 1;
    END;
    IF Toss (level) THEN RETURN END;
    Header (level);
    Out ("non-standard Modula-3: ");
    Out (feature);
    Trailer ();
  END WarnNonStandard;

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

PROCEDURE Trailer () =
  VAR n: INTEGER := 0;
  BEGIN
    Out ("\n");
    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 (t: Text.T) =
  BEGIN
    Wr.PutText (Host.errors, t);
  END Out;

PROCEDURE OutS (s: String.T) =
  BEGIN
    String.Put (Host.errors, 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;

BEGIN
END Error.