From bdc7277d09377f87319e0c27de40210b0212fabc Mon Sep 17 00:00:00 2001
From: Kaz Kylheku <kaz@kylheku.com>
Date: Wed, 16 Oct 2019 07:36:27 -0700
Subject: tree: copy-search-tree function.

* lib.c (copy): Handle tree objects via copy_search_tree.

* tree.c (deep_copy_tnode): New static function.
(copy_search_tree): New function.
(tree_init): copy-search-tree intrinsic registered.

* tree.h (copy_search_tree): Declared.

* txr.1: Documented copy-search-tree, and copy function's use
thereof.
---
 lib.c  |  2 ++
 tree.c | 22 ++++++++++++++++++++++
 tree.h |  1 +
 txr.1  | 24 ++++++++++++++++++++++++
 4 files changed, 49 insertions(+)

diff --git a/lib.c b/lib.c
index 81f3d06d..b6f22971 100644
--- a/lib.c
+++ b/lib.c
@@ -10081,6 +10081,8 @@ val copy(val seq)
       return make_random_state(seq, nil);
     if (seq->co.cls == carray_s)
       return copy_carray(seq);
+    if (seq->co.cls == tree_s)
+      return copy_search_tree(seq);
     if (obj_struct_p(seq))
       return copy_struct(seq);
     /* fallthrough */
diff --git a/tree.c b/tree.c
index 70e43158..11cc612e 100644
--- a/tree.c
+++ b/tree.c
@@ -637,6 +637,27 @@ static val tree_construct(val opts, val keys)
   return tree(keys, key_fn, less_fn, equal_fn);
 }
 
+static val deep_copy_tnode(val node)
+{
+  if (node == nil)
+    return nil;
+  return tnode(node->tn.key,
+               deep_copy_tnode(node->tn.left),
+               deep_copy_tnode(node->tn.right));
+}
+
+val copy_search_tree(val tree)
+{
+  val self = lit("copy-search-tree");
+  struct tree *ntr = coerce(struct tree *, malloc(sizeof *ntr));
+  struct tree *otr = coerce(struct tree *, cobj_handle(self, tree, tree_s));
+  val nroot = deep_copy_tnode(otr->root);
+  val ntree = cobj(coerce(mem_t *, ntr), tree_s, &tree_ops);
+  *ntr = *otr;
+  ntr->root = nroot;
+  return ntree;
+}
+
 val treep(val obj)
 {
   return tnil(type(obj) == COBJ && obj->co.cls == tree_s);
@@ -711,6 +732,7 @@ void tree_init(void)
   reg_fun(intern(lit("copy-tnode"), user_package), func_n1(copy_tnode));
   reg_fun(tree_s, func_n4o(tree, 0));
   reg_fun(tree_construct_s, func_n2(tree_construct));
+  reg_fun(intern(lit("copy-search-tree"), user_package), func_n1(copy_search_tree));
   reg_fun(intern(lit("treep"), user_package), func_n1(treep));
   reg_fun(intern(lit("tree-insert-node"), user_package), func_n2(tree_insert_node));
   reg_fun(intern(lit("tree-insert"), user_package), func_n2(tree_insert));
diff --git a/tree.h b/tree.h
index 528bae7b..7c7833bf 100644
--- a/tree.h
+++ b/tree.h
@@ -39,6 +39,7 @@ val set_right(val node, val nright);
 val set_key(val node, val nkey);
 val copy_tnode(val node);
 val tree(val keys, val key_fn, val less_fn, val equal_fn);
+val copy_search_tree(val tree);
 val treep(val obj);
 val tree_insert_node(val tree, val node);
 val tree_begin(val tree);
diff --git a/txr.1 b/txr.1
index 7f718700..5a536e50 100644
--- a/txr.1
+++ b/txr.1
@@ -28078,6 +28078,8 @@ the type of the argument, as follows:
 .meti (make-random-state << object )
 .coIP tnode
 .meti (copy-tnode << object )
+.coIP tree
+.meti (copy-search-tree << object )
 .RE
 
 .IP
@@ -45638,6 +45640,28 @@ is already empty, then the function returns
 otherwise it returns an integer which gives the count of the number
 of deleted nodes.
 
+.coNP Function @ copy-search-tree
+.synb
+.mets (copy-search-tree << tree )
+.syne
+.desc
+The
+.code copy-search-tree
+returns a new tree object which is a copy of
+.metn tree .
+
+The
+.meta tree
+argument must be an object of type
+.codn tree .
+
+The returned object has the same key abstraction functions as
+.meta tree
+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
 .synb
 .mets (tree-begin < tree )
-- 
cgit v1.2.3