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