[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