From f86fbccfb05abca627614968585dd45dd25c033f Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Fri, 1 Aug 2008 20:00:12 -0500
Subject: [PATCH] Fixing copy-equiv
---
.../tree/copy-equiv/copy-equiv-tests.factor | 25 +++++++++++++++
.../tree/copy-equiv/copy-equiv.factor | 32 +++++++++++++------
2 files changed, 48 insertions(+), 9 deletions(-)
create mode 100644 unfinished/compiler/tree/copy-equiv/copy-equiv-tests.factor
diff --git a/unfinished/compiler/tree/copy-equiv/copy-equiv-tests.factor b/unfinished/compiler/tree/copy-equiv/copy-equiv-tests.factor
new file mode 100644
index 0000000000..251c4d40d2
--- /dev/null
+++ b/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
diff --git a/unfinished/compiler/tree/copy-equiv/copy-equiv.factor b/unfinished/compiler/tree/copy-equiv/copy-equiv.factor
index bd3375a78d..bf5b47c9b1 100644
--- a/unfinished/compiler/tree/copy-equiv/copy-equiv.factor
+++ b/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 ;