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