mlton/control/source-pos.sml

   1 (* Copyright (C) 2017 Matthew Fluet.
   2  * Copyright (C) 1999-2007 Henry Cejtin, Matthew Fluet, Suresh
   3  *    Jagannathan, and Stephen Weeks.
   4  * Copyright (C) 1997-2000 NEC Research Institute.
   5  *
   6  * MLton is released under a BSD-style license.
   7  * See the file MLton-LICENSE for details.
   8  *)
   9
  10 structure SourcePos: SOURCE_POS =
  11 struct
  12
  13 datatype t = T of {column: int,
  14                    file: File.t,
  15                    line: int}
  16
  17 local
  18    fun f g (T r) = g r
  19 in
  20    val column = f #column
  21    val line = f #line
  22 end
  23
  24 fun compare (T {column = c, file = f, line = l},
  25              T {column = c', file = f', line = l'}) =
  26    case String.compare (f, f') of
  27       EQUAL =>
  28          (case Int.compare (l, l') of
  29              EQUAL => Int.compare (c, c')
  30            | r => r)
  31     | r => r
  32
  33 fun equals (T r, T r') = r = r'
  34
  35 fun fileEquals (T {file = f, ...}, T {file = f', ...}) =
  36    String.equals (f, f')
  37
  38 fun make {column, file, line} =
  39    T {column = column,
  40       file = file,
  41       line = line}
  42
  43 fun getLib (T {file, ...}) =
  44    let
  45       val libDir = concat [!ControlFlags.libDir, "/sml"]
  46    in
  47       if String.hasPrefix (file, {prefix = libDir})
  48          then SOME (String.size libDir)
  49          else NONE
  50    end
  51
  52 fun file (p as T {file, ...}) =
  53    if !ControlFlags.preferAbsPaths
  54       then file
  55       else
  56          case getLib p of
  57             NONE => file
  58           | SOME i =>
  59                concat ["$(SML_LIB)", String.dropPrefix (file, i)]
  60
  61 val bogus = T {column = ~1,
  62                file = "<bogus>",
  63                line = ~1}
  64
  65 fun isBogus p = equals (p, bogus)
  66
  67 fun posToString (T {line, column, ...}) =
  68    concat [Int.toString line, ".", Int.toString column]
  69
  70 fun toString p =
  71    concat [file p, " ", posToString p]
  72
  73 end