Fix file paths for recursive rmdom
[hcoop/domtool2.git] / src / errormsg.sml
1 (* This file comes mostly from "Modern Compiler Implementation in ML," by Andrew Appel
2 * http://www.cs.princeton.edu/~appel/modern/ml/
3 *)
4
5 structure ErrorMsg :> ERRORMSG =
6 struct
7 (* Initial values of compiler state variables *)
8 val anyErrors = ref false
9 val errorText = ref ""
10 val fileName = ref ""
11 val lineNum = ref 1
12 val linePos = ref [1]
13 val sourceStream = ref TextIO.stdIn
14
15 fun print msg = (errorText := !errorText ^ msg;
16 TextIO.print msg)
17
18 (* Reset compiler to initial state *)
19 fun reset() = (anyErrors:=false;
20 errorText:="";
21 fileName:="";
22 lineNum:=1;
23 linePos:=[1];
24 sourceStream:=TextIO.stdIn)
25
26 (* Print the given error message *)
27 fun error posopt (msg:string) =
28 let
29 val (startpos, endpos) = Option.getOpt (posopt, (0, 0))
30 fun look(pos,a::rest,n) =
31 if a<pos then app print [Int.toString n,
32 ".",
33 Int.toString (pos-a)]
34 else look(pos,rest,n-1)
35 | look _ = print "0.0"
36 in
37 anyErrors := true;
38 print (!fileName); print ":";
39 look(startpos, !linePos, !lineNum);
40 if startpos=endpos then () else (print "-"; look(endpos, !linePos, !lineNum));
41 app print [":error: ", msg, "\n"]
42 end
43
44 val dummyLoc = (0, 0)
45
46 exception Error
47 end
48