655e71faf6ad — Chris Cannam 5 months ago
Add resolveRange
5 files changed, 144 insertions(+), 5 deletions(-)

M test.sml
M trie-map-fn.sml
M trie-map-keyadapter-fn.sml
M trie-map.sig
M trie.sig
M test.sml +25 -0
@@ 445,6 445,31 @@ functor TrieRangeTestFn (ARG : TRIE_TEST
                                (T.foldrRange (op::) []
                                              (test_trie (), (from, to)),
                                 expected)))
+             testdata) @
+        (map (fn (name, from, to, expected) =>
+                 (name ^ "-resolve",
+                  fn () => let val t = test_trie ()
+                               val leftCheck = T.foldlRange
+                                                   (fn (e, NONE) => SOME e
+                                                     | (_, opt) => opt)
+                                                   NONE (t, (from, to))
+                               val rightCheck = T.foldrRange
+                                                    (fn (e, NONE) => SOME e
+                                                      | (_, opt) => opt)
+                                                    NONE (t, (from, to))
+                               val resolved = T.resolveRange (t, (from, to))
+                           in
+                               case (leftCheck, rightCheck, resolved) of
+                                   (NONE, NONE, NONE) => true
+                                 | (SOME l, SOME r, SOME (l', r')) =>
+                                   check_pairs id [(l', l), (r', r)]
+                                 | (NONE, NONE, SOME (l', r')) =>
+                                   (report id (l' ^ "," ^ r', "<none>"); false)
+                                 | (SOME l, SOME r, NONE) =>
+                                   (report id ("<none>", l ^ "," ^ r); false)
+                                 | _ =>
+                                   raise Fail "inconsistency from foldli/foldriRange!"
+                           end))
              testdata)
 end
 

          
M trie-map-fn.sml +97 -5
@@ 605,10 605,10 @@ functor TrieMapFn (A : TRIE_MAP_FN_ARG)
               | branchr ((iopt, m), lc, rc) =
                 let val acc =
                         M.foldri
-                            (fn (x, n, acc) =>
+                            (fn (x, nsub, acc) =>
                                 if not (acceptMapElement (x, lc, rc)) then acc
                                 else foldiRangeNode true
-                                                    f (x :: rpfx, n,
+                                                    f (x :: rpfx, nsub,
                                                        subConstraint (x, lc),
                                                        subConstraint (x, rc),
                                                        acc))

          
@@ 686,10 686,10 @@ functor TrieMapFn (A : TRIE_MAP_FN_ARG)
               | branchr ((iopt, m), lc, rc) =
                 let val acc =
                         M.foldri
-                            (fn (x, n, acc) =>
+                            (fn (x, nsub, acc) =>
                                 if not (acceptMapElement (x, lc, rc)) then acc
                                 else foldRangeNode true
-                                                   f (n,
+                                                   f (nsub,
                                                       subConstraint (x, lc),
                                                       subConstraint (x, rc),
                                                       acc))

          
@@ 727,6 727,85 @@ functor TrieMapFn (A : TRIE_MAP_FN_ARG)
                    | BRANCH (iopt, m) => branch ((iopt, m), lc, rc))
         end
 
+    fun resolveRangeNode right (rpfx, n, leftConstraintK, rightConstraintK) =
+        let fun leaf (item, [], _) = SOME (K.implode (rev rpfx))
+              | leaf _ = NONE
+                             
+            fun twig ((kk, item), lc, rc) =
+                let val kk' = K.explode kk
+                in
+                    if acceptTwig (kk', lc, rc)
+                    then SOME (K.implode ((rev rpfx) @ kk'))
+                    else NONE
+                end
+
+            fun branchl ((SOME item, m), [], rc) =
+                SOME (K.implode (rev rpfx))
+              | branchl ((iopt, m), [], []) =
+                foldliNode (fn (k, _, NONE) => SOME k
+                             | (_, _, acc) => acc)
+                           (rpfx, n, NONE)
+              | branchl ((iopt, m), lc, rc) =
+                M.foldli
+                    (fn (x, nsub, SOME k) => SOME k
+                      | (x, nsub, NONE) =>
+                        if not (acceptMapElement (x, lc, rc)) then NONE
+                        else resolveRangeNode false
+                                              (x :: rpfx, nsub,
+                                               subConstraint (x, lc),
+                                               subConstraint (x, rc)))
+                    NONE m
+                                                    
+            fun branchr ((iopt, m), [], []) =
+                foldriNode (fn (k, _, NONE) => SOME k
+                             | (_, _, acc) => acc)
+                           (rpfx, n, NONE)
+              | branchr ((iopt, m), lc, rc) =
+                let val acc =
+                        M.foldri
+                            (fn (x, nsub, SOME k) => SOME k
+                              | (x, nsub, NONE) =>
+                                if not (acceptMapElement (x, lc, rc)) then NONE
+                                else resolveRangeNode true
+                                                      (x :: rpfx, nsub,
+                                                       subConstraint (x, lc),
+                                                       subConstraint (x, rc)))
+                            NONE m
+                in
+                    case acc of
+                        SOME k => SOME k
+                      | NONE => 
+                        case iopt of
+                            NONE => NONE
+                          | SOME item => case lc of
+                                             [] => SOME (K.implode (rev rpfx))
+                                           | _ => NONE
+                end
+
+            val branch = if right then branchr else branchl
+                    
+            val leftConstraint = Option.map K.explode leftConstraintK
+            val rightConstraint = Option.map K.explode rightConstraintK
+
+            val lc = Option.getOpt (leftConstraint, [])
+            val rc = Option.getOpt (rightConstraint, [])
+        in
+            case rightConstraint of
+                SOME [] =>
+                (if null lc
+                 then case n of
+                          LEAF item => leaf (item, lc, NONE)
+                        | TWIG _ => NONE
+                        | BRANCH (NONE, _) => NONE
+                        | BRANCH (SOME item, _) => SOME (K.implode (rev rpfx))
+                 else NONE)
+              | _ =>
+                (case n of
+                     LEAF item => leaf (item, lc, rc)
+                   | TWIG (kk, item) => twig ((kk, item), lc, rc)
+                   | BRANCH (iopt, m) => branch ((iopt, m), lc, rc))
+        end
+
     fun extractRangeNode (n, leftConstraintK, rightConstraintK) =
         let (* quite some duplication with foldiRangeNode here *)
             fun leaf (item, [], _) = POPULATED (LEAF item)

          
@@ 817,7 896,20 @@ functor TrieMapFn (A : TRIE_MAP_FN_ARG)
             EMPTY => acc
           | POPULATED n =>
             foldRangeNode true f (n, leftConstraint, rightConstraint, acc)
-            
+
+    fun resolveRange (trie, (leftConstraint, rightConstraint)) =
+        case trie of
+            EMPTY => NONE
+          | POPULATED n =>
+            case (resolveRangeNode false
+                                   ([], n, leftConstraint, rightConstraint),
+                  resolveRangeNode true
+                                   ([], n, leftConstraint, rightConstraint)) of
+                (NONE, NONE) => NONE
+              | (SOME left, SOME right) => SOME (left, right)
+              | _ => 
+                raise Fail "internal error: resolveRange obtained NONE from one end but SOME from the other"
+                          
     fun extractRange (trie, (leftConstraint, rightConstraint)) =
         case trie of
             EMPTY => EMPTY

          
M trie-map-keyadapter-fn.sml +6 -0
@@ 96,6 96,12 @@ functor TrieMapKeyAdapterFn (A : TRIE_MA
                            (Option.map enkey leftConstraint,
                             Option.map enkey rightConstraint))
 
+    fun resolveRange (t, (leftConstraint, rightConstraint)) =
+        Option.map (fn (l, r) => (dekey l, dekey r))
+                   (T.resolveRange (t,
+                                    (Option.map enkey leftConstraint,
+                                     Option.map enkey rightConstraint)))
+                      
     fun extractRange (t, (leftConstraint, rightConstraint)) =
         T.extractRange (t, (Option.map enkey leftConstraint,
                             Option.map enkey rightConstraint))

          
M trie-map.sig +8 -0
@@ 128,6 128,14 @@ signature TRIE_MAP = sig
         within the given key range, in reverse of sort order by key *)
     val foldriRange : (key * 'a * 'b -> 'b) -> 'b -> ('a trie * range) -> 'b
 
+    (** Return the keys at either end of the given range. That is,
+        return keys k1 and k2, present in the trie, for which the
+        range (SOME k1, SOME k2) is equivalent to the given range
+        within the given trie. If the given range is empty within the
+        given trie, return NONE. This is equivalent to checking the
+        first keys of foldli/foldriRange, but typically faster. *)
+    val resolveRange : 'a trie * range -> (key * key) option
+                                                                              
     (** Return a trie containing all key-value pairs in the trie that
         are found within the given key range, sharing the structure of
         the given trie as far as possible *)

          
M trie.sig +8 -0
@@ 84,6 84,14 @@ signature TRIE = sig
         the given range, in reverse of sort order *)
     val foldrRange : (entry * 'a -> 'a) -> 'a -> (trie * range) -> 'a
 
+    (** Return the entries at either end of the given range. That is,
+        return entries e1 and e2, present in the trie, for which the
+        range (SOME e1, SOME e2) is equivalent to the given range
+        within the given trie. If the given range is empty within the
+        given trie, return NONE. This is equivalent to checking the
+        first entries of foldl/foldrRange, but typically faster. *)
+    val resolveRange : trie * range -> (entry * entry) option
+
     (** Return a trie containing all entries in the trie that are
         found within the given range, sharing the structure of the
         given trie as far as possible *)