]> Joshua Wise's Git repositories - snipe.git/blob - util/symbol.sml
Initial import of l4c
[snipe.git] / 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
This page took 0.030481 seconds and 4 git commands to generate.