1(*
2 * Copyright 2014, NICTA
3 *
4 * This software may be distributed and modified according to the terms of
5 * the BSD 2-Clause license. Note that NO WARRANTY is provided.
6 * See "LICENSE_BSD2.txt" for details.
7 *
8 * @TAG(NICTA_BSD)
9 *)
10
11signature FEEDBACK =
12sig
13
14  exception WantToExit of string
15  val numErrors : int ref
16  val errorThreshold : int option ref
17  val errorStr : Region.t * string -> unit
18  val errorStr' : SourcePos.t * SourcePos.t * string -> unit
19  val warnStr' : SourcePos.t * SourcePos.t * string -> unit
20  val informStr : int * string -> unit
21  val informStr' : int * SourcePos.t * SourcePos.t * string -> unit
22
23  val errorf : (string -> unit) ref
24  val warnf : (string -> unit) ref
25  val informf : (string -> unit) ref
26
27  val verbosity_level : int ref
28
29  val timestamp : string -> string
30
31end
32
33structure Feedback :> FEEDBACK =
34struct
35
36exception WantToExit of string
37val isSome = Option.isSome
38
39val numErrors = ref 0
40val errorThreshold = ref (SOME 10)
41
42fun default s =  (TextIO.output(TextIO.stdErr, s);
43                  TextIO.flushOut TextIO.stdErr)
44
45val errorf = ref default
46val warnf = ref default
47val informf = ref default
48
49val verbosity_level = ref 1
50
51fun informStr (v,s) = if v <= !verbosity_level then !informf (s ^ "\n") else ()
52fun informStr' (v,l,r,s) =
53    informStr (v,Region.toString(Region.make {left = l, right = r}) ^ ": " ^ s)
54
55fun errorStr (r, s) = let
56in
57  !errorf (Region.toString r ^ ": " ^ s ^ "\n");
58  numErrors := !numErrors + 1;
59  if isSome (!errorThreshold) andalso !numErrors > valOf (!errorThreshold) then
60    raise WantToExit "Too many errors - aborted."
61  else ()
62end
63
64fun errorStr' (l,r,s) = errorStr(Region.make {left = l, right = r}, s)
65
66
67fun warnStr' (l,r,s) =
68    !warnf ("Warning "^SourcePos.toString l^ " " ^ s ^ "\n")
69
70fun timestamp s = Time.fmt 0 (Time.now()) ^ ": " ^ s
71
72end; (* struct *)
73
74
75