4 files changed, 80 insertions, 0 deletions

diff --git a/eval.c b/eval.c
index 747fd74a..2a345f09 100644
--- a/eval.c
+++ b/eval.c
@@ -6780,6 +6780,7 @@ void eval_init(void)
   reg_fun(intern(lit("alist-remove"), user_package), func_n1v(alist_removev));
   reg_fun(intern(lit("alist-nremove"), user_package), func_n1v(alist_nremovev));
   reg_fun(intern(lit("copy-cons"), user_package), func_n1(copy_cons));
+  reg_fun(intern(lit("copy-tree"), user_package), func_n1(copy_tree));
   reg_fun(intern(lit("copy-alist"), user_package), func_n1(copy_alist));
   reg_fun(intern(lit("prop"), user_package), func_n2(getplist));
   reg_fun(intern(lit("memp"), user_package), func_n2(memp));
diff --git a/lib.c b/lib.c
index 461b1664..ba129115 100644
--- a/lib.c
+++ b/lib.c
@@ -8175,6 +8175,21 @@ val copy_cons(val cell)
   }
 }
 
+val copy_tree(val tree)
+{
+  if (atom(tree)) {
+    return tree;
+  } else {
+    val car = copy_tree(tree->c.car);
+    val cdr = copy_tree(tree->c.cdr);
+    val copy = make_obj();
+    *copy = *tree;
+    copy->c.car = car;
+    copy->c.cdr = cdr;
+    return copy;
+  }
+}
+
 val copy_alist(val list)
 {
   list_collect_decl (out, ptail);
diff --git a/lib.h b/lib.h
index a57442a4..bd5fbfc3 100644
--- a/lib.h
+++ b/lib.h
@@ -1061,6 +1061,7 @@ val alist_nremove(val list, val keys);
 val alist_nremovev(val list, struct args *keys);
 val alist_nremove1(val list, val key);
 val copy_cons(val cons);
+val copy_tree(val tree);
 val copy_alist(val list);
 val mapcar_listout(val fun, val list);
 val mapcar(val fun, val list);
diff --git a/txr.1 b/txr.1
index 0d357c56..8309ee13 100644
--- a/txr.1
+++ b/txr.1
@@ -19400,6 +19400,69 @@ state as the original. If the original has not yet been updated
 and thus has an update function, the copy also has not yet been
 updated and has the same update function.
 
+.coNP Function @ copy-tree
+.synb
+.mets (copy-tree << obj )
+.syne
+.desc
+The
+.code copy-tree
+function returns a copy of
+.meta obj
+which represents an arbitrary
+.codn cons -cell-based
+structure.
+
+The cell structure of
+.meta obj
+is traversed and a similar structure is constructed, but without regard for
+substructure sharing or circularity.
+
+More precisely, if
+.meta obj
+is an atom, then it is returned.
+If it is an ordinary
+.code cons
+cell, then
+.code copy-tree
+is recursively applied to the
+.code car
+and
+.code cdr
+fields to produce their individual replicas. A new
+.code cons
+cell is then produced from the replicated
+.code car
+and
+.codn cdr .
+If
+.meta obj
+is a lazy
+.codn cons ,
+then just like in the ordinary
+.code cons
+case, the
+.code car
+and
+.code cdr
+fields are duplicated with a recursive call to
+.codn copy-tree .
+Then, a lazy
+.code cons
+is created from these replicated fields. If
+.meta cell
+has an update function, then the newly created lazy
+.code cons
+has the same update function; the function isn't copied.
+
+Like
+.codn copy-cons ,
+the
+.code copy-tree
+function doesn't trigger the update of lazy conses.
+The copies of lazy conses which have not been updated
+are also conses which have not been updated.
+
 .coNP Functions @ reverse and @ nreverse
 .synb
 .mets (reverse << list )