Merge branch 'master' of git://factorcode.org/git/factor

basis/disjoint-sets/disjoint-sets-docs.factor

@@ -0,0 +1,58 @@
+IN: disjoint-sets
+USING: help.markup help.syntax kernel assocs math ;
+
+HELP: <disjoint-set>
+{ $values { "disjoint-set" disjoint-set } }
+{ $description "Creates a new disjoint set data structure with no elements." } ;
+
+HELP: add-atom
+{ $values { "a" object } { "disjoint-set" disjoint-set } }
+{ $description "Adds a new element to the disjoint set, initially only equivalent to itself." } ;
+
+HELP: equiv-set-size
+{ $values { "a" object } { "disjoint-set" disjoint-set } { "n" integer } }
+{ $description "Outputs the number of elements in the equivalence class of " { $snippet "a" } "." } ;
+
+HELP: equiv?
+{ $values { "a" object } { "b" object } { "disjoint-set" disjoint-set } { "?" "a boolean" } }
+{ $description "Tests if two elements belong to the same equivalence class." } ;
+
+HELP: equate
+{ $values { "a" object } { "b" object } { "disjoint-set" disjoint-set } }
+{ $description "Merges the equivalence classes of two elements, which must previously have been added with " { $link add-atom } "." } ;
+
+HELP: assoc>disjoint-set
+{ $values { "assoc" assoc } { "disjoint-set" disjoint-set } }
+{ $description "Given an assoc representation of a graph where the keys are vertices and key/value pairs are edges, creates a disjoint set whose elements are the keys of assoc, and two keys are equvalent if they belong to the same connected component of the graph." }
+{ $examples
+    { $example
+        "USING: disjoint-sets kernel prettyprint ;"
+        "H{ { 1 1 } { 2 1 } { 3 4 } { 4 4 } { 5 3 } } assoc>disjoint-set"
+        "1 2 pick equiv? ."
+        "4 5 pick equiv? ."
+        "1 5 pick equiv? ."
+        "drop"
+        "t\nt\nf\n"
+    }
+} ;
+
+ARTICLE: "disjoint-sets" "Disjoint sets"
+"The " { $emphasis "disjoint set" } " data structure, also known as " { $emphasis "union-find" } " (after the two main operations which it supports) represents a set of elements partitioned into disjoint equivalence classes, or alternatively, an equivalence relation on a set."
+$nl
+"The two main supported operations are equating two elements, which joins their equivalence classes, and checking if two elements belong to the same equivalence class. Both operations have the time complexity of the inverse Ackermann function, which for all intents and purposes is constant time."
+$nl
+"The class of disjoint sets:"
+{ $subsection disjoint-set }
+"Creating new disjoint sets:"
+{ $subsection <disjoint-set> }
+{ $subsection assoc>disjoint-set }
+"Queries:"
+{ $subsection equiv? }
+{ $subsection equiv-set-size }
+"Adding elements:"
+{ $subsection add-atom }
+"Equating elements:"
+{ $subsection equate }
+"Additionally, disjoint sets implement the " { $link clone } " generic word." ;
+
+ABOUT: "disjoint-sets"

basis/disjoint-sets/disjoint-sets.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2008 Eric Mertens.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors arrays hints kernel locals math hashtables
-assocs ;
+assocs fry ;
 
 IN: disjoint-sets
 
@@ -36,8 +36,6 @@ TUPLE: disjoint-set
 : representative? ( a disjoint-set -- ? )
     dupd parent = ; inline
 
-PRIVATE>
-
 GENERIC: representative ( a disjoint-set -- p )
 
 M: disjoint-set representative
@@ -45,8 +43,6 @@ M: disjoint-set representative
         [ [ parent ] keep representative dup ] 2keep set-parent
     ] if ;
 
-<PRIVATE
-
 : representatives ( a b disjoint-set -- r r )
     [ representative ] curry bi@ ; inline
 
@@ -90,3 +86,10 @@ M:: disjoint-set equate ( a b disjoint-set -- )
 M: disjoint-set clone
     [ parents>> ] [ ranks>> ] [ counts>> ] tri [ clone ] tri@
     disjoint-set boa ;
+
+: assoc>disjoint-set ( assoc -- disjoint-set )
+    <disjoint-set>
+    [ '[ drop , add-atom ] assoc-each ]
+    [ '[ , equate ] assoc-each ]
+    [ nip ]
+    2tri ;

unfinished/compiler/tree/escape-analysis/allocations/allocations.factor

@@ -4,18 +4,19 @@ USING: assocs namespaces sequences kernel math combinators sets
 disjoint-sets fry stack-checker.state compiler.tree.copy-equiv ;
 IN: compiler.tree.escape-analysis.allocations
 
-! A map from values to sequences of values
+! A map from values to one of the following:
+! - f -- initial status, assigned to values we have not seen yet;
+!        may potentially become an allocation later
+! - a sequence of values -- potentially unboxed tuple allocations
+! - t -- not allocated locally, can never be unboxed
+
 SYMBOL: allocations
 
-: allocation ( value -- allocation )
+: (allocation) resolve-copy allocations get ; inline
-    resolve-copy allocations get at ;
 
-: record-allocation ( allocation value -- )
+: allocation ( value -- allocation ) (allocation) at ;
-    {
+
-        { [ dup not ] [ 2drop ] }
+: record-allocation ( allocation value -- ) (allocation) set-at ;
-        { [ over not ] [ allocations get delete-at drop ] }
-        [ allocations get set-at ]
-    } cond ;
 
 : record-allocations ( allocations values -- )
     [ record-allocation ] 2each ;
@@ -29,11 +30,8 @@ SYMBOL: +escaping+
     <disjoint-set> +escaping+ over add-atom ;
 
 : init-escaping-values ( -- )
-    copies get <escaping-values>
+    copies get assoc>disjoint-set +escaping+ over add-atom
-    [ '[ drop , add-atom ] assoc-each ]
+    escaping-values set ;
-    [ '[ , equate ] assoc-each ]
-    [ nip escaping-values set ]
-    2tri ;
 
 : <slot-value> ( -- value )
     <value>

unfinished/compiler/tree/escape-analysis/branches/branches.factor

@@ -8,8 +8,6 @@ compiler.tree.escape-analysis.nodes
 compiler.tree.escape-analysis.allocations ;
 IN: compiler.tree.escape-analysis.branches
 
-SYMBOL: children-escape-data
-
 M: #branch escape-analysis*
     live-children sift [ (escape-analysis) ] each ;