b55830b5db1a — Chris Cannam 2 months ago
M atrie-node-map-fn.sml +15 -0
@@ 34,6 34,21 @@ functor ATrieNodeMapFn (E : ATRIE_ELEMEN
else Vector.sub (vec, i - base)
end

+    fun map f (MAP { base, nonempty, vec }) =
+        MAP { base = base,
+              nonempty = nonempty,
+              vec = Vector.map (fn a => Option.map f a) vec
+            }
+    fun mapi f (MAP { base, nonempty, vec }) =
+        MAP { base = base,
+              nonempty = nonempty,
+              vec = Vector.mapi
+                        (fn (i, NONE) => NONE
+                          | (i, SOME x) => SOME (f (E.invOrd (i + base), x)))
+                        vec
+            }
fun foldl f acc (MAP { vec, ... }) =
Vector.foldl (fn (NONE, acc) => acc
| (SOME x, acc) => f (x, acc))

M bitmapped-vector.sml +14 -0
@@ 281,6 281,20 @@ functor BitMappedVectorFn (V : BIT_VECTO
fun remove (vec, i) =
alter (vec, i, fn _ => NONE)

+    fun mapi (f : int * 'a -> 'b) ((b, v) : 'a vector) : 'b vector =
+        (b,
+         let val i = ref (~1)
+                 (i := ! i + 1;
+                  if V.sub (b, ! i) then ()
+         in
+             Vector.mapi (fn (ix, x) => (advance (); f (! i, x))) v
+         end)
+    fun map (f : 'a -> 'b) ((b, v) : 'a vector) : 'b vector =
+        (b, Vector.map f v)
fun foldli (f : (int * 'a * 'b -> 'b))
(acc : 'b) ((b, v) : 'a vector) : 'b =
case V.foldli

M btrie-node-map-fn.sml +4 -2
@@ 21,9 21,11 @@ functor BTrieNodeMapFn (E : BTRIE_ELEMEN
fun new () = V.new E.maxOrd
val isEmpty = V.isEmpty
fun find (v, k) = V.find (v, E.ord k)
-    fun foldl f = V.foldl (fn (x, acc) => f (x, acc))
+    fun map f = V.map f
+    fun mapi f = V.mapi (fn (i, x) => f (E.invOrd i, x))
+    fun foldl f = V.foldl f
fun foldli f = V.foldli (fn (i, x, acc) => f (E.invOrd i, x, acc))
-    fun foldr f = V.foldr (fn (x, acc) => f (x, acc))
+    fun foldr f = V.foldr f
fun foldri f = V.foldri (fn (i, x, acc) => f (E.invOrd i, x, acc))
fun alter (v, k, f) = V.alter (v, E.ord k, f)
fun remove (v, k) = V.remove (v, E.ord k)

M persistent-array.sml +2 -2
@@ 103,8 103,8 @@ structure PersistentArrayImpl = struct
fun mapi f v =
foldli (fn (i, x, acc) => append (acc, f (i, x))) empty v

-    fun map f v =
-        foldl (fn (x, acc) => append (acc, f x)) empty v
+    fun map f (A { size, trie }) =
+        A { size = size, trie = T.map f trie }

fun appi f v =
foldli (fn (i, x, _) => ignore (f (i, x))) () v

M persistent-queue.sml +2 -2
@@ 109,8 109,8 @@ structure PersistentQueue :> PERSISTENT_
fun mapi f v =
foldli (fn (i, x, acc) => append (acc, f (i, x))) empty v

-    fun map f v =
-        foldl (fn (x, acc) => append (acc, f x)) empty v
+    fun map f ({ start, size, trie }) =
+        { start = start, size = size, trie = T.map f trie }

fun appi f v =
foldli (fn (i, x, _) => ignore (f (i, x))) () v

M trie-map-fn.sml +35 -1
@@ 11,6 11,8 @@ signature TRIE_NODE_MAP = sig
val new : unit -> 'a map
val isEmpty : 'a map -> bool
val find : 'a map * key -> 'a option
+    val map : ('a -> 'b) -> 'a map -> 'b map
+    val mapi : (key * 'a -> 'b) -> 'a map -> 'b map
val foldl : ('a * 'b -> 'b) -> 'b -> 'a map -> 'b
val foldli : (key * 'a * 'b -> 'b) -> 'b -> 'a map -> 'b
val foldr : ('a * 'b -> 'b) -> 'b -> 'a map -> 'b

@@ 370,7 372,39 @@ functor TrieMapFn (A : TRIE_MAP_FN_ARG)
case t of
EMPTY => NONE
| POPULATED n => searchiNode f ([], n)
+    fun mapiNode f =
+        let fun f' (rpfx, item) = f (K.implode (rev rpfx), item)
+            fun mapi' (rpfx, n) =
+                case n of
+                    LEAF item =>
+                    LEAF (f' (rpfx, item))
+                  | TWIG (kk, item) =>
+                    TWIG (kk, f' (rpfx, item))
+                  | BRANCH (iopt, m) =>
+                    BRANCH (Option.map (fn item => f' (rpfx, item)) iopt,
+                            M.mapi (fn (x, n) => mapi' (x::rpfx, n)) m)
+        in
+            mapi'
+        end
+    fun mapi (f : key * 'a -> 'b) (t : 'a trie) : 'b trie =
+        case t of
+            EMPTY => EMPTY
+          | POPULATED n =>
+            POPULATED (mapiNode f ([], n))
+    fun mapNode f n =
+        case n of
+            LEAF item => LEAF (f item)
+          | TWIG (kk, item) => TWIG (kk, f item)
+          | BRANCH (iopt, m) => BRANCH (Option.map f iopt, M.map (mapNode f) m)
+    fun map (f : 'a -> 'b) (t : 'a trie) : 'b trie =
+        case t of
+            EMPTY => EMPTY
+          | POPULATED n => POPULATED (mapNode f n)
fun foldlNode f =
let fun fold' (n, acc) =
case n of

@@ 45,7 45,12 @@ functor TrieMapKeyAdapterFn (A : TRIE_MA

fun prefixOf (t, k) =
Option.map dekey (T.prefixOf (t, enkey k))
+    val map = T.map
+    fun mapi f =
+        T.mapi (fn (k, x) => f (dekey k, x))
val foldl = T.foldl
val foldr = T.foldr

@@ 56,7 61,7 @@ functor TrieMapKeyAdapterFn (A : TRIE_MA
T.foldri (fn (k, x, acc) => f (dekey k, x, acc))

fun enumerate t =
-        map (fn (k, x) => (dekey k, x)) (T.enumerate t)
+        List.map (fn (k, x) => (dekey k, x)) (T.enumerate t)

fun foldliPrefix f acc (t, k) =
T.foldliPrefix (fn (k, x, acc) => f (dekey k, x, acc))

@@ 70,7 75,7 @@ functor TrieMapKeyAdapterFn (A : TRIE_MA
T.extractPrefix (t, enkey k)

fun enumeratePrefix (t, k) =
-        map (fn (k, x) => (dekey k, x)) (T.enumeratePrefix (t, enkey k))
+        List.map (fn (k, x) => (dekey k, x)) (T.enumeratePrefix (t, enkey k))

type range = key option * key option

@@ 107,10 112,10 @@ functor TrieMapKeyAdapterFn (A : TRIE_MA
Option.map enkey rightConstraint))

fun enumerateRange (t, (leftConstraint, rightConstraint)) =
-        map (fn (k, x) => (dekey k, x))
-            (T.enumerateRange (t,
-                               (Option.map enkey leftConstraint,
-                                Option.map enkey rightConstraint)))
+        List.map (fn (k, x) => (dekey k, x))
+                 (T.enumerateRange (t,
+                                    (Option.map enkey leftConstraint,
+                                     Option.map enkey rightConstraint)))
end

@@ 152,6 157,6 @@ functor PatternMatchTrieMapKeyAdapterFn
A.T.foldriPattern (fn (k, x, acc) => f (A.dekey k, x, acc))

fun enumeratePattern (t, p) =
-        map (fn (k, x) => (A.dekey k, x)) (A.T.enumeratePattern (t, p))
+        List.map (fn (k, x) => (A.dekey k, x)) (A.T.enumeratePattern (t, p))

end

M trie-map.sig +15 -7
@@ 67,22 67,30 @@ signature TRIE_MAP = sig
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
+    (** Map all the values in the trie to new values using the given
+        map function, supplied with key and value for each. *)
+    val mapi : (key * 'a -> 'b) -> 'a trie -> 'b trie
+    (** Map all the values in the trie to new values using the given
+        map function, supplied with value only. *)
+    val map : ('a -> 'b) -> 'a trie -> 'b trie

(** Fold over all the key-value pairs in the trie, in sort order
by key *)
val foldli : (key * 'a * 'b -> 'b) -> 'b -> 'a trie -> 'b

-    (** Fold over all the values in the trie, in reverse of sort order
-        by key *)
-    val foldr : ('a * 'b -> 'b) -> 'b -> 'a trie -> 'b
+    (** Fold over all the values in the trie, in sort order by key *)
+    val foldl : ('a * 'b -> 'b) -> 'b -> 'a trie -> 'b

(** Fold over all the key-value pairs in the trie, in reverse of
sort order by key *)
val foldri : (key * 'a * 'b -> 'b) -> 'b -> 'a trie -> 'b
+    (** Fold over all the values in the trie, in reverse of sort order
+        by key *)
+    val foldr : ('a * 'b -> 'b) -> 'b -> 'a trie -> 'b
(** Return a list of all key-value pairs in the trie, in sort order
by key *)
val enumerate : 'a trie -> (key * 'a) list