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 anyWarnings = ref false
  10     val errorText = ref ""
  11     val fileName = ref ""
  12     val lineNum = ref 1
  13     val linePos = ref [1]
  14     val sourceStream = ref TextIO.stdIn
  15
  16     fun print msg = (errorText := !errorText ^ msg;
  17                      TextIO.print msg)
  18
  19     (* Reset compiler to initial state *)
  20     fun reset() = (anyErrors:=false;
  21                    anyWarnings:=false;
  22                    errorText:="";
  23                    fileName:="";
  24                    lineNum:=1;
  25                    linePos:=[1];
  26                    sourceStream:=TextIO.stdIn)
  27
  28     fun notify f prefix posopt (msg:string) =
  29       let
  30         val (startpos, endpos) = Option.getOpt (posopt, (0, 0))
  31         fun look(pos,a::rest,n) =
  32           if a<pos then app print [Int.toString n,
  33                                    ".",
  34                                    Int.toString (pos-a)]
  35           else look(pos,rest,n-1)
  36           | look _ = print "0.0"
  37       in
  38         f ();
  39         print (!fileName); print ":";
  40         look(startpos, !linePos, !lineNum);
  41         if startpos=endpos then () else (print "-"; look(endpos, !linePos, !lineNum));
  42         app print [":", prefix, ": ", msg, "\n"]
  43       end
  44
  45     val error = notify (fn () => anyErrors := true) "error"
  46     val warning = notify (fn () => anyWarnings := true) "warning"
  47
  48       val dummyLoc = (0, 0)
  49
  50       exception Error
  51   end
  52