util/symbol.sml

   1 (* L1 Compiler
   2  * The symbol tables
   3  * Author: Kaustuv Chaudhuri <kaustuv+@cs.cmu.edu>
   4  *)
   5
   6 (* uses, from $/smlnj-lib/Util/
   7    structure HashTable
   8    structure HashString
   9    functor BinaryMapFn
  10    functor BinarySetFn
  11 *)
  12
  13
  14 signature SYMBOL =
  15 sig
  16   type symbol
  17   val compare : symbol * symbol -> order (* compare symbols by their creation time
  18                                           * GREATER if they can not be compared
  19                                           *)
  20
  21   val bogus : symbol            (* a dummy symbol, less than others *)
  22   val is_bogus : symbol -> bool
  23
  24   val reset : unit -> unit      (* resets the hash table in which the symbols are stored *)
  25   val symbol : string -> symbol (* generates a new symbol with given name *)
  26   val name : symbol -> string   (* returns a name associated with symbol *)
  27
  28   (* symbol tables -- allows association of any type with each symbol *)
  29   type 'a table
  30   val empty : 'a table          (* empty table *)
  31   val digest : (symbol * 'a) list -> 'a table (* prefilled table *)
  32
  33   val bind : 'a table -> symbol * 'a -> 'a table (* insert new item into table *)
  34   val look : 'a table -> symbol -> 'a option (* return the value from the table *)
  35   val look' : 'a table -> symbol -> 'a (* returns value from table, raise Option if not found *)
  36   val count : 'a table -> int   (* returns the number of items in the table *)
  37
  38   val elems : 'a table -> 'a list (* return all the data as a list *)
  39   val elemsi : 'a table -> (symbol * 'a) list (* return the symbols with the associated data *)
  40   val keys : 'a table -> symbol list (* just the symbols *)
  41   val intersect : ('a * 'a -> 'a) -> 'a table * 'a table -> 'a table
  42
  43   val mapi : (symbol * 'a -> 'b) -> 'a table -> 'b table
  44   val mapPartial : ('a -> 'b option) -> 'a table -> 'b table
  45   val mapPartiali : (symbol * 'a -> 'b option) -> 'a table -> 'b table
  46   val appi : (symbol * 'a -> unit) -> 'a table -> unit
  47
  48   (* symbol set -- similar to a () Symbol.table, elements can be removed *)
  49   type set
  50   val null : set                (* empty set *)
  51   val singleton : symbol -> set (* generate a set with one item *)
  52   val add : set -> symbol -> set (* add a symbol *)
  53   val remove : set -> symbol -> set (* remove a symbol *)
  54   val member : set -> symbol -> bool (* is the symbol in the set? *)
  55   val showmems : set -> string  (* returns the string of delimited names, for debugging *)
  56 end
  57
  58
  59 structure Symbol :> SYMBOL =
  60 struct
  61   type symbol = string * int
  62
  63   val bogus = ("?", ~1)
  64   fun is_bogus (_, ~1) = true
  65     | is_bogus _ = false
  66
  67   fun compare ((n, i), (n', i')) =
  68       if i < 0 orelse i' < 0 then GREATER
  69       else Int.compare (i, i')
  70
  71   local
  72     exception Symbol
  73     val nexts = ref 0
  74     fun initht () =
  75       HashTable.mkTable (HashString.hashString, fn (x, y) => String.compare (x, y) = EQUAL)
  76       (128, Symbol)
  77     val ht = ref (initht ())
  78   in
  79     fun reset () = (nexts := 0;
  80                     ht := initht ())
  81     fun symbol name =
  82       (case HashTable.find (!ht) name of
  83          SOME i => (name, i)
  84        | NONE => let
  85                    val i = !nexts before nexts := !nexts + 1
  86                  in
  87                    HashTable.insert (!ht) (name, i);
  88                    (name, i)
  89                  end)
  90
  91   end
  92
  93   fun name (n, i) = n
  94
  95   structure Map = BinaryMapFn (struct
  96                                  type ord_key = symbol
  97                                  val compare = compare
  98                                end)
  99
 100   type 'a table = 'a Map.map
 101
 102   val empty = Map.empty
 103   fun digest l = List.foldr (fn ((s, v), m) => Map.insert (m, s, v)) empty l
 104
 105   fun bind t (s, x) = Map.insert (t, s, x)
 106   fun look t s = Map.find (t, s)
 107   fun look' t s = Option.valOf (look t s)
 108   fun count t = Map.numItems t
 109   fun elems t = Map.listItems t
 110   fun elemsi t = Map.listItemsi t
 111   fun keys t = Map.listKeys t
 112   fun intersect binding (t1,t2) = Map.intersectWith binding (t1,t2)
 113   fun mapi f t = Map.mapi f t
 114   fun mapPartial f t = Map.mapPartial f t
 115   fun mapPartiali f t = Map.mapPartiali f t
 116   fun appi f t = Map.appi f t
 117
 118   fun delimit' [] s = s
 119     | delimit' [x] s = s ^ x
 120     | delimit' (x :: xs) s = delimit' xs (s ^ x ^ ", ")
 121   fun delimit l = delimit' l "[" ^ "]"
 122
 123   structure Set = BinarySetFn (struct
 124                                  type ord_key = symbol
 125                                  val compare = compare
 126                                end)
 127
 128   type set = Set.set
 129
 130   val null = Set.empty
 131   val singleton = Set.singleton
 132   fun add S s = Set.add (S, s)
 133   fun remove S s = Set.delete (S, s)
 134   fun member S s = Set.member (S, s)
 135   fun showmems S = delimit (List.map name (Set.listItems S))
 136 end