use reject instead of [ ... not ] filter.

[factor.git] / basis / compiler / cfg / parallel-copy / parallel-copy.factor

diff --git a/basis/compiler/cfg/parallel-copy/parallel-copy.factor b/basis/compiler/cfg/parallel-copy/parallel-copy.factor
index e006c620b037d7b88dc973a01dcd8793daf5fb4e..1a7be5d8fd76f9bdc46f9172a447d4d448011721 100644 (file)
--- a/basis/compiler/cfg/parallel-copy/parallel-copy.factor
+++ b/basis/compiler/cfg/parallel-copy/parallel-copy.factor
@@ -1,14 +1,11 @@
 ! Copyright (C) 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: assocs cpu.architecture compiler.cfg.registers
-compiler.cfg.instructions deques dlists fry kernel locals namespaces
-sequences hashtables ;
+USING: assocs compiler.cfg.instructions compiler.cfg.registers
+compiler.cfg.ssa.destruction.leaders cpu.architecture deques
+dlists fry kernel locals make namespaces sequences ;
+FROM: sets => conjoin ;
 IN: compiler.cfg.parallel-copy
 
-! Revisiting Out-of-SSA Translation for Correctness, Code Quality, and Efficiency
-! http://hal.archives-ouvertes.fr/docs/00/34/99/25/PDF/OutSSA-RR.pdf,
-! Algorithm 1
-
 <PRIVATE
 
 SYMBOLS: locs preds to-do ready ;
@@ -17,7 +14,7 @@ SYMBOLS: locs preds to-do ready ;
     to-do get push-all-back ;
 
 : init-ready ( bs -- )
-    locs get '[ _ key? not ] filter ready get push-all-front ;
+    locs get '[ _ key? ] reject ready get push-all-front ;
 
 : init ( mapping -- )
     <dlist> to-do set
@@ -34,9 +31,6 @@ SYMBOLS: locs preds to-do ready ;
     a c = a preds get at and [ a ready get push-front ] when ; inline
 
 :: process-to-do ( b temp: ( src -- dst ) quot: ( dst src -- ) -- )
-    ! Note that we check if b = loc(b), not b = loc(pred(b)) as the
-    ! paper suggests. Confirmed by one of the authors at
-    ! http://www.reddit.com/comments/93253/some_lecture_notes_on_ssa_form/c0bco4f
     b locs get at b = [
         b temp call :> temp
         temp b quot call
@@ -47,7 +41,6 @@ SYMBOLS: locs preds to-do ready ;
 PRIVATE>
 
 :: parallel-mapping ( mapping temp: ( src -- dst ) quot: ( dst src -- ) -- )
-    ! mapping is a list of { dst src } pairs
     [
         mapping init
         to-do get [
@@ -58,20 +51,21 @@ PRIVATE>
         ] slurp-deque
     ] with-scope ; inline
 
-: parallel-copy ( mapping -- )
-    ! mapping is a list of { dst src } pairs
-    next-vreg '[ drop _ ] [ any-rep ##copy ] parallel-mapping ;
+: parallel-copy ( mapping -- insns )
+    [ next-vreg '[ drop _ ] [ any-rep ##copy, ] parallel-mapping ] { } make ;
 
 <PRIVATE
 
 SYMBOL: temp-vregs
 
 : temp-vreg ( rep -- vreg )
-    temp-vregs get [ next-vreg-rep ] cache ;
+    temp-vregs get [ next-vreg-rep ] cache
+    [ leader-map get conjoin ] keep ;
 
 PRIVATE>
 
-: parallel-copy-rep ( mapping -- )
-    ! mapping is a list of { dst src } pairs
-    H{ } clone temp-vregs set
-    [ rep-of temp-vreg ] [ dup rep-of ##copy ] parallel-mapping ;
+: parallel-copy-rep ( mapping -- insns )
+    [
+        H{ } clone temp-vregs set
+        [ rep-of temp-vreg ] [ dup rep-of ##copy, ] parallel-mapping
+    ] { } make ;