# HG changeset patch # User Chris Cannam # Date 1638875227 0 # Tue Dec 07 11:07:07 2021 +0000 # Node ID 655e71faf6ad2c46aa6369dead78f3dad3a00569 # Parent 30011aa6dc426c17011c0261bb665b4ac5fbcf9f Add resolveRange diff --git a/test.sml b/test.sml --- a/test.sml +++ b/test.sml @@ -445,6 +445,31 @@ (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', ""); false) + | (SOME l, SOME r, NONE) => + (report id ("", l ^ "," ^ r); false) + | _ => + raise Fail "inconsistency from foldli/foldriRange!" + end)) testdata) end diff --git a/trie-map-fn.sml b/trie-map-fn.sml --- a/trie-map-fn.sml +++ b/trie-map-fn.sml @@ -605,10 +605,10 @@ | 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 @@ | 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 @@ | 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 @@ 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 diff --git a/trie-map-keyadapter-fn.sml b/trie-map-keyadapter-fn.sml --- a/trie-map-keyadapter-fn.sml +++ b/trie-map-keyadapter-fn.sml @@ -96,6 +96,12 @@ (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)) diff --git a/trie-map.sig b/trie-map.sig --- a/trie-map.sig +++ b/trie-map.sig @@ -128,6 +128,14 @@ 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 *) diff --git a/trie.sig b/trie.sig --- a/trie.sig +++ b/trie.sig @@ -84,6 +84,14 @@ 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 *)