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   val kane : 'a marked -> 'a
  31
  32   (* ext: retrieve positional information from marked value*)
  33   val ext : 'a marked -> ext option
  34
  35
  36   (* USEFUL TOOLS *)
  37
  38   (* wrap:
  39    * returns SOME of positional information unit that contains each one in the list
  40    * NONE if such wrap is not possible (spans several files, etc.)
  41    *)
  42   val wrap : ext option list -> ext option
  43
  44   (* map: make your function keep positional information *)
  45   val map : ('a -> 'b) -> 'a marked -> 'b marked
  46   (* map': similar to map, but f can now use positional information
  47    * and preserve it at the same time
  48    *)
  49   val map' : ('a marked -> 'b) -> 'a marked -> 'b marked
  50 end
  51
  52 structure Mark :> MARK =
  53 struct
  54   type ext = (int * int) * (int * int) * string
  55
  56   fun pos (row, 0) = Int.toString row
  57     | pos (row, col) = Int.toString row ^ "." ^ Int.toString col
  58
  59   fun show (l, r, file) = file ^ ":" ^ pos l ^ "-" ^ pos r
  60
  61   type 'a marked = 'a * ext option
  62
  63   fun mark (d, e) = (d, SOME e)
  64   fun mark' (d, e) = (d, e)
  65   fun naked d = (d, NONE)
  66
  67   fun data (d, e) = d
  68   val kane = data
  69   fun ext (d, e) = e
  70
  71   fun extmin ((l1, c1), (l2, c2)) =
  72         if l1 < l2 then (l1, c1)
  73         else
  74           if l1 > l2 then (l2, c2)
  75           else (l1, Int.min (c1, c2))
  76   fun extmax ((l1, c1), (l2, c2)) =
  77         if l1 > l2 then (l1, c1)
  78         else
  79           if l1 > l2 then (l2, c2)
  80           else (l1, Int.min (c1, c2))
  81
  82   fun wrap [] = NONE
  83     | wrap (e :: []) = e
  84     | wrap (e :: el) =
  85       (case wrap el of
  86            NONE => NONE
  87          | SOME (el1, el2, elf) =>
  88            (case e of
  89                 SOME (e1, e2, ef) =>
  90                 if String.compare (ef, elf) = EQUAL then
  91                     SOME (extmin (e1, el1), extmax (e2, el2), ef)
  92                 else NONE
  93               | NONE => SOME (el1, el2, elf)))
  94
  95
  96   fun map f (d, e) = (f d, e)
  97   fun map' f (m as (d, e)) = (f m, e)
  98 end