M persistent-array.sig +24 -15
@@ 3,34 3,43 @@ signature PERSISTENT_ARRAY = sig
type 'a array (* nb not an eqtype *)
+ (* I. Functions identical to ARRAY *)
+
val maxLen : int
-
+ val array : int * 'a -> 'a array
val fromList : 'a list -> 'a array
val tabulate : int * (int -> 'a) -> 'a array
val length : 'a array -> int
-
val sub : 'a array * int -> 'a
- val update : 'a array * int * 'a -> 'a array
-
+ val vector : 'a array -> 'a Vector.vector
+ val app : ('a -> unit) -> 'a array -> unit
val appi : (int * 'a -> unit) -> 'a array -> unit
- val app : ('a -> unit) -> 'a array -> unit
-
- val mapi : (int * 'a -> 'b) -> 'a array -> 'b array
- val map : ('a -> 'b) -> 'a array -> 'b array
-
val foldl : ('a * 'b -> 'b) -> 'b -> 'a array -> 'b
val foldli : (int * 'a * 'b -> 'b) -> 'b -> 'a array -> 'b
-
val foldr : ('a * 'b -> 'b) -> 'b -> 'a array -> 'b
val foldri : (int * 'a * 'b -> 'b) -> 'b -> 'a array -> 'b
+ val find : ('a -> bool) -> 'a array -> 'a option
+ val findi : (int * 'a -> bool) -> 'a array -> (int * 'a) option
+ val exists : ('a -> bool) -> 'a array -> bool
+ val all : ('a -> bool) -> 'a array -> bool
+ val collate : ('a * 'a -> order) -> 'a array * 'a array -> order
+ (* II. Functions similar to ARRAY, but altered for persistent
+ array. The functions passed to modify/modifyi should return
+ NONE for "no change" or SOME x to change the value. *)
+
+ val update : 'a array * int * 'a -> 'a array
+ val modify : ('a -> 'a option) -> 'a array -> 'a array
+ val modifyi : (int * 'a -> 'a option) -> 'a array -> 'a array
+
+ (* III. Functions not in ARRAY *)
+
+ val toList : 'a array -> 'a list
+ val map : ('a -> 'b) -> 'a array -> 'b array
+ val mapi : (int * 'a -> 'b) -> 'a array -> 'b array
val empty : 'a array
val isEmpty : 'a array -> bool
-
val append : 'a array * 'a -> 'a array
val popEnd : 'a array -> 'a array * 'a
-
- val toList : 'a array -> 'a list
-
- (* !!! + collate etc *)
+
end
M persistent-array.sml +48 -2
@@ 75,6 75,19 @@ structure PersistentArray :> PERSISTENT_
fun foldri f acc { size, trie } =
T.foldri (fn (w, x, acc) => f (Word32.toInt w, x, acc)) acc trie
+ fun find f { size, trie } =
+ T.search f trie
+
+ fun findi f { size, trie } =
+ Option.map (fn (w, x) => (Word32.toInt w, x))
+ (T.searchi (fn (w, x) => f (Word32.toInt w, x)) trie)
+
+ fun exists f { size, trie } =
+ Option.isSome (T.search f trie)
+
+ fun all f { size, trie } =
+ not (Option.isSome (T.search (fn x => not (f x)) trie))
+
fun mapi f v =
foldli (fn (i, x, acc) => append (acc, f (i, x))) empty v
@@ 100,6 113,39 @@ structure PersistentArray :> PERSISTENT_
end
fun toList v =
- rev (foldl (op::) [] v)
-
+ foldr (op::) [] v
+
+ fun vector v =
+ Vector.fromList (toList v)
+
+ fun modifyi f v =
+ foldli (fn (i, x, updating) =>
+ case f (i, x) of
+ NONE => updating
+ | SOME x' => update (updating, i, x'))
+ v v
+
+ fun modify f v =
+ modifyi (fn (i, x) => f x) v
+
+ fun collate f (v1, v2) =
+ let val len1 = length v1
+ val len2 = length v2
+ fun collate' i =
+ if i = len1
+ then if i = len2
+ then EQUAL
+ else LESS
+ else if i = len2
+ then GREATER
+ else case f (sub (v1, i), sub (v2, i)) of
+ EQUAL => collate' (i+1)
+ | order => order
+ in
+ collate' 0
+ end
+
+ fun array (n, x) =
+ tabulate (n, fn _ => x)
+
end
M persistent-queue.sig +29 -5
@@ 1,11 1,35 @@
signature PERSISTENT_QUEUE = sig
- include PERSISTENT_ARRAY
+ type 'a queue
- type 'a queue = 'a array
+ (* I. Functions also found in PERSISTENT_ARRAY *)
- val prepend : 'a array * 'a -> 'a array
- val popStart : 'a array -> 'a array * 'a
-
+ val maxLen : int
+ val fromList : 'a list -> 'a queue
+ val tabulate : int * (int -> 'a) -> 'a queue
+ val length : 'a queue -> int
+ val sub : 'a queue * int -> 'a
+ val vector : 'a queue -> 'a Vector.vector
+ val app : ('a -> unit) -> 'a queue -> unit
+ val appi : (int * 'a -> unit) -> 'a queue -> unit
+ val foldl : ('a * 'b -> 'b) -> 'b -> 'a queue -> 'b
+ val foldli : (int * 'a * 'b -> 'b) -> 'b -> 'a queue -> 'b
+ val foldr : ('a * 'b -> 'b) -> 'b -> 'a queue -> 'b
+ val foldri : (int * 'a * 'b -> 'b) -> 'b -> 'a queue -> 'b
+ val update : 'a queue * int * 'a -> 'a queue
+ val toList : 'a queue -> 'a list
+ val map : ('a -> 'b) -> 'a queue -> 'b queue
+ val mapi : (int * 'a -> 'b) -> 'a queue -> 'b queue
+ val empty : 'a queue
+ val isEmpty : 'a queue -> bool
+ val append : 'a queue * 'a -> 'a queue
+ val popEnd : 'a queue -> 'a queue * 'a
+
+ (* II. Functions specific to PERSISTENT_QUEUE *)
+
+ val queue : int * 'a -> 'a queue
+ val prepend : 'a queue * 'a -> 'a queue
+ val popStart : 'a queue -> 'a queue * 'a
+
end
M persistent-queue.sml +8 -4
@@ 3,14 3,12 @@ structure PersistentQueue :> PERSISTENT_
structure T = Word32TrieMap
- type 'a array = {
+ type 'a queue = {
start : Word32.word,
size : Word32.word,
trie : 'a T.trie
}
- type 'a queue = 'a array
-
val maxLen = PersistentArray.maxLen
val maxLenW = Word32.fromInt maxLen
@@ 123,7 121,13 @@ structure PersistentQueue :> PERSISTENT_
end
fun toList v =
- rev (foldl (op::) [] v)
+ foldr (op::) [] v
+
+ fun vector v =
+ Vector.fromList (toList v)
+
+ fun queue (n, x) =
+ tabulate (n, fn _ => x)
end
M test.sml +94 -12
@@ 755,12 755,34 @@ structure HashMapTest :> TESTS = struct
end
-signature PERSISTENT_ARRAY_TEST_FN_ARG = sig
- structure A : PERSISTENT_ARRAY
+signature PERSISTENT_COMMON_TEST_FN_ARG = sig
+ structure A : sig
+ type 'a t
+ val maxLen : int
+ val fromList : 'a list -> 'a t
+ val tabulate : int * (int -> 'a) -> 'a t
+ val length : 'a t -> int
+ val sub : 'a t * int -> 'a
+ val app : ('a -> unit) -> 'a t -> unit
+ val appi : (int * 'a -> unit) -> 'a t -> unit
+ val foldl : ('a * 'b -> 'b) -> 'b -> 'a t -> 'b
+ val foldli : (int * 'a * 'b -> 'b) -> 'b -> 'a t -> 'b
+ val foldr : ('a * 'b -> 'b) -> 'b -> 'a t -> 'b
+ val foldri : (int * 'a * 'b -> 'b) -> 'b -> 'a t -> 'b
+ val update : 'a t * int * 'a -> 'a t
+ val toList : 'a t -> 'a list
+ val map : ('a -> 'b) -> 'a t -> 'b t
+ val mapi : (int * 'a -> 'b) -> 'a t -> 'b t
+ val empty : 'a t
+ val isEmpty : 'a t -> bool
+ val append : 'a t * 'a -> 'a t
+ val popEnd : 'a t -> 'a t * 'a
+ end
+
val name : string
end
-functor PersistentArrayTestFn (ARG : PERSISTENT_ARRAY_TEST_FN_ARG) :> TESTS = struct
+functor PersistentCommonTestFn (ARG : PERSISTENT_COMMON_TEST_FN_ARG) :> TESTS = struct
open TestSupport
@@ 873,26 895,86 @@ functor PersistentArrayTestFn (ARG : PER
]
end
-structure PersistentArrayTest = PersistentArrayTestFn(struct
- structure A = PersistentArray
- val name = "persistent-array"
- end)
+structure PersistentArrayTest :> TESTS = struct
+
+ open TestSupport
+
+ val name = "persistent-array"
+
+ structure CommonTestPart = PersistentCommonTestFn
+ (struct
+ structure A = struct
+ open PersistentArray
+ type 'a t = 'a array
+ end
+ val name = name ^ "-common"
+ end)
+
+ structure A = PersistentArray
+ fun tests () =
+ (CommonTestPart.tests ()) @ [
+ ( "find",
+ fn () =>
+ let val a = A.fromList [ "a", "b", "c", "d", "banana" ]
+ in
+ A.find (fn "d" => true | _ => false) a = SOME "d"
+ andalso
+ A.find (fn "q" => true | _ => false) a = NONE
+ end
+ ),
+ ( "findi",
+ fn () =>
+ let val a = A.fromList [ "a", "b", "c", "d", "banana" ]
+ in
+ A.findi (fn (3, "d") => true | _ => false) a = SOME (3, "d")
+ andalso
+ A.findi (fn (_, "d") => true | _ => false) a = SOME (3, "d")
+ andalso
+ A.findi (fn (_, "q") => true | _ => false) a = NONE
+ end
+ ),
+ ( "exists",
+ fn () =>
+ let val a = A.fromList [ "a", "b", "c", "d", "banana" ]
+ in
+ A.exists (fn "d" => true | _ => false) a = true
+ andalso
+ A.exists (fn "q" => true | _ => false) a = false
+ end
+ ),
+ ( "all",
+ fn () =>
+ let val a = A.fromList [ "a", "b", "c", "d", "banana" ]
+ in
+ A.all (fn "d" => true | _ => false) a = false
+ andalso
+ A.all (fn "q" => false | _ => true) a = true
+ end
+ )
+ ]
+
+end
+
structure PersistentQueueTest :> TESTS = struct
open TestSupport
val name = "persistent-queue"
- structure ArrayTestPart = PersistentArrayTestFn(struct
- structure A = PersistentQueue
- val name = name
- end)
+ structure CommonTestPart = PersistentCommonTestFn
+ (struct
+ structure A = struct
+ open PersistentQueue
+ type 'a t = 'a queue
+ end
+ val name = name ^ "-common"
+ end)
structure Q = PersistentQueue
fun tests () =
- (ArrayTestPart.tests ()) @ [
+ (CommonTestPart.tests ()) @ [
( "prepend",
fn () => check_lists id (Q.toList (Q.prepend (Q.empty, "hello")),
[ "hello" ])
M trie-map-fn.sml +62 -0
@@ 309,6 309,68 @@ functor TrieMapFn (A : TRIE_MAP_FN_ARG)
SOME _ => true
| NONE => false
+ fun searchNode f =
+ let fun search' n =
+ case n of
+ LEAF item => if f item
+ then SOME item
+ else NONE
+ | TWIG (kk, item) => if f item
+ then SOME item
+ else NONE
+ | BRANCH (iopt, m) =>
+ if Option.isSome iopt andalso f (Option.valOf iopt)
+ then iopt
+ else M.foldl (fn (n', SOME r) => SOME r
+ | (n', NONE) => search' n')
+ NONE
+ m
+ in
+ search'
+ end
+
+ fun search (f : 'a -> bool) (t : 'a trie) : 'a option =
+ case t of
+ EMPTY => NONE
+ | POPULATED n => searchNode f n
+
+ fun searchiNode f =
+ let fun searchi' (rpfx, n) =
+ case n of
+ LEAF item =>
+ let val k = K.implode (rev rpfx)
+ in
+ if f (k, item)
+ then SOME (k, item)
+ else NONE
+ end
+ | TWIG (kk, item) =>
+ let val k = K.implode (rev rpfx @ K.explode kk)
+ in
+ if f (k, item)
+ then SOME (k, item)
+ else NONE
+ end
+ | BRANCH (iopt, m) =>
+ let val k = K.implode (rev rpfx)
+ in
+ if Option.isSome iopt andalso f (k, Option.valOf iopt)
+ then SOME (k, Option.valOf iopt)
+ else M.foldli (fn (x, n', SOME r) => SOME r
+ | (x, n', NONE) =>
+ searchi' (x::rpfx, n'))
+ NONE
+ m
+ end
+ in
+ searchi'
+ end
+
+ fun searchi (f : key * 'a -> bool) (t : 'a trie) : (key * 'a) option =
+ case t of
+ EMPTY => NONE
+ | POPULATED n => searchiNode f ([], n)
+
fun foldlNode f =
let fun fold' (n, acc) =
case n of
M trie-map-keyadapter-fn.sml +4 -0
@@ 39,6 39,10 @@ functor TrieMapKeyAdapterFn (A : TRIE_MA
fun locate (t, k, order) = Option.map (fn (k, x) => (dekey k, x))
(T.locate (t, enkey k, order))
+ val search = T.search
+ fun searchi f t = Option.map (fn (k, x) => (dekey k, x))
+ (T.searchi (fn (k, x) => f (dekey k, x)) t)
+
fun prefixOf (t, k) =
Option.map dekey (T.prefixOf (t, enkey k))
M trie-map.sig +13 -3
@@ 4,8 4,6 @@
signature TRIE_MAP = sig
- (*!!! how far should this match ORD_MAP? *)
-
type 'a trie
type key
@@ 48,13 46,25 @@ signature TRIE_MAP = sig
respectively less or greater than it is returned, if there is
one *)
val locate : 'a trie * key * order -> (key * 'a) option
-
+
(** Return the longest prefix of the given key that is present as
a key in the trie. The given key does not need to be present
as a key in the trie. If it is present, it will be its own
longest prefix, and so it will be returned. If there is no
prefix of the given key in the trie, return NONE *)
val prefixOf : 'a trie * key -> key option
+
+ (** Examine the values in the trie, in sort order by key, and
+ return the first one for which the given function returns
+ true. This is similar to Vector.find in that it must iterate
+ through the trie rather than performing a direct lookup *)
+ val search : ('a -> bool) -> 'a trie -> 'a option
+
+ (** Examine the key/value pairs in the trie, in sort order by key,
+ and return the first one for which the given function returns
+ true. This is similar to Vector.findi in that it must iterate
+ through the trie rather than performing a direct lookup *)
+ val searchi : (key * 'a -> bool) -> 'a trie -> (key * 'a) option
(** Fold over all the values in the trie, in sort order by key *)
val foldl : ('a * 'b -> 'b) -> 'b -> 'a trie -> 'b