util/mark.sml

   1 (* L1 Compiler
   2  * Positional Markers
   3  * Author: Kaustuv Chaudhuri <kaustuv+@cs.cmu.edu>
   4  * Annotations / bugfixes: Alex Vaynberg <alv@andrew.cmu.edu>
   5  *)
   6
   7 signature MARK =
   8 sig
   9   type ext = (int * int) * (int * int) * string  (* position *)
  10
  11   val show : ext -> string      (* converts the data into human readable form *)
  12
  13   type 'a marked                (* value with positional information *)
  14
  15   (* INTRODUCTION FUNCTIONS for type 'a marked *)
  16
  17   (* put together a value and positional information *)
  18   val mark : 'a * ext -> 'a marked
  19
  20   (* put together a value and an option of positional information *)
  21   val mark' : 'a * ext option -> 'a marked
  22
  23   (* mark the value with no positional information *)
  24   val naked : 'a -> 'a marked
  25
  26   (* ELIMINATION FUNCTIONS for type a' marked *)
  27
  28   (* data: remove the markings *)
  29   val data : 'a marked -> 'a
  30
  31   (* ext: retrieve positional information from marked value*)
  32   val ext : 'a marked -> ext option
  33
  34
  35   (* USEFUL TOOLS *)
  36
  37   (* wrap:
  38    * returns SOME of positional information unit that contains each one in the list
  39    * NONE if such wrap is not possible (spans several files, etc.)
  40    *)
  41   val wrap : ext option list -> ext option
  42
  43   (* map: make your function keep positional information *)
  44   val map : ('a -> 'b) -> 'a marked -> 'b marked
  45   (* map': similar to map, but f can now use positional information
  46    * and preserve it at the same time
  47    *)
  48   val map' : ('a marked -> 'b) -> 'a marked -> 'b marked
  49 end
  50
  51 structure Mark :> MARK =
  52 struct
  53   type ext = (int * int) * (int * int) * string
  54
  55   fun pos (row, 0) = Int.toString row
  56     | pos (row, col) = Int.toString row ^ "." ^ Int.toString col
  57
  58   fun show (l, r, file) = file ^ ":" ^ pos l ^ "-" ^ pos r
  59
  60   type 'a marked = 'a * ext option
  61
  62   fun mark (d, e) = (d, SOME e)
  63   fun mark' (d, e) = (d, e)
  64   fun naked d = (d, NONE)
  65
  66   fun data (d, e) = d
  67   fun ext (d, e) = e
  68
  69   fun extmin ((l1, c1), (l2, c2)) =
  70         if l1 < l2 then (l1, c1)
  71         else
  72           if l1 > l2 then (l2, c2)
  73           else (l1, Int.min (c1, c2))
  74   fun extmax ((l1, c1), (l2, c2)) =
  75         if l1 > l2 then (l1, c1)
  76         else
  77           if l1 > l2 then (l2, c2)
  78           else (l1, Int.min (c1, c2))
  79
  80   fun wrap [] = NONE
  81     | wrap (e :: []) = e
  82     | wrap (e :: el) =
  83       (case wrap el of
  84            NONE => NONE
  85          | SOME (el1, el2, elf) =>
  86            (case e of
  87                 SOME (e1, e2, ef) =>
  88                 if String.compare (ef, elf) = EQUAL then
  89                     SOME (extmin (e1, el1), extmax (e2, el2), ef)
  90                 else NONE
  91               | NONE => SOME (el1, el2, elf)))
  92
  93
  94   fun map f (d, e) = (f d, e)
  95   fun map' f (m as (d, e)) = (f m, e)
  96 end