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   (* symbol set -- similar to a () Symbol.table, elements can be removed *)
  44   type set
  45   val null : set                (* empty set *)
  46   val singleton : symbol -> set (* generate a set with one item *)
  47   val add : set -> symbol -> set (* add a symbol *)
  48   val remove : set -> symbol -> set (* remove a symbol *)
  49   val member : set -> symbol -> bool (* is the symbol in the set? *)
  50   val showmems : set -> string  (* returns the string of delimited names, for debugging *)
  51 end
  52
  53
  54 structure Symbol :> SYMBOL =
  55 struct
  56   type symbol = string * int
  57
  58   val bogus = ("?", ~1)
  59   fun is_bogus (_, ~1) = true
  60     | is_bogus _ = false
  61
  62   fun compare ((n, i), (n', i')) =
  63       if i < 0 orelse i' < 0 then GREATER
  64       else Int.compare (i, i')
  65
  66   local
  67     exception Symbol
  68     val nexts = ref 0
  69     fun initht () =
  70       HashTable.mkTable (HashString.hashString, fn (x, y) => String.compare (x, y) = EQUAL)
  71       (128, Symbol)
  72     val ht = ref (initht ())
  73   in
  74     fun reset () = (nexts := 0;
  75                     ht := initht ())
  76     fun symbol name =
  77       (case HashTable.find (!ht) name of
  78          SOME i => (name, i)
  79        | NONE => let
  80                    val i = !nexts before nexts := !nexts + 1
  81                  in
  82                    HashTable.insert (!ht) (name, i);
  83                    (name, i)
  84                  end)
  85
  86   end
  87
  88   fun name (n, i) = n
  89
  90   structure Map = BinaryMapFn (struct
  91                                  type ord_key = symbol
  92                                  val compare = compare
  93                                end)
  94
  95   type 'a table = 'a Map.map
  96
  97   val empty = Map.empty
  98   fun digest l = List.foldr (fn ((s, v), m) => Map.insert (m, s, v)) empty l
  99
 100   fun bind t (s, x) = Map.insert (t, s, x)
 101   fun look t s = Map.find (t, s)
 102   fun look' t s = Option.valOf (look t s)
 103   fun count t = Map.numItems t
 104   fun elems t = Map.listItems t
 105   fun elemsi t = Map.listItemsi t
 106   fun keys t = Map.listKeys t
 107   fun intersect binding (t1,t2) = Map.intersectWith binding (t1,t2)
 108
 109   fun delimit' [] s = s
 110     | delimit' [x] s = s ^ x
 111     | delimit' (x :: xs) s = delimit' xs (s ^ x ^ ", ")
 112   fun delimit l = delimit' l "[" ^ "]"
 113
 114   structure Set = BinarySetFn (struct
 115                                  type ord_key = symbol
 116                                  val compare = compare
 117                                end)
 118
 119   type set = Set.set
 120
 121   val null = Set.empty
 122   val singleton = Set.singleton
 123   fun add S s = Set.add (S, s)
 124   fun remove S s = Set.delete (S, s)
 125   fun member S s = Set.member (S, s)
 126   fun showmems S = delimit (List.map name (Set.listItems S))
 127 end