Scheduling doesn't have such redundant data structures anymore

diff --git a/basis/compiler/cfg/dependence/dependence.factor b/basis/compiler/cfg/dependence/dependence.factor
index 94649239705fe5b44850640935cf224ac09b38d9..0b1f598901d44d60a8efc142c6c576996c644ad0 100644 (file)
--- a/basis/compiler/cfg/dependence/dependence.factor
+++ b/basis/compiler/cfg/dependence/dependence.factor
@@ -12,11 +12,13 @@ SYMBOL: roots
 SYMBOL: node-number
 SYMBOL: nodes
 
+SYMBOL: +data+
+SYMBOL: +control+
+
 ! Nodes in the dependency graph
 ! These need to be numbered so that the same instruction
 ! will get distinct nodes if it occurs multiple times
 TUPLE: node
-    precedes-data precedes-control
     number insn precedes follows
     children parent
     registers parent-index ;
@@ -30,22 +32,15 @@ M: node hashcode* nip number>> ;
         node-number counter >>number
         swap >>insn
         H{ } clone >>precedes
-        H{ } clone >>precedes-data
-        H{ } clone >>precedes-control
         H{ } clone >>follows ;
 
 : ready? ( node -- ? ) precedes>> assoc-empty? ;
 
-: precedes ( first second -- )
-    swap precedes>> conjoin ;
-
-: precedes-data ( first second -- )
-    [ precedes ]
-    [ swap precedes-data>> conjoin ] 2bi ;
+: spin ( a b c -- c b a )
+    [ 2nip ] [ drop nip ] [ 2drop ] 3tri ;
 
-: precedes-control ( first second -- )
-    [ precedes ]
-    [ swap precedes-control>> conjoin ] 2bi ;
+: precedes ( first second how -- )
+    spin precedes>> set-at ;
 
 :: add-data-edges ( nodes -- )
     ! This builds up def-use information on the fly, since
@@ -53,11 +48,11 @@ M: node hashcode* nip number>> ;
     H{ } clone :> definers
     nodes [| node |
         node insn>> defs-vreg [ node swap definers set-at ] when*
-        node insn>> uses-vregs [ definers at [ node precedes-data ] when* ] each
+        node insn>> uses-vregs [ definers at [ node +data+ precedes ] when* ] each
     ] each ;
 
 : make-chain ( nodes -- )
-    [ dup rest-slice [ precedes-control ] 2each ] unless-empty ;
+    [ dup rest-slice [ +control+ precedes ] 2each ] unless-empty ;
 
 : instruction-chain ( nodes quot -- )
     '[ insn>> @ ] filter make-chain ; inline
@@ -107,7 +102,7 @@ UNION: alien-call-insn
 
 : set-follows ( nodes -- )
     [
-        dup precedes>> values [
+        dup precedes>> keys [
             follows>> conjoin
         ] with each
     ] each ;
@@ -140,11 +135,14 @@ UNION: alien-call-insn
     [ >>parent drop ]
     [ [ ?push ] change-children drop ] 2bi ;
 
+: keys-for ( assoc value -- keys )
+    '[ nip _ = ] assoc-filter keys ;
+
 : choose-parent ( node -- )
     ! If a node has control dependences, it has to be a root
     ! Otherwise, choose one of the data dependences for a parent
-    dup precedes-control>> assoc-empty? [
-        dup precedes-data>> values [ drop ] [
+    dup precedes>> +control+ keys-for empty? [
+        dup precedes>> +data+ keys-for [ drop ] [
             first attach-parent
         ] if-empty
     ] [ drop ] if ;

diff --git a/basis/compiler/cfg/scheduling/scheduling.factor b/basis/compiler/cfg/scheduling/scheduling.factor
index a38349a786f73e9128385a24d998a6a367bffb70..b81efb88ab3d3bb43747c560ec94f1c9635025cd 100644 (file)
--- a/basis/compiler/cfg/scheduling/scheduling.factor
+++ b/basis/compiler/cfg/scheduling/scheduling.factor
@@ -26,7 +26,7 @@ ERROR: bad-delete-at key assoc ;
     '[ _ >>parent-index drop ] each ;
 
 : remove-node ( node -- )
-    [ follows>> values ] keep
+    [ follows>> keys ] keep
     '[ [ precedes>> _ swap check-delete-at ] each ]
     [ [ ready? ] filter roots get push-all ] bi ;