compiler.cfg.dependence/scheduling: fix(?) for #1187, just avoid shuffling ##peek...

basis/compiler/cfg/dependence/dependence-tests.factor

@@ -1,6 +1,6 @@
 USING: accessors arrays assocs combinators.short-circuit
-compiler.cfg.dependence compiler.cfg.instructions compiler.cfg.registers fry
+compiler.cfg.dependence compiler.cfg.instructions
-grouping kernel math namespaces random sequences tools.test vectors ;
+grouping kernel math random sequences tools.test vectors ;
 IN: compiler.cfg.dependence.tests
 FROM: sets => members set= ;
 
@@ -106,68 +106,3 @@ ERROR: node-missing-children trees nodes ;
         [ children>> length ] map
     ] replicate all-equal?
 ] unit-test
-
-: test-some-kind-of-dep ( -- insns )
-    ! 0 node-number set-global
-    V{
-        T{ ##peek { dst 275 } { loc D 2 } }
-        T{ ##load-tagged { dst 277 } { val 0 } }
-        T{ ##allot
-           { dst 280 }
-           { size 16 }
-           { class-of array }
-           { temp 6 }
-        }
-        T{ ##set-slot-imm
-           { src 277 }
-           { obj 280 }
-           { slot 1 }
-           { tag 2 }
-        }
-        T{ ##load-reference
-           { dst 283 }
-           { obj
-             {
-                 vector
-                 2
-                 1
-                 tuple
-                 258304024774
-                 vector
-                 8390923745423
-             }
-           }
-        }
-        T{ ##allot
-           { dst 285 }
-           { size 32 }
-           { class-of tuple }
-           { temp 12 }
-        }
-        T{ ##set-slot-imm
-           { src 283 }
-           { obj 285 }
-           { slot 1 }
-           { tag 7 }
-        }
-        T{ ##set-slot-imm
-           { src 280 }
-           { obj 285 }
-           { slot 2 }
-           { tag 7 }
-        }
-    } [ 2 * >>insn# ] map-index [ <node> ] map ;
-
-{ 7 } [
-    test-not-in-order [ <node> ] map
-    dup build-dependence-graph
-    dup build-fan-in-trees
-    [ parent-index>> -1/0. = ] count
-] unit-test
-
-{ V{ 0 6 12 14 } } [
-    test-some-kind-of-dep
-    dup build-dependence-graph
-    dup build-fan-in-trees
-    [ parent-index>> -1/0. = ] filter [ insn>> insn#>> ] map
-] unit-test

basis/compiler/cfg/dependence/dependence.factor

@@ -6,15 +6,12 @@ namespaces sequences sorting make math math.vectors sets vectors ;
 FROM: namespaces => set ;
 IN: compiler.cfg.dependence
 
-SYMBOL: +data+
+SYMBOLS: +data+ +control+ ;
-SYMBOL: +control+
 
 TUPLE: node < identity-tuple insn precedes children registers parent-index ;
 
 : <node> ( insn -- node )
-    node new
+    node new swap >>insn H{ } clone >>precedes ;
-        swap >>insn
-        H{ } clone >>precedes ;
 
 :: precedes ( first second how -- )
     how second first precedes>> set-at ;
@@ -50,9 +47,7 @@ UNION: memory-insn
 GENERIC: add-control-edge ( node insn -- )
 
 M: stack-insn add-control-edge loc>> chain ;
-
 M: memory-insn add-control-edge drop memory-insn chain ;
-
 M: object add-control-edge 2drop ;
 
 : add-control-edges ( nodes -- )

basis/compiler/cfg/scheduling/scheduling-tests.factor

@@ -1,7 +1,8 @@
 USING: accessors arrays assocs compiler.cfg compiler.cfg.dependence
 compiler.cfg.dependence.tests compiler.cfg.instructions
-compiler.cfg.linearization compiler.cfg.scheduling compiler.cfg.utilities
+compiler.cfg.linearization compiler.cfg.registers compiler.cfg.scheduling
-grouping kernel math namespaces tools.test random sequences sets words ;
+compiler.cfg.utilities grouping kernel math namespaces tools.test random
+sequences sets splitting vectors words ;
 IN: compiler.cfg.scheduling.tests
 
 ! Test split-insns
@@ -84,10 +85,8 @@ IN: compiler.cfg.scheduling.tests
 
 {
     {
-        V{ T{ ##inc-r } T{ ##inc-d } }
+        V{ T{ ##inc-r } T{ ##inc-d } T{ ##peek } T{ ##peek } }
         V{
-            T{ ##peek }
-            T{ ##peek }
             T{ ##load-tagged }
             T{ ##allot }
             T{ ##set-slot-imm }
@@ -159,8 +158,58 @@ IN: compiler.cfg.scheduling.tests
     100 [ test-1187 split-insns 1 swap nth reorder ] replicate all-equal?
 ] unit-test
 
+: insns-1 ( -- insns )
+    V{
+        T{ ##peek { dst 275 } { loc D 2 } }
+        T{ ##load-tagged { dst 277 } { val 0 } }
+        T{ ##allot
+           { dst 280 }
+           { size 16 }
+           { class-of array }
+           { temp 6 }
+        }
+        T{ ##set-slot-imm
+           { src 277 }
+           { obj 280 }
+           { slot 1 }
+           { tag 2 }
+        }
+        T{ ##load-reference
+           { dst 283 }
+           { obj
+             {
+                 vector
+                 2
+                 1
+                 tuple
+                 258304024774
+                 vector
+                 8390923745423
+             }
+           }
+        }
+        T{ ##allot
+           { dst 285 }
+           { size 32 }
+           { class-of tuple }
+           { temp 12 }
+        }
+        T{ ##set-slot-imm
+           { src 283 }
+           { obj 285 }
+           { slot 1 }
+           { tag 7 }
+        }
+        T{ ##set-slot-imm
+           { src 280 }
+           { obj 285 }
+           { slot 2 }
+           { tag 7 }
+        }
+    } [ 2 * >>insn# ] map-index ;
+
 { t f } [
-    test-some-kind-of-dep dup build-dependence-graph
+    insns-1 setup-nodes
     ! Anyone preceding insn# 14?
     [
         [ precedes>> keys [ insn>> insn#>> ] map 14 swap member? ] any?
@@ -170,3 +219,13 @@ IN: compiler.cfg.scheduling.tests
         [ precedes>> keys [ insn>> insn#>> ] map 14 swap member? ] any?
     ] bi
 ] unit-test
+
+{ V{ 0 6 12 14 } } [
+    insns-1 setup-nodes
+    [ parent-index>> -1/0. = ] filter [ insn>> insn#>> ] map
+] unit-test
+
+{ 7 } [
+    test-not-in-order setup-nodes
+    [ parent-index>> -1/0. = ] count
+] unit-test

basis/compiler/cfg/scheduling/scheduling.factor

@@ -36,7 +36,10 @@ IN: compiler.cfg.scheduling
 : (reorder) ( nodes -- )
     dup select-instruction [ , (reorder) ] [ drop ] if* ;
 
-UNION: initial-insn ##phi ##inc-d ##inc-r ##callback-inputs ;
+UNION: initial-insn
+    ##phi ##inc-d ##inc-r ##callback-inputs
+    ! See #1187
+    ##peek ;
 
 UNION: final-insn
 ##branch