Small shuffle optimization cleanup

diff --git a/library/compiler/linearizer.factor b/library/compiler/linearizer.factor
index ee807e866cc5ca895b2e9b2110b42996030fab92..81bfc41ae0d65468f090f0cd7c2373b9520de08e 100644 (file)
--- a/library/compiler/linearizer.factor
+++ b/library/compiler/linearizer.factor
@@ -102,35 +102,18 @@ M: #call linearize* ( node -- next )
 M: #call-label linearize* ( node -- next )
     node-param renamed-label linearize-call ;
 
-SYMBOL: live-d
-SYMBOL: live-r
-
-: value-dropped? ( value -- ? )
-    dup value?
-    over live-d get member? not
-    rot live-r get member? not and
-    or ;
-
-: filter-dropped ( seq -- seq )
-    [ dup value-dropped? [ drop f ] when ] map ;
-
 : prepare-inputs ( values -- values templates )
-    filter-dropped dup [ any-reg swap 2array ] map ;
+    dup [ any-reg swap 2array ] map ;
 
-: do-inputs ( node -- )
-    dup node-in-d prepare-inputs rot node-in-r prepare-inputs
+: do-inputs ( shuffle -- )
+    dup shuffle-in-d prepare-inputs
+    rot shuffle-in-r prepare-inputs
     template-inputs ;
 
-: live-stores ( instack outstack -- stack )
-    #! Avoid storing a value into its former position.
-    dup length [ pick ?nth dupd eq? [ drop f ] when ] 2map nip ;
-
 M: #shuffle linearize* ( #shuffle -- )
     0 vreg-allocator set
-    dup node-in-d over node-out-d live-stores live-d set
-    dup node-in-r over node-out-r live-stores live-r set
-    do-inputs
-    live-d get live-r get template-outputs
+    node-shuffle dup do-inputs
+    dup shuffle-out-d swap shuffle-out-r template-outputs
     iterate-next ;
 
 : ?static-branch ( node -- n )

diff --git a/library/inference/shuffle.factor b/library/inference/shuffle.factor
index d54267abcca95de2022f4782cebcc84a3c68aa9b..54f29336e755c1d8ad983b44ced0c36e421f9b29 100644 (file)
--- a/library/inference/shuffle.factor
+++ b/library/inference/shuffle.factor
@@ -3,8 +3,6 @@ USING: hashtables kernel math namespaces sequences ;
 
 TUPLE: shuffle in-d in-r out-d out-r ;
 
-: empty-shuffle { } { } { } { } <shuffle> ;
-
 : load-shuffle ( d r shuffle -- )
     tuck shuffle-in-r [ set ] 2each shuffle-in-d [ set ] 2each ;
 
@@ -59,3 +57,26 @@ M: shuffle clone ( shuffle -- shuffle )
     [ shuffle-out-d clone ] keep
     shuffle-out-r clone
     <shuffle> ;
+
+SYMBOL: live-d
+SYMBOL: live-r
+
+: value-dropped? ( value -- ? )
+    dup value?
+    over live-d get member? not
+    rot live-r get member? not and
+    or ;
+
+: filter-dropped ( seq -- seq )
+    [ dup value-dropped? [ drop f ] when ] map ;
+
+: live-stores ( instack outstack -- stack )
+    #! Avoid storing a value into its former position.
+    dup length [ pick ?nth dupd eq? [ drop f ] when ] 2map nip ;
+
+: trim-shuffle ( shuffle -- shuffle )
+    dup shuffle-in-d over shuffle-out-d live-stores live-d set
+    dup shuffle-in-r over shuffle-out-r live-stores live-r set
+    dup shuffle-in-d filter-dropped
+    swap shuffle-in-r filter-dropped
+    live-d get live-r get <shuffle> ;