Fixing copy-equiv

unfinished/compiler/tree/copy-equiv/copy-equiv-tests.factor

@@ -0,0 +1,25 @@
+IN: compiler.tree.copy-equiv.tests
+USING: compiler.tree.copy-equiv tools.test namespaces kernel
+assocs ;
+
+H{ } clone copies set
+
+[ ] [ 0 introduce-value ] unit-test
+[ ] [ 1 introduce-value ] unit-test
+[ ] [ 1 2 is-copy-of ] unit-test
+[ ] [ 2 3 is-copy-of ] unit-test
+[ ] [ 2 4 is-copy-of ] unit-test
+[ ] [ 4 5 is-copy-of ] unit-test
+[ ] [ 0 6 is-copy-of ] unit-test
+
+[ 0 ] [ 0 resolve-copy ] unit-test
+[ 1 ] [ 5 resolve-copy ] unit-test
+
+! Make sure that we did path compression
+[ 1 ] [ 5 copies get at ] unit-test
+
+[ 1 ] [ 1 resolve-copy ] unit-test
+[ 1 ] [ 2 resolve-copy ] unit-test
+[ 1 ] [ 3 resolve-copy ] unit-test
+[ 1 ] [ 4 resolve-copy ] unit-test
+[ 0 ] [ 6 resolve-copy ] unit-test

unfinished/compiler/tree/copy-equiv/copy-equiv.factor

@@ -1,23 +1,37 @@
 ! Copyright (C) 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: namespaces disjoint-sets sequences assocs math
-kernel accessors fry
-compiler.tree compiler.tree.def-use compiler.tree.combinators ;
+USING: namespaces sequences assocs math kernel accessors fry
+combinators sets locals
+compiler.tree
+compiler.tree.def-use
+compiler.tree.combinators ;
 IN: compiler.tree.copy-equiv
 
 ! Two values are copy-equivalent if they are always identical
 ! at run-time ("DS" relation).
 
-! Disjoint set of copy equivalence
+! Mapping from values to their canonical leader
 SYMBOL: copies
 
-: is-copy-of ( val copy -- ) copies get equate ;
+:: compress-path ( source assoc -- destination )
+    [let | destination [ source assoc at ] |
+        source destination = [ source ] [
+            [let | destination' [ destination assoc compress-path ] |
+                destination' destination = [
+                    destination' source assoc set-at
+                ] unless
+                destination'
+            ]
+        ] if
+    ] ;
+
+: resolve-copy ( copy -- val ) copies get compress-path ;
+
+: is-copy-of ( val copy -- ) copies get set-at ;
 
 : are-copies-of ( vals copies -- ) [ is-copy-of ] 2each ;
 
-: resolve-copy ( copy -- val ) copies get representative ;
-
-: introduce-value ( val -- ) copies get add-atom ;
+: introduce-value ( val -- ) copies get conjoin ;
 
 GENERIC: compute-copy-equiv* ( node -- )
 
@@ -60,5 +74,5 @@ M: node compute-copy-equiv* drop ;
     ] each-node ;
 
 : compute-copy-equiv ( node -- node )
-    <disjoint-set> copies set
+    H{ } clone copies set
     dup amend-copy-equiv ;