(* Hasht.sml *) (* Hash tables *) (* We do dynamic hashing, and we double the size of the table when buckets become too long, but without re-hashing the elements. *) open Array;infix 9 sub; datatype ('a, 'b) bucketlist = Cons of 'a * int * 'b * ('a, 'b) bucketlist | Empty; type ('a, 'b) TCell = { max_len: int, (* max length of a bucket *) data: ('a, 'b) bucketlist array } (* the buckets *); type ('a, 'b) t = ('a, 'b) TCell ref; fun forup f a b = let fun loop i = if i > b then () else (f i; loop (i+1)) in loop a end; fun new initial_size = ref { max_len = 3, data = array(initial_size, Empty) }; fun clear h = let val {data, max_len} = !h in forup (fn i => update(data, i, Empty)) 0 (Array.length data - 1) end; fun resize h = let val {data, max_len} = !h val len = Array.length data val newlen = len+len+1 val newdata = array(newlen, Empty) fun dispatch Empty = () | dispatch (Cons(k, c, v, rest)) = let val () = dispatch rest val i = c mod newlen in update(newdata, i, Cons(k, c, v, newdata sub i)) end in forup (fn i => dispatch(data sub i)) 0 (len-1); h := { data = newdata, max_len = 2 * max_len}; () end; fun bucket_too_long n bucket = if n < 0 then true else case bucket of Empty => false | Cons(_, _, _, rest) => bucket_too_long (n-1) rest; prim_val hash_param : int -> int -> 'a -> int = 3 "hash_univ_param"; fun hash x = hash_param 50 500 x; fun insert h key value = let val {data, max_len} = !h val code = hash_param 10 100 key fun insert_bucket Empty = Cons(key, code, value, Empty) | insert_bucket (Cons(k, c, v, next)) = if code = c andalso k = key then Cons(key, code, value, next) else Cons(k, c, v, insert_bucket next) val i = code mod (Array.length data) val bucket = insert_bucket (data sub i) in update(data, i, bucket); if bucket_too_long max_len bucket then resize h else () end; fun remove h key = let val {data, max_len : int} = !h val code = hash_param 10 100 key fun remove_bucket Empty = Empty | remove_bucket (Cons(k, c, v, next)) = if code = c andalso k = key then next else Cons(k, c, v, remove_bucket next) val i = code mod (Array.length data) in update(data, i, remove_bucket (data sub i)) end; fun find h key = let val {data, max_len : int} = !h val code = (hash_param 10 100 key) in case data sub (code mod (Array.length data)) of Empty => raise Subscript | Cons(k1, c1, d1, rest1) => if code = c1 andalso key = k1 then d1 else case rest1 of Empty => raise Subscript | Cons(k2, c2, d2, rest2) => if code = c2 andalso key = k2 then d2 else case rest2 of Empty => raise Subscript | Cons(k3, c3, d3, rest3) => if code = c3 andalso key = k3 then d3 else let fun find Empty = raise Subscript | find (Cons(k, c, d, rest)) = if code = c andalso key = k then d else find rest in find rest3 end end; fun peek h key = let val {data, max_len : int} = !h val code = (hash_param 10 100 key) in case data sub (code mod (Array.length data)) of Empty => NONE | Cons(k1, c1, d1, rest1) => if code = c1 andalso key = k1 then SOME d1 else case rest1 of Empty => NONE | Cons(k2, c2, d2, rest2) => if code = c2 andalso key = k2 then SOME d2 else case rest2 of Empty => NONE | Cons(k3, c3, d3, rest3) => if code = c3 andalso key = k3 then SOME d3 else let fun peek Empty = NONE | peek (Cons(k, c, d, rest)) = if code = c andalso key = k then SOME d else peek rest in peek rest3 end end; fun apply f h = let val {data, max_len : int} = !h val len = Array.length data in forup (fn i => let fun scan_bucket Empty = () | scan_bucket (Cons(k, c, d, rest)) = ( f k d : unit; scan_bucket rest ) in scan_bucket (data sub i) end) 0 (len - 1) end; fun fold f e h = let val {data, max_len : int} = !h fun fold_bucket (Empty, res) = res | fold_bucket (Cons(k, c, d, rest), res) = fold_bucket (rest, f k d res) in Array.foldl fold_bucket e data end;
(* Hasht.sml *)
(* Hash tables *)
(* We do dynamic hashing, and we double the size of the table when
buckets become too long, but without re-hashing the elements. *)
open Array;
infix 9 sub;
datatype ('a, 'b) bucketlist =
Cons of 'a * int * 'b * ('a, 'b) bucketlist
| Empty
;
type ('a, 'b) TCell =
{ max_len: int, (* max length of a bucket *)
data: ('a, 'b) bucketlist array } (* the buckets *)
;
type ('a, 'b) t = ('a, 'b) TCell ref;
fun forup f a b =
let fun loop i = if i > b then () else (f i; loop (i+1))
in loop a end
;
fun new initial_size =
ref { max_len = 3, data = array(initial_size, Empty) }
;
fun clear h =
let val {data, max_len} = !h in
forup (fn i => update(data, i, Empty))
0 (Array.length data - 1)
end
;
fun resize h =
let val {data, max_len} = !h
val len = Array.length data
val newlen = len+len+1
val newdata = array(newlen, Empty)
fun dispatch Empty = ()
| dispatch (Cons(k, c, v, rest)) =
let val () = dispatch rest
val i = c mod newlen
in update(newdata, i, Cons(k, c, v, newdata sub i)) end
in
forup (fn i => dispatch(data sub i)) 0 (len-1);
h := { data = newdata, max_len = 2 * max_len};
()
end
;
fun bucket_too_long n bucket =
if n < 0 then true else
case bucket of
Empty => false
| Cons(_, _, _, rest) => bucket_too_long (n-1) rest
;
prim_val hash_param : int -> int -> 'a -> int = 3 "hash_univ_param";
fun hash x = hash_param 50 500 x;
fun insert h key value =
let val {data, max_len} = !h
val code = hash_param 10 100 key
fun insert_bucket Empty =
Cons(key, code, value, Empty)
| insert_bucket (Cons(k, c, v, next)) =
if code = c andalso k = key then
Cons(key, code, value, next)
else Cons(k, c, v, insert_bucket next)
val i = code mod (Array.length data)
val bucket = insert_bucket (data sub i)
in
update(data, i, bucket);
if bucket_too_long max_len bucket then resize h else ()
end
;
fun remove h key =
let val {data, max_len : int} = !h
val code = hash_param 10 100 key
fun remove_bucket Empty = Empty
| remove_bucket (Cons(k, c, v, next)) =
if code = c andalso k = key then
next
else Cons(k, c, v, remove_bucket next)
val i = code mod (Array.length data)
in update(data, i, remove_bucket (data sub i)) end
;
fun find h key =
let val {data, max_len : int} = !h
val code = (hash_param 10 100 key)
in
case data sub (code mod (Array.length data)) of
Empty => raise Subscript
| Cons(k1, c1, d1, rest1) =>
if code = c1 andalso key = k1 then d1 else
case rest1 of
Empty => raise Subscript
| Cons(k2, c2, d2, rest2) =>
if code = c2 andalso key = k2 then d2 else
case rest2 of
Empty => raise Subscript
| Cons(k3, c3, d3, rest3) =>
if code = c3 andalso key = k3 then d3 else
let fun find Empty = raise Subscript
| find (Cons(k, c, d, rest)) =
if code = c andalso key = k then d else find rest
in find rest3 end
end;
fun peek h key =
let val {data, max_len : int} = !h
val code = (hash_param 10 100 key)
in
case data sub (code mod (Array.length data)) of
Empty => NONE
| Cons(k1, c1, d1, rest1) =>
if code = c1 andalso key = k1 then SOME d1 else
case rest1 of
Empty => NONE
| Cons(k2, c2, d2, rest2) =>
if code = c2 andalso key = k2 then SOME d2 else
case rest2 of
Empty => NONE
| Cons(k3, c3, d3, rest3) =>
if code = c3 andalso key = k3 then SOME d3 else
let fun peek Empty = NONE
| peek (Cons(k, c, d, rest)) =
if code = c andalso key = k then SOME d
else peek rest
in peek rest3 end
end;
fun apply f h =
let val {data, max_len : int} = !h
val len = Array.length data
in
forup (fn i =>
let fun scan_bucket Empty = ()
| scan_bucket (Cons(k, c, d, rest)) =
( f k d : unit; scan_bucket rest )
in scan_bucket (data sub i) end)
0 (len - 1)
end
;
fun fold f e h =
let val {data, max_len : int} = !h
fun fold_bucket (Empty, res) = res
| fold_bucket (Cons(k, c, d, rest), res) =
fold_bucket (rest, f k d res)
in
Array.foldl fold_bucket e data
end
;