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 signature ERRORMSG =
   6   sig
   7     val reset : unit -> unit
   8
   9     val anyErrors : bool ref
  10     val errorText : string ref
  11
  12     val fileName : string ref
  13     val sourceStream : TextIO.instream ref
  14
  15     val lineNum : int ref
  16     val linePos : int list ref
  17
  18     val error : (int * int) option -> string -> unit
  19
  20     exception Error
  21 end
  22
  23 structure ErrorMsg :> ERRORMSG =
  24   struct
  25     (* Initial values of compiler state variables *)
  26     val anyErrors = ref false
  27     val errorText = ref ""
  28     val fileName = ref ""
  29     val lineNum = ref 1
  30     val linePos = ref [1]
  31     val sourceStream = ref TextIO.stdIn
  32
  33     fun print msg = (errorText := !errorText ^ msg;
  34                      TextIO.print msg)
  35
  36     (* Reset compiler to initial state *)
  37     fun reset() = (anyErrors:=false;
  38                    errorText:="";
  39                    fileName:="";
  40                    lineNum:=1;
  41                    linePos:=[1];
  42                    sourceStream:=TextIO.stdIn)
  43
  44     (* Print the given error message *)
  45     fun error posopt (msg:string) =
  46       let
  47         val (startpos, endpos) = Option.getOpt (posopt, (0, 0))
  48         fun look(pos,a::rest,n) =
  49           if a<pos then app print [Int.toString n,
  50                                    ".",
  51                                    Int.toString (pos-a)]
  52           else look(pos,rest,n-1)
  53           | look _ = print "0.0"
  54       in
  55         anyErrors := true;
  56         print (!fileName); print ":";
  57         look(startpos, !linePos, !lineNum);
  58         if startpos=endpos then () else (print "-"; look(endpos, !linePos, !lineNum));
  59         app print [":error: ", msg, "\n"]
  60       end
  61
  62       exception Error
  63   end