tree: new tree-begin-at function.

* tree.c (enum tree_iter_state): New iterator state
tr_find_low_prepared dedicated to the tree-begin-at traversal.
This state indicates that tree-next should visit the starting
node that it is given, and then after that, treat anything to
the left of it as having been visited. In the other states,
tree-next does not visit the node it is given but uses it as
the starting point to find the next node.
(tn_find_next): Bugfix here: when navigating the right link,
the function neglected to add the node to the path.  But the
logic for backtracking up the path expects this: it checks
whether the node from the path is the parent of a right child.
Somehow this didn't cause a problem for full traversals with
tree-begin; at least the existing test cases don't expose an
issue.  It caused a problem for tree-begin-at, though.
(tn_find_low): New static function. This finds the low-key
node in the tree, priming the iterator object with the correct
state and path content to continue the traversal from that
node on . We need the tr_find_low_prepared state in the
iterator in order to visit the low node itself that was found.
(tree_begin_at): New function.
(tree_init): Register tree-begin-at intrinsic.

* tree.h (tree_begin_at): Declared.

* tests/010/tree.tl: New test cases for tree-begin-at.

* txr.1: Documented.

* share/txr/stdlib/doc-syms.tl: Updated.

5 files changed, 112 insertions, 8 deletions

diff --git a/share/txr/stdlib/doc-syms.tl b/share/txr/stdlib/doc-syms.tl
index 94455d7f..7527b96d 100644
--- a/share/txr/stdlib/doc-syms.tl
+++ b/share/txr/stdlib/doc-syms.tl
@@ -1078,6 +1078,7 @@
      ("del" "D-0040")
      ("cos" "D-0041")
      ("yield-from" "N-01556613")
+     ("tree-begin-at" "N-00A02578")
      ("dlvsym-checked" "N-029063A0")
      ("txr-when" "N-02311DCA")
      ("sock-accept" "N-00AF0FE8")
@@ -1398,7 +1399,7 @@
      ("itimer-virtual" "N-02B7882A")
      ("sig-stop" "N-0176430F")
      ("lazy-str-force" "N-03269DEF")
-     ("tree-begin" "N-02887FCA")
+     ("tree-begin" "N-00A02578")
      ("dt-chr" "N-02D8CAF4")
      ("buf-alloc-size" "N-013A3727")
      ("find-frames" "N-02B97226")
@@ -1509,9 +1510,9 @@
      ("veol2" "N-01812D70")
      ("f-dupfd-cloexec" "N-025E55E7")
      ("path-sock-p" "N-00198FC7")
+     ("format" "N-011ACA52")
      ("neq" "N-0216A942")
      ("ldo" "N-03EF3A27")
-     ("format" "N-011ACA52")
      ("etimedout" "N-036B1BDB")
      ("random-state-get-vec" "N-005C0F98")
      ("hash_keys" "N-01BD56A5")
diff --git a/tests/010/tree.tl b/tests/010/tree.tl
index df454e75..a71308c3 100644
--- a/tests/010/tree.tl
+++ b/tests/010/tree.tl
@@ -48,6 +48,34 @@
 
 (test trc #T(()))
 
+(test (tree-delete tr 6) 6)
+
+(vtest (build (for* ((i (tree-begin-at tr 6))
+                     (n (tree-next i)))
+                    (n)
+                    ((set n (tree-next i)))
+                (add (key n))))
+       (range 7 19))
+
+(vtest (build (for* ((i (tree-begin-at tr 0))
+                     (n (tree-next i)))
+                    (n)
+                    ((set n (tree-next i)))
+                (add (key n))))
+       (append (range 0 5) (range 7 19)))
+
+(vtest (build (for* ((i (tree-begin-at tr 8))
+                     (n (tree-next i)))
+                    (n)
+                    ((set n (tree-next i)))
+                (add (key n))))
+       (range 8 19))
+
+(test (tree-next (tree-begin-at tr 20)) nil)
+
+(test (tree-next (tree-begin-at #T(()) 0)) nil)
+(test (key (tree-next (tree-begin-at #T(() 1) 1))) 1)
+
 (mtest
   (tree-delete tr 0) 0
   (tree-delete tr 1) 1
@@ -55,7 +83,6 @@
   (tree-delete tr 3) 3
   (tree-delete tr 4) 4
   (tree-delete tr 5) 5
-  (tree-delete tr 6) 6
   (tree-delete tr 7) 7
   (tree-delete tr 8) 8
   (tree-delete tr 9) 9
diff --git a/tree.c b/tree.c
index 4d378ced..acbcb169 100644
--- a/tree.c
+++ b/tree.c
@@ -25,7 +25,6 @@
  * OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
  */
 
-
 #include <stddef.h>
 #include <stdio.h>
 #include <stdarg.h>
@@ -60,7 +59,8 @@ struct tree {
 
 enum tree_iter_state {
   tr_visited_nothing,
-  tr_visited_left
+  tr_visited_left,
+  tr_find_low_prepared
 };
 
 struct tree_iter {
@@ -191,6 +191,7 @@ static val tn_find_next(val node, struct tree_iter *trit)
     case tr_visited_left:
       if (node->tn.right) {
         trit->state = tr_visited_nothing;
+        set(mkloc(trit->path[trit->depth++], trit->self), node);
         node = node->tn.right;
         continue;
       } else {
@@ -205,12 +206,60 @@ static val tn_find_next(val node, struct tree_iter *trit)
         }
         return nil;
       }
+    case tr_find_low_prepared:
+      trit->state = tr_visited_left;
+      return node;
     default:
       internal_error("invalid tree iterator state");
     }
   }
 }
 
+static void tn_find_low(val node, struct tree_diter *tdi,
+                        struct tree *tr, val key)
+{
+  struct tree_iter *trit = &tdi->ti;
+
+  if (node == 0) {
+    return;
+  } else {
+    val tr_key = if3(tr->key_fn,
+                     funcall1(tr->key_fn, node->tn.key),
+                     node->tn.key);
+
+    set(mkloc(trit->path[trit->depth++], trit->self), node);
+
+    if (if3(tr->less_fn,
+            funcall2(tr->less_fn, key, tr_key),
+            less(key, tr_key)))
+    {
+      set(mkloc(tdi->lastnode, tdi->ti.self), node);
+      if (node->tn.left) {
+        tn_find_low(node->tn.left, tdi, tr, key);
+        return;
+      }
+    } else if (if3(tr->equal_fn == nil,
+                   equal(key, tr_key),
+                   funcall2(tr->equal_fn, key, tr_key))) {
+      set(mkloc(tdi->lastnode, tdi->ti.self), node);
+      if (node->tn.left) {
+        tn_find_low(node->tn.left, tdi, tr, key);
+        return;
+      }
+    } else {
+      if (node->tn.right) {
+        tn_find_low(node->tn.right, tdi, tr, key);
+        return;
+      }
+    }
+
+    while (trit->path[trit->depth - 1] != tdi->lastnode)
+      trit->depth--;
+    trit->depth--;
+    trit->state = tr_find_low_prepared;
+  }
+}
+
 static val tn_flatten(val x, val y)
 {
   if (x == nil)
@@ -700,6 +749,22 @@ val tree_begin(val tree)
   return iter;
 }
 
+val tree_begin_at(val tree, val lowkey)
+{
+  val self = lit("tree-begin-at");
+  struct tree *tr = coerce(struct tree *, cobj_handle(self, tree, tree_s));
+  struct tree_diter *tdi = coerce(struct tree_diter *,
+                                  chk_calloc(1, sizeof *tdi));
+  val iter = cobj(coerce(mem_t *, tdi), tree_iter_s, &tree_iter_ops);
+
+  tdi->ti.self = iter;
+  tdi->tr = tr;
+
+  tn_find_low(tr->root, tdi, tr, lowkey);
+
+  return iter;
+}
+
 val tree_next(val iter)
 {
   val self = lit("tree-next");
@@ -750,6 +815,7 @@ void tree_init(void)
   reg_fun(intern(lit("tree-delete"), user_package), func_n2(tree_delete));
   reg_fun(intern(lit("tree-root"), user_package), func_n1(tree_root));
   reg_fun(intern(lit("tree-begin"), user_package), func_n1(tree_begin));
+  reg_fun(intern(lit("tree-begin-at"), user_package), func_n2(tree_begin_at));
   reg_fun(intern(lit("tree-next"), user_package), func_n1(tree_next));
   reg_fun(intern(lit("tree-clear"), user_package), func_n1(tree_clear));
   reg_var(tree_fun_whitelist_s, list(identity_s, equal_s, less_s, nao));
diff --git a/tree.h b/tree.h
index 6d35868a..a0d12692 100644
--- a/tree.h
+++ b/tree.h
@@ -43,6 +43,7 @@ val copy_search_tree(val tree);
 val treep(val obj);
 val tree_insert_node(val tree, val node);
 val tree_begin(val tree);
+val tree_begin_at(val tree, val lowkey);
 val tree_next(val iter);
 val tree_clear(val tree);
 void tree_init(void);
diff --git a/txr.1 b/txr.1
index 63cf06a6..1cc8bdc5 100644
--- a/txr.1
+++ b/txr.1
@@ -51542,23 +51542,32 @@ and contains the same elements.
 The nodes held inside the new tree are freshly allocated,
 but their key objects are shared with the original tree.
 
-.coNP Function @ tree-begin
+.coNP Functions @ tree-begin and @ tree-begin-at
 .synb
 .mets (tree-begin < tree )
+.mets (tree-begin-at < tree << low-key )
 .syne
 .desc
 The
 .code tree-begin
 function returns a new object of type
 .code tree-iter
-which provides in-order traversal of the elements stored in the tree.
+which provides in-order traversal of all the nodes stored in the tree.
+
+The
+.code tree-begin-at
+similarly returns a new object of type
+.codn tree-iter .
+This object provides in-order traversal of those nodes stored in the tree
+whose key is equal to or higher than
+.metn low-key .
 
 The
 .meta tree
 argument must be an object of type
 .codn tree .
 
-Note: the elements are traversed by applying the
+The nodes are traversed by applying the
 .code tree-next
 function to the
 .code tree-iter