[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