[MLton-commit] r5448
Vesa Karvonen
vesak at mlton.org
Sun Mar 18 15:59:48 PST 2007
Using ResizableArray.
----------------------------------------------------------------------
U mltonlib/trunk/com/ssh/misc-util/unstable/mk-int-obj-cache.fun
----------------------------------------------------------------------
Modified: mltonlib/trunk/com/ssh/misc-util/unstable/mk-int-obj-cache.fun
===================================================================
--- mltonlib/trunk/com/ssh/misc-util/unstable/mk-int-obj-cache.fun 2007-03-18 23:53:28 UTC (rev 5447)
+++ mltonlib/trunk/com/ssh/misc-util/unstable/mk-int-obj-cache.fun 2007-03-18 23:59:47 UTC (rev 5448)
@@ -7,41 +7,26 @@
(** Makes a cache module whose keys are int objects. *)
functor MkIntObjCache (Key : INT_OBJ) :> CACHE
where type Key.t = Key.t = struct
- structure Key = Key
+ structure Key = Key and R = ResizableArray
- datatype 'a t =
- IN of {size : Int.t Ref.t,
- table : {key : Key.t, value : 'a} Option.t Array.t Ref.t}
- fun gt s (IN r) = ! (s r)
- fun st s (IN r) v = s r := v
+ type 'a t = {key : Key.t, value : 'a} R.t
exception NotFound
- fun size c = gt#size c
- fun cap c = Array.length (gt#table c)
+ val size = R.length
+ val isEmpty = R.isEmpty
+ val new = R.new
- fun isEmpty c = 0 = size c
-
- fun sub c i = valOf (Array.sub (gt#table c, i))
- fun update c (i, v) = Array.update (gt#table c, i, v)
-
- fun new () = IN {size = ref 0, table = ref (Array.tabulate (0, undefined))}
-
- fun realloc (IN {size, table}) newCap =
- table := Array.tabulate
- (newCap,
- fn i => if i < !size then Array.sub (!table, i) else NONE)
-
fun putWith c k2v = let
val n = size c
val k = Key.new n
in
- (if cap c = n then realloc c (n*2+1) else ()
- ; let val v = k2v k
- in st#size c (n+1)
- ; update c (n, SOME {key = k, value = v})
- ; (k, v)
- end)
+ let
+ val v = k2v k
+ in
+ R.push c {key = k, value = v}
+ ; (k, v)
+ end
handle e => (Key.discard k ; raise e)
end
@@ -49,8 +34,8 @@
fun get c k = let
val i = Key.get k
in
- if i<0 orelse size c <= i then raise NotFound else let
- val {value, key} = sub c i
+ if i < 0 orelse size c <= i then raise NotFound else let
+ val {value, key} = R.sub (c, i)
in
if k <> key then raise NotFound else value
end
@@ -58,13 +43,13 @@
fun rem c k = let
val n = size c - 1
val i = Key.get k
- val r = sub c n
+ val r = R.sub (c, n)
in
- if i<0 orelse n<i orelse #key (sub c i) <> k then raise NotFound else ()
- ; Key.discard k ; update c (i, SOME r) ; Key.set (#key r) i
- ; update c (n, NONE) ; st#size c n
- ; if n*4 < cap c then realloc c (cap c div 2) else ()
+ if i<0 orelse n<i orelse #key (R.sub (c, i)) <> k
+ then raise NotFound else ()
+ ; Key.discard k ; R.update (c, i, r) ; Key.set (#key r) i
+ ; ignore (R.pop c)
end
fun use c k = get c k before rem c k
- fun values c = List.tabulate (size c, #value o sub c)
+ fun values (c : 'a t) = List.tabulate (size c, #value o c <\ R.sub)
end
More information about the MLton-commit
mailing list