[MLton-commit] r5447

Vesa Karvonen vesak at mlton.org
Sun Mar 18 15:53:30 PST 2007


Added ResizableArray and factored Buffer and ResizableArray to use a
common implementation.

----------------------------------------------------------------------

U   mltonlib/trunk/com/ssh/extended-basis/unstable/detail/ml/smlnj/sigs.cm
U   mltonlib/trunk/com/ssh/extended-basis/unstable/detail/ml/smlnj/unsealed.cm
U   mltonlib/trunk/com/ssh/extended-basis/unstable/detail/sequence/buffer.sml
A   mltonlib/trunk/com/ssh/extended-basis/unstable/detail/sequence/mk-buffer-common.fun
A   mltonlib/trunk/com/ssh/extended-basis/unstable/detail/sequence/resizable-array.sml
U   mltonlib/trunk/com/ssh/extended-basis/unstable/extensions.mlb
U   mltonlib/trunk/com/ssh/extended-basis/unstable/public/export/common.sml
U   mltonlib/trunk/com/ssh/extended-basis/unstable/public/sequence/buffer.sig
A   mltonlib/trunk/com/ssh/extended-basis/unstable/public/sequence/resizable-array.sig

----------------------------------------------------------------------

Modified: mltonlib/trunk/com/ssh/extended-basis/unstable/detail/ml/smlnj/sigs.cm
===================================================================
--- mltonlib/trunk/com/ssh/extended-basis/unstable/detail/ml/smlnj/sigs.cm	2007-03-18 23:45:25 UTC (rev 5446)
+++ mltonlib/trunk/com/ssh/extended-basis/unstable/detail/ml/smlnj/sigs.cm	2007-03-18 23:53:28 UTC (rev 5447)
@@ -65,6 +65,7 @@
    ../../../public/sequence/mono-array.sig
    ../../../public/sequence/mono-vector-slice.sig
    ../../../public/sequence/mono-vector.sig
+   ../../../public/sequence/resizable-array.sig
    ../../../public/sequence/vector-slice.sig
    ../../../public/sequence/vector.sig
    ../../../public/text/char.sig

Modified: mltonlib/trunk/com/ssh/extended-basis/unstable/detail/ml/smlnj/unsealed.cm
===================================================================
--- mltonlib/trunk/com/ssh/extended-basis/unstable/detail/ml/smlnj/unsealed.cm	2007-03-18 23:45:25 UTC (rev 5446)
+++ mltonlib/trunk/com/ssh/extended-basis/unstable/detail/ml/smlnj/unsealed.cm	2007-03-18 23:53:28 UTC (rev 5447)
@@ -63,12 +63,14 @@
    ../../../detail/sequence/array.sml
    ../../../detail/sequence/buffer.sml
    ../../../detail/sequence/list.sml
+   ../../../detail/sequence/mk-buffer-common.fun
    ../../../detail/sequence/mk-mono-array-ext.fun
    ../../../detail/sequence/mk-mono-array-slice-ext.fun
    ../../../detail/sequence/mk-mono-seq-common-ext.fun
    ../../../detail/sequence/mk-mono-vector-ext.fun
    ../../../detail/sequence/mk-mono-vector-slice-ext.fun
    ../../../detail/sequence/mk-seq-common-ext.fun
+   ../../../detail/sequence/resizable-array.sml
    ../../../detail/sequence/vector-slice.sml
    ../../../detail/sequence/vector.sml
    ../../../detail/text/mk-text-ext.fun

Modified: mltonlib/trunk/com/ssh/extended-basis/unstable/detail/sequence/buffer.sml
===================================================================
--- mltonlib/trunk/com/ssh/extended-basis/unstable/detail/sequence/buffer.sml	2007-03-18 23:45:25 UTC (rev 5446)
+++ mltonlib/trunk/com/ssh/extended-basis/unstable/detail/sequence/buffer.sml	2007-03-18 23:53:28 UTC (rev 5447)
@@ -5,60 +5,12 @@
  *)
 
 structure Buffer :> BUFFER = struct
-   structure A = Array and AS = ArraySlice and V = Vector and VS = VectorSlice
-   datatype 'a t = IN of {length : int ref, data : 'a A.t ref}
-   fun new () = IN {length = ref 0, data = ref (A.fromList [])}
-   fun duplicate (IN {length, data}) =
-       IN {length = ref (!length), data = ref (A.duplicate (!data))}
-   fun length (IN {length, ...}) = !length
-   fun isEmpty b = 0 = length b
-   fun data (IN {data, ...}) = !data
-   fun sub (b, i) = if length b <= i then raise Subscript else A.sub (data b, i)
-   local
-      fun cap b = A.length (data b)
-      fun decideCap c r = if r <= c then c else decideCap (2*c+1) r
-   in
-      fun ensureCap (b as IN {data, ...}) reqCap filler =
-          if reqCap <= cap b then ()
-          else let val oldData = !data
-               in data := A.tabulate (decideCap (cap b) reqCap,
-                                      fn i => if A.length oldData <= i then
-                                                 filler
-                                              else
-                                                 A.sub (oldData, i))
-               end
-   end
-   local
-      fun mk sLength sAny sCopy (b as IN {length, data}) s =
-          case sLength s of
-             0 => ()
-           | n => let
-                val newLength = !length + n
-             in ensureCap b newLength (sAny s)
-              ; sCopy {src = s, dst = !data, di = !length} : unit
-              ; length := newLength
-             end
-      infixr />
-      val op /> = Fn./>
-   in
-      fun push ? =
-          mk (Fn.const 1) Fn.id (fn {src, dst, di} => A.update (dst, di, src)) ?
-      fun pushArray ? = mk A.length (A.sub /> 0) A.copy ?
-      fun pushArraySlice ? = mk AS.length (AS.sub /> 0) AS.copy ?
-      fun pushBuffer b s =
-          pushArraySlice b (AS.slice (data s, 0, SOME (length s)))
-      fun pushList ? =
-          mk List.length List.hd
-             (fn {src, dst, di} =>
-                 List.appi (fn (i, x) => A.update (dst, di+i, x)) src) ?
-      fun pushVector ? = mk V.length (V.sub /> 0) A.copyVec ?
-      fun pushVectorSlice ? = mk VS.length (VS.sub /> 0) AS.copyVec ?
-   end
-   local
-      fun mk tabulate b = tabulate (length b, fn i => sub (b, i))
-   in
-      fun toArray  ? = mk A.tabulate ?
-      fun toList   ? = mk List.tabulate ?
-      fun toVector ? = mk V.tabulate ?
-   end
+   structure Buffer =
+      MkBufferCommon (type 'a elem = 'a
+                      val inj = Fn.id val prj = Fn.id val any = Fn.id)
+   open Buffer
+
+   fun reserve b newCap =
+       if newCap <= capacity b orelse isEmpty b then ()
+       else realloc (asub (array b) 0) b newCap
 end

Added: mltonlib/trunk/com/ssh/extended-basis/unstable/detail/sequence/mk-buffer-common.fun
===================================================================
--- mltonlib/trunk/com/ssh/extended-basis/unstable/detail/sequence/mk-buffer-common.fun	2007-03-18 23:45:25 UTC (rev 5446)
+++ mltonlib/trunk/com/ssh/extended-basis/unstable/detail/sequence/mk-buffer-common.fun	2007-03-18 23:53:28 UTC (rev 5447)
@@ -0,0 +1,88 @@
+(* Copyright (C) 2007 SSH Communications Security, Helsinki, Finland
+ *
+ * This code is released under the MLton license, a BSD-style license.
+ * See the LICENSE file or http://mlton.org/License for details.
+ *)
+
+functor MkBufferCommon (type 'a elem
+                        val inj : 'a -> 'a elem
+                        val prj : 'a elem -> 'a
+                        val any : 'a -> 'a elem) = struct
+   structure A=Array and AS=ArraySlice and V=Vector and VS=VectorSlice and L=List
+   datatype 'a t = T of {array : 'a elem A.t Ref.t, length : Int.t Ref.t}
+
+   fun the s (T r) = s r
+   fun get s = ! o the s
+   fun set s t v = the s t := v
+
+   fun array ? = get#array ?
+   fun length ? = get#length ?
+
+   fun isEmpty t = 0 = length t
+
+   fun asub a i = A.sub (a, i)
+
+   fun chk t i = if length t <= i then raise Subscript else ()
+
+   fun sub (t, i) = (chk t i ; prj (asub (array t) i))
+   fun update (t, i, v) = (chk t i ; A.update (array t, i, inj v))
+
+   fun new () = T {array = ref (A.empty ()), length = ref 0}
+   fun duplicate t = let
+      val n = length t
+   in
+      T {array = ref (A.tabulate (n, asub (array t))), length = ref n}
+   end
+
+   fun capacity t = A.length (array t)
+   fun trim t = set#array t (A.tabulate (length t, asub (array t)))
+
+   fun realloc fill t newCap = let
+      val n = length t
+      val a = array t
+   in
+      set#array t (A.tabulate (newCap, fn i => if i<n then asub a i else fill))
+   end
+
+   fun ensureCap filler b reqCap = let
+      val cap = capacity b
+   in
+      if reqCap <= cap then () else realloc filler b (Int.max (reqCap, cap*2+1))
+   end
+
+   local
+      fun mk sLength sAny sAppi sInj b s =
+          case sLength s of
+             0 => ()
+           | n => let
+                val oldLength = length b
+                val newLength = oldLength + n
+             in ensureCap (sAny s) b newLength
+              ; sAppi let
+                   val a = array b
+                in
+                   fn (i, v) => A.update (a, i+oldLength, sInj v)
+                end s : Unit.t
+              ; set#length b newLength
+             end
+      infixr />
+      val op /> = Fn./>
+   in
+      fun push ? = mk (Fn.const 1) any (fn ef => fn v => ef (0, v)) inj ?
+      fun pushArray ? = mk A.length (any o A.sub /> 0) A.appi inj ?
+      fun pushArraySlice ? = mk AS.length (any o AS.sub /> 0) AS.appi inj ?
+      fun pushBuffer b s = mk AS.length (AS.sub /> 0) AS.appi Fn.id b
+                              (AS.slice (array s, 0, SOME (length s)))
+      fun pushList ? = mk L.length (any o L.hd) L.appi inj ?
+      fun pushVector ? = mk V.length (any o V.sub /> 0) V.appi inj ?
+      fun pushVectorSlice ? = mk VS.length (any o VS.sub /> 0) VS.appi inj ?
+   end
+
+   local
+      fun to tabulate t = tabulate (length t, prj o asub (array t))
+   in
+      fun toArray ? = to A.tabulate ?
+      fun toList ? = to L.tabulate ?
+      fun toVector ? = to V.tabulate ?
+   end
+end


Property changes on: mltonlib/trunk/com/ssh/extended-basis/unstable/detail/sequence/mk-buffer-common.fun
___________________________________________________________________
Name: svn:eol-style
   + native

Added: mltonlib/trunk/com/ssh/extended-basis/unstable/detail/sequence/resizable-array.sml
===================================================================
--- mltonlib/trunk/com/ssh/extended-basis/unstable/detail/sequence/resizable-array.sml	2007-03-18 23:45:25 UTC (rev 5446)
+++ mltonlib/trunk/com/ssh/extended-basis/unstable/detail/sequence/resizable-array.sml	2007-03-18 23:53:28 UTC (rev 5447)
@@ -0,0 +1,29 @@
+(* Copyright (C) 2007 SSH Communications Security, Helsinki, Finland
+ *
+ * This code is released under the MLton license, a BSD-style license.
+ * See the LICENSE file or http://mlton.org/License for details.
+ *)
+
+structure ResizableArray :> RESIZABLE_ARRAY = struct
+   structure Buffer =
+      MkBufferCommon (type 'a elem = 'a Option.t
+                      val inj = SOME val prj = valOf fun any _ = NONE)
+   open Buffer
+
+   fun reserve b newCap =
+       if newCap <= capacity b then () else realloc NONE b newCap
+
+   fun pop t = let
+      val n = length t - 1
+   in
+      if n < 0 then NONE else let
+         val a = array t
+         val result = A.sub (a, n)
+      in
+         A.update (a, n, NONE)
+       ; set#length t n
+       ; if n*3 < capacity t then realloc NONE t (capacity t div 2) else ()
+       ; result
+      end
+   end
+end


Property changes on: mltonlib/trunk/com/ssh/extended-basis/unstable/detail/sequence/resizable-array.sml
___________________________________________________________________
Name: svn:eol-style
   + native

Modified: mltonlib/trunk/com/ssh/extended-basis/unstable/extensions.mlb
===================================================================
--- mltonlib/trunk/com/ssh/extended-basis/unstable/extensions.mlb	2007-03-18 23:45:25 UTC (rev 5446)
+++ mltonlib/trunk/com/ssh/extended-basis/unstable/extensions.mlb	2007-03-18 23:53:28 UTC (rev 5447)
@@ -208,8 +208,13 @@
 
          (* Buffer *)
          public/sequence/buffer.sig
+         detail/sequence/mk-buffer-common.fun
          detail/sequence/buffer.sml
 
+         (* ResizableArray *)
+         public/sequence/resizable-array.sig
+         detail/sequence/resizable-array.sml
+
          (* Reader *)
          public/io/reader.sig
          detail/io/reader.sml

Modified: mltonlib/trunk/com/ssh/extended-basis/unstable/public/export/common.sml
===================================================================
--- mltonlib/trunk/com/ssh/extended-basis/unstable/public/export/common.sml	2007-03-18 23:45:25 UTC (rev 5446)
+++ mltonlib/trunk/com/ssh/extended-basis/unstable/public/export/common.sml	2007-03-18 23:53:28 UTC (rev 5447)
@@ -73,6 +73,7 @@
 signature READER = READER
 signature REAL = REAL
 signature REF = REF
+signature RESIZABLE_ARRAY = RESIZABLE_ARRAY
 signature SHIFT_OP = SHIFT_OP
 signature SQ = SQ
 signature STRING = STRING
@@ -145,6 +146,7 @@
 structure Reader : READER = Reader
 structure Real : REAL = Real
 structure Ref : REF where type 'a t = 'a ref = Ref
+structure ResizableArray : RESIZABLE_ARRAY = ResizableArray
 structure ShiftOp : SHIFT_OP = ShiftOp
 structure String : STRING = String
 structure Substring : SUBSTRING = Substring

Modified: mltonlib/trunk/com/ssh/extended-basis/unstable/public/sequence/buffer.sig
===================================================================
--- mltonlib/trunk/com/ssh/extended-basis/unstable/public/sequence/buffer.sig	2007-03-18 23:45:25 UTC (rev 5446)
+++ mltonlib/trunk/com/ssh/extended-basis/unstable/public/sequence/buffer.sig	2007-03-18 23:53:28 UTC (rev 5447)
@@ -4,7 +4,12 @@
  * See the LICENSE file or http://mlton.org/License for details.
  *)
 
-(** Imperative dynamically growing buffer. *)
+(**
+ * Imperative dynamically growing buffer.  A (plain) buffer only allows
+ * elements to be pushed to the end.  This simplifies the implementation.
+ *
+ * See also: {RESIZABLE_ARRAY}
+ *)
 signature BUFFER = sig
    type 'a t
    (** The type of buffers. *)
@@ -20,6 +25,36 @@
     * to {let val b' = new () in pushBuffer b' b end}.
     *)
 
+   (** == Capacity == *)
+
+   val capacity : 'a t -> Int.t
+   (**
+    * Returns the maximum length after which it becomes necessary for the
+    * buffer to allocate more storage for holding additional elements.  It
+    * always holds that {length b <= capacity b}.
+    *)
+
+   val reserve : 'a t -> Int.t Effect.t
+   (**
+    * {reserve b n} attempts to ensure that {n <= capacity b}.  Does
+    * nothing if the specified capacity is smaller than the current
+    * capacity.  Also, the capacity of some type of buffers can not be
+    * increased when they are empty.
+    *
+    * This can be used to avoid incremental (re)allocation when one knows
+    * how many elements will be pushed into the buffer.
+    *)
+
+   val trim : 'a t Effect.t
+   (**
+    * Attempts to eliminate excess capacity allocated for the buffer.  In
+    * other words, after {trim b} it should be that {capacity b - length
+    * b} is as small as possible.
+    *
+    * Warning: Trim should be used with care as it can destroy asymptotic
+    * complexity guarantees.
+    *)
+
    (** == Accessors == *)
 
    val isEmpty : 'a t UnPr.t
@@ -54,7 +89,11 @@
     * equivalent to {Vector.fromList (toList b)}.
     *)
 
-   (** == Adding Elements to a Buffer == *)
+   (** == Adding Elements to a Buffer ==
+    *
+    * It is generally guaranteed that adding elements to a buffer does not
+    * reduce the capacity of the buffer.
+    *)
 
    val push : 'a t -> 'a Effect.t
    (**
@@ -65,6 +104,9 @@
     *> val ca = toList b
     *
     * it holds that {cb = init ca} and {last ca = v}.
+    *
+    * Assuming that {trim} is never called, then the amortized complexity
+    * of {push} is O(1).
     *)
 
    val pushArray : 'a t -> 'a Array.t Effect.t

Added: mltonlib/trunk/com/ssh/extended-basis/unstable/public/sequence/resizable-array.sig
===================================================================
--- mltonlib/trunk/com/ssh/extended-basis/unstable/public/sequence/resizable-array.sig	2007-03-18 23:45:25 UTC (rev 5446)
+++ mltonlib/trunk/com/ssh/extended-basis/unstable/public/sequence/resizable-array.sig	2007-03-18 23:53:28 UTC (rev 5447)
@@ -0,0 +1,27 @@
+(* Copyright (C) 2007 SSH Communications Security, Helsinki, Finland
+ *
+ * This code is released under the MLton license, a BSD-style license.
+ * See the LICENSE file or http://mlton.org/License for details.
+ *)
+
+(**
+ * Imperative resizable array.
+ *)
+signature RESIZABLE_ARRAY = sig
+   include BUFFER
+
+   (** == Mutators == *)
+
+   val update : ('a t * Int.t * 'a) Effect.t
+   (**
+    * {update (a, i, v)} Sets the {i}th element of the resizable array {a}
+    * to {v}.  If {i < 0} or {length a <= i}, then the {Subscript}
+    * exception is raised.
+    *)
+
+   val pop : 'a t -> 'a Option.t
+   (**
+    * Removes the last element {v} of the resizable array and returns
+    * {SOME v} or {NONE} if the resizable array is empty.
+    *)
+end


Property changes on: mltonlib/trunk/com/ssh/extended-basis/unstable/public/sequence/resizable-array.sig
___________________________________________________________________
Name: svn:eol-style
   + native




More information about the MLton-commit mailing list