adamc@0: (* Copyright (c) 2008, Adam Chlipala
adamc@0:  * All rights reserved.
adamc@0:  *
adamc@0:  * Redistribution and use in source and binary forms, with or without
adamc@0:  * modification, are permitted provided that the following conditions are met:
adamc@0:  *
adamc@0:  * - Redistributions of source code must retain the above copyright notice,
adamc@0:  *   this list of conditions and the following disclaimer.
adamc@0:  * - Redistributions in binary form must reproduce the above copyright notice,
adamc@0:  *   this list of conditions and the following disclaimer in the documentation
adamc@0:  *   and/or other materials provided with the distribution.
adamc@0:  * - The names of contributors may not be used to endorse or promote products
adamc@0:  *   derived from this software without specific prior written permission.
adamc@0:  *
adamc@0:  * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
adamc@0:  * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
adamc@0:  * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
adamc@0:  * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
adamc@0:  * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR 
adamc@0:  * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
adamc@0:  * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
adamc@0:  * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
adamc@0:  * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
adamc@0:  * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
adamc@0:  * POSSIBILITY OF SUCH DAMAGE.
adamc@0:  *)
adamc@0: 
adamc@0: structure ErrorMsg :> ERROR_MSG = struct
adamc@0: 
adamc@0: type pos = {line : int,
adamc@0:             char : int}
adamc@0: 
adamc@0: type span = {file : string,
adamc@0:              first : pos,
adamc@0:              last : pos}
adamc@0: 
adamc@0: type 'a located = 'a * span
adamc@0: 
adamc@1: 
adamc@1: fun posToString {line, char} =
adamc@1:     String.concat [Int.toString line, ":", Int.toString char]
adamc@1: 
adamc@1: fun spanToString {file, first, last} =
adamc@1:     String.concat [file, ":", posToString first, "-", posToString last]
adamc@1: 
adamc@3: val dummyPos = {line = 0,
adamc@3:                 char = 0}
adamc@3: val dummySpan = {file = "",
adamc@3:                  first = dummyPos,
adamc@3:                  last = dummyPos}
adamc@3: 
adamc@1: 
adamc@1: val file = ref ""
adamc@1: val numLines = ref 1
adamc@1: val lines : int list ref = ref []
adamc@1: 
adamc@1: fun resetPositioning fname = (file := fname;
adamc@1:                               numLines := 1;
adamc@1:                               lines := [])
adamc@1: 
adamc@1: fun newline pos = (numLines := !numLines + 1;
adamc@1:                    lines := pos :: !lines)
adamc@1: 
adamc@1: fun lastLineStart () =
adamc@1:     case !lines of
adamc@1:         [] => 0
adamc@1:       | n :: _ => n+1
adamc@1: 
adamc@1: fun posOf n =
adamc@1:     let
adamc@1:         fun search lineNum lines =
adamc@1:             case lines of
adamc@1:                 [] => {line = 1,
adamc@1:                        char = n}
adamc@1:               | bound :: rest =>
adamc@1:                 if n > bound then
adamc@1:                     {line = lineNum,
adamc@1:                      char = n - bound - 1}
adamc@1:                 else
adamc@1:                     search (lineNum - 1) rest
adamc@1:     in
adamc@1:         search (!numLines) (!lines)
adamc@1:     end
adamc@1: 
adamc@1: fun spanOf (pos1, pos2) = {file = !file,
adamc@1:                            first = posOf pos1,
adamc@1:                            last = posOf pos2}
adamc@1: 
adamc@1: 
adamc@1: val errors = ref false
adamc@1: 
adamc@1: fun resetErrors () = errors := false
adamc@1: fun anyErrors () = !errors
adamc@1: fun error s = (TextIO.output (TextIO.stdErr, s);
adamc@1:                TextIO.output1 (TextIO.stdErr, #"\n");
adamc@1:                errors := true)
adamc@1: fun errorAt span s = (TextIO.output (TextIO.stdErr, spanToString span);
adamc@591:                       TextIO.output (TextIO.stdErr, ": ");
adamc@1:                       error s)
adamc@1: fun errorAt' span s = errorAt (spanOf span) s
adamc@1: 
adamc@0: end