]> gitweb.factorcode.org Git - factor.git/blobdiff - basis/compiler/cfg/linear-scan/assignment/assignment.factor
use reject instead of [ ... not ] filter.
[factor.git] / basis / compiler / cfg / linear-scan / assignment / assignment.factor
index 20d0f5b37039438b0d239faad7fb779d6d32e309..f35e0a5c99924723b52b8285f747e721f4cbac93 100644 (file)
@@ -5,7 +5,7 @@ compiler.cfg.linearization compiler.cfg.liveness compiler.cfg.registers
 compiler.cfg.instructions compiler.cfg.linear-scan.allocation.state
 compiler.cfg.linear-scan.live-intervals compiler.cfg.renaming.functor
 compiler.cfg.ssa.destruction.leaders cpu.architecture
-fry heaps kernel locals make math namespaces sequences sets ;
+fry heaps kernel make math namespaces sequences sets ;
 FROM: namespaces => set ;
 IN: compiler.cfg.linear-scan.assignment
 
@@ -22,11 +22,9 @@ SYMBOL: pending-interval-assoc
 : remove-pending ( live-interval -- )
     vreg>> pending-interval-assoc get delete-at ;
 
-:: vreg>reg ( vreg -- reg/spill-slot )
-    vreg leader :> leader
-    leader pending-interval-assoc get at* [
-        drop leader vreg rep-of lookup-spill-slot
-    ] unless ;
+: vreg>reg ( vreg -- reg/spill-slot )
+    dup leader dup pending-interval-assoc get at
+    [ 2nip ] [ swap rep-of lookup-spill-slot ] if* ;
 
 ERROR: not-spilled-error vreg ;
 
@@ -124,9 +122,9 @@ M: insn assign-registers-in-insn drop ;
         [ compute-live-in ]
     } cleave ;
 
-:: assign-registers-in-block ( bb -- )
-    bb begin-block
-    bb [
+: assign-registers-in-block ( bb -- )
+    dup begin-block
+    [
         [
             [
                 {
@@ -137,9 +135,7 @@ M: insn assign-registers-in-insn drop ;
                 } cleave
             ] each
         ] V{ } make
-    ] change-instructions drop
-
-    bb compute-live-out ;
+    ] change-instructions compute-live-out ;
 
 : init-assignment ( live-intervals -- )
     [ [ start>> ] map ] keep zip >min-heap unhandled-intervals set
@@ -151,5 +147,5 @@ M: insn assign-registers-in-insn drop ;
 
 : assign-registers ( cfg live-intervals -- )
     init-assignment
-    linearization-order [ kill-block?>> not ] filter
+    linearization-order [ kill-block?>> ] reject
     [ assign-registers-in-block ] each ;