From 29ebeb5a2669f5820908bbe5bdd4d4aad221ce17 Mon Sep 17 00:00:00 2001
From: Jon Harper <jon.harper87@gmail.com>
Date: Fri, 6 Jan 2017 15:20:06 +0100
Subject: [PATCH] trees, change M\ tree clone to keep the shape of the tree

Without this, all base class and splay trees were becoming linked lists after cloning..
---
 extra/trees/trees-tests.factor | 11 +++++++++++
 extra/trees/trees.factor       | 13 ++++++++++++-
 2 files changed, 23 insertions(+), 1 deletion(-)

diff --git a/extra/trees/trees-tests.factor b/extra/trees/trees-tests.factor
index 2e8eb454a8..3ce9802d3e 100644
--- a/extra/trees/trees-tests.factor
+++ b/extra/trees/trees-tests.factor
@@ -25,3 +25,14 @@ IN: trees.tests
 { "replaced four" } [ test-tree 9 over delete-at 4 of ] unit-test
 { "nine" "replaced four" } [ test-tree 7 over delete-at 9 over at 4 rot at ] unit-test
 { "nine" } [ test-tree 7 over delete-at 4 over delete-at 9 of ] unit-test
+
+! test that cloning doesn't reshape the tree
+{ TREE{
+    { 7 "seven" }
+    { 9 "nine" }
+    { 4 "four" }
+} } [ TREE{
+    { 7 "seven" }
+    { 9 "nine" }
+    { 4 "four" }
+} clone ] unit-test
diff --git a/extra/trees/trees.factor b/extra/trees/trees.factor
index e59af367cd..3d51961b69 100644
--- a/extra/trees/trees.factor
+++ b/extra/trees/trees.factor
@@ -202,7 +202,18 @@ M: tree delete-at
 M: tree new-assoc
     2drop <tree> ;
 
-M: tree clone dup assoc-clone-like ;
+<PRIVATE
+
+: clone-nodes ( node -- node' )
+    dup [
+        clone
+        [ clone-nodes ] change-left
+        [ clone-nodes ] change-right
+    ] when ;
+
+PRIVATE>
+
+M: tree clone (clone) [ clone-nodes ] change-root ;
 
 : >tree ( assoc -- tree )
     T{ tree f f 0 } assoc-clone-like ;