@@ 24,7 24,7 @@ signature PERSISTENT_ARRAY = sig
     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
+    (* II. Functions similar to ARRAY, but altered for a persistent
            array. The functions passed to modify/modifyi should return
            NONE for "no change" or SOME x to change the value. *)
 

          

@@ 121,6 121,49 @@ functor TrieTestFn (ARG : TRIE_TEST_FN_A
                        T.isEmpty e1 andalso T.isEmpty e2
                    end
         ),
+        ( "extractPrefix-empty",
+          fn () => check_lists id (T.enumerate
+                                       (T.extractPrefix (T.empty, "parp")), [])
+        ),
+        ( "extractPrefix-matches",
+          fn () => check_lists id (T.enumerate
+                                       (T.extractPrefix (test_trie (), "pa")),
+			           [ "par", "parp" ])
+	           andalso
+	           check_lists id (T.enumerate
+                                       (T.extractPrefix (test_trie (), "par")),
+			           [ "par", "parp" ])
+	           andalso
+	           check_lists id (T.enumerate
+                                       (T.extractPrefix (test_trie (), "alligat")),
+			           [ "alligator" ])
+        ),
+        ( "extractPrefix-no-matches",
+          fn () => check_lists id (T.enumerate
+                                       (T.extractPrefix (test_trie (), "quiz")),
+                                   [ ])
+                   andalso
+                   check_lists id (T.enumerate
+                                       (T.extractPrefix (test_trie (), "aaa")),
+                                   [ ])
+                   andalso
+                   check_lists id (T.enumerate
+                                       (T.extractPrefix (test_trie (), "zzz")),
+                                   [ ])
+                   andalso
+                   check_lists id (T.enumerate
+                                       (T.extractPrefix (test_trie (), "parpy")),
+                                   [ ])
+                   andalso
+                   check_lists id (T.enumerate
+                                       (T.extractPrefix (test_trie (), "alligators")),
+                                   [ ])
+        ),
+        ( "extractPrefix-all-matches",
+          fn () => check_lists id (T.enumerate
+                                       (T.extractPrefix (test_trie (), "")),
+                                   sorted strings)
+        ),
         ( "enumeratePrefix-empty",
           fn () => check_lists id (T.enumeratePrefix (T.empty, "parp"), [])
         ),

          

@@ 495,6 495,34 @@ functor TrieMapFn (A : TRIE_MAP_FN_ARG)
     fun enumeratePrefix (trie, e) =
         foldriPrefix (fn (k, v, acc) => (k, v) :: acc) [] (trie, e)
 
+    fun extractPrefixNode (xx, n) =
+        if K.isEmpty xx
+        then SOME n
+        else
+            case n of
+                LEAF item => NONE
+              | TWIG (kk, item) =>
+                (if isPrefixOf (K.explode xx, K.explode kk)
+                 then SOME n
+                 else NONE)
+              | BRANCH (_, m) =>
+                case M.find (m, K.head xx) of
+                    NONE => NONE
+                  | SOME nsub =>
+                    case extractPrefixNode (K.tail xx, nsub) of
+                        NONE => NONE
+                      | SOME nsub' => 
+                        SOME (BRANCH (NONE, M.modify (M.new (), K.head xx,
+                                                      fn _ => SOME nsub')))
+
+    fun extractPrefix (trie, e) =
+        case trie of
+            EMPTY => EMPTY
+          | POPULATED n =>
+            case extractPrefixNode (e, n) of
+                NONE => EMPTY
+              | SOME n => POPULATED n
+
     fun foldiNodeRange right f (rpfx, n, leftConstraintK, rightConstraintK, acc) =
         let fun f' (pfx, item, acc) =
                 f (K.implode pfx, item, acc)

          

@@ 66,6 66,9 @@ functor TrieMapKeyAdapterFn (A : TRIE_MA
         T.foldriPrefix (fn (k, x, acc) => f (dekey k, x, acc))
                        acc (t, enkey k)
 
+    fun extractPrefix (t, k) =
+        T.extractPrefix (t, enkey k)
+                       
     fun enumeratePrefix (t, k) =
         map (fn (k, x) => (dekey k, x)) (T.enumeratePrefix (t, enkey k))
 

          

@@ 95,6 95,12 @@ signature TRIE_MAP = sig
         itself does not need to be present as a key in the trie *)
     val foldriPrefix : (key * 'a * 'b -> 'b) -> 'b -> ('a trie * key) -> 'b
 
+    (** Return a trie containing all key-value pairs in the trie that
+        have the given key as a prefix, sharing the structure of the
+        given trie as far as possible. The prefix itself does not need
+        to be present as a key in the trie *)
+    val extractPrefix : 'a trie * key -> 'a trie
+
     (** Return a list of all key-value pairs in the trie that have the
         given key as a prefix, in sort order by key. The prefix itself
         does not need to be present as a key in the trie *)

          

@@ 61,6 61,12 @@ signature TRIE = sig
         need to be present as an entry in the trie *)
     val foldrPrefix : (entry * 'a -> 'a) -> 'a -> (trie * entry) -> 'a 
 
+    (** Return a trie containing all entries in the trie that have the
+        given entry as a prefix, sharing the structure of the given
+        trie as far as possible. The prefix itself does not need to be
+        present as an entry in the trie *)
+    val extractPrefix : trie * entry -> trie
+
     (** Return a list of all entries in the trie that have the given
         entry as a prefix, in sort order. The prefix itself does not
         need to be present as an entry in the trie *)