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..

diff --git a/extra/trees/trees-tests.factor b/extra/trees/trees-tests.factor
index 2e8eb454a8db698791db5362bf5007284acdb36d..3ce9802d3ed613014fe7a17f35194d7a29794d80 100644 (file)
--- 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 e59af367cdb76cef1abfbb398a05027b20810563..3d51961b69eba6de2e3c7a50cdf984ce84dd9c7e 100644 (file)
--- 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 ;