optimize literals on either size of a shuffle

library/compiler/linearizer.factor

@@ -53,12 +53,6 @@ M: object load-value ( vreg n value -- )
 M: literal load-value ( vreg n value -- )
     nip push-literal ;
 
-: push-1 ( value -- ) 0 swap push-literal ;
-
-M: #push linearize-node* ( node -- )
-    node-out-d dup length dup %inc-d,
-    1 - swap [ push-1 0 over %replace-d , ] each drop ;
-
 : ifte-head ( label -- )
     in-1  -1 %inc-d, 0 %jump-t , ;
 

library/compiler/vops.factor

@@ -121,12 +121,12 @@ C: %end-dispatch make-vop ;
 ! stack operations
 TUPLE: %peek-d ;
 C: %peek-d make-vop ;
-: %peek-d ( vreg n -- ) swap <vreg> src/dest-vop <%peek-d> ;
+: %peek-d ( vreg n -- vop ) swap <vreg> src/dest-vop <%peek-d> ;
 M: %peek-d basic-block? drop t ;
 
 TUPLE: %replace-d ;
 C: %replace-d make-vop ;
-: %replace-d ( vreg n -- ) swap <vreg> 2-in-vop <%replace-d> ;
+: %replace-d ( vreg n -- vop ) swap <vreg> 2-in-vop <%replace-d> ;
 M: %replace-d basic-block? drop t ;
 
 TUPLE: %inc-d ;
@@ -138,17 +138,17 @@ M: %inc-d basic-block? drop t ;
 
 TUPLE: %immediate ;
 C: %immediate make-vop ;
-: %immediate ( vreg obj -- )
+: %immediate ( vreg obj -- vop )
     swap <vreg> src/dest-vop <%immediate> ;
 M: %immediate basic-block? drop t ;
 
 TUPLE: %peek-r ;
 C: %peek-r make-vop ;
-: %peek-r ( vreg n -- ) swap <vreg> src/dest-vop <%peek-r> ;
+: %peek-r ( vreg n -- vop ) swap <vreg> src/dest-vop <%peek-r> ;
 
 TUPLE: %replace-r ;
 C: %replace-r make-vop ;
-: %replace-r ( vreg n -- ) swap <vreg> 2-in-vop <%replace-r> ;
+: %replace-r ( vreg n -- vop ) swap <vreg> 2-in-vop <%replace-r> ;
 
 TUPLE: %inc-r ;
 C: %inc-r make-vop ;

library/inference/class-infer.factor

@@ -117,8 +117,9 @@ M: #call infer-classes* ( node -- )
         drop
     ] ifte ;
 
-M: #push infer-classes* ( node -- )
+M: #shuffle infer-classes* ( node -- )
-    node-out-d dup [ literal-value ] map swap assume-literals ;
+    node-out-d [ literal? ] subset
+    dup [ literal-value ] map swap assume-literals ;
 
 M: #ifte child-ties ( node -- seq )
     node-in-d first dup general-t <class-tie>

library/inference/dataflow.factor

@@ -95,13 +95,10 @@ TUPLE: #call-label ;
 C: #call-label make-node ;
 : #call-label ( label -- node ) param-node <#call-label> ;
 
-TUPLE: #push ;
-C: #push make-node ;
-: #push ( outputs -- node ) d-tail out-d-node <#push> ;
-
 TUPLE: #shuffle ;
 C: #shuffle make-node ;
 : #shuffle ( -- node ) empty-node <#shuffle> ;
+: #push ( outputs -- node ) d-tail out-d-node <#shuffle> ;
 
 TUPLE: #values ;
 C: #values make-node ;

library/inference/kill-literals.factor

@@ -41,12 +41,10 @@ M: node literals* ( node -- ) drop { } ;
 M: node can-kill* ( literal node -- ? )
     uses-value? not ;
 
-! #push
-M: #push literals* ( node -- ) node-out-d ;
-
-M: #push can-kill* ( literal node -- ? ) 2drop t ;
-
 ! #shuffle
+M: #shuffle literals* ( node -- )
+    node-out-d [ literal? ] subset ;
+
 M: #shuffle can-kill* ( literal node -- ? ) 2drop t ;
 
 ! #call-label

library/inference/optimizer.factor

@@ -50,10 +50,6 @@ M: f optimize-node* drop t ;
 M: node optimize-node* ( node -- t )
     drop t ;
 
-! #push
-M: #push optimize-node* ( node -- node/t )
-    [ node-out-d empty? ] prune-if ;
-
 ! #shuffle
 : compose-shuffle-nodes ( #shuffle #shuffle -- #shuffle/t )
     [ >r node-shuffle r> node-shuffle compose-shuffle ] keep
@@ -67,9 +63,7 @@ M: #shuffle optimize-node*  ( node -- node/t )
     dup node-successor dup #shuffle? [
         compose-shuffle-nodes
     ] [
-        drop [
+        drop [ node-values empty? ] prune-if
-            dup node-in-d empty? swap node-in-r empty? and
-        ] prune-if
     ] ifte ;
 
 ! #ifte

library/inference/print-dataflow.factor

@@ -16,21 +16,22 @@ M: comment pprint* ( ann -- )
 : comment, ( ? node text -- )
     rot [ <comment> , ] [ 2drop ] ifte ;
 
-: value-str ( prefix values -- str )
+: values% ( prefix values -- )
-    [ value-uid word-name append ] map-with concat ;
+    [
+        swap %
+        dup literal? [ literal-value ] [ value-uid ] ifte
+        unparse %
+    ] each-with ;
 
 : effect-str ( node -- str )
     [
-        " " over node-in-d value-str %
+        " " over node-in-d values%
-        " r: " over node-in-r value-str %
+        " r: " over node-in-r values%
         " --" %
-        " " over node-out-d value-str %
+        " " over node-out-d values%
-        " r: " swap node-out-r value-str %
+        " r: " swap node-out-r values%
     ] "" make 1 swap tail ;
 
-M: #push node>quot ( ? node -- )
-    node-out-d [ literal-value literalize ] map % drop ;
-
 M: #shuffle node>quot ( ? node -- )
     >r drop t r> dup effect-str "#shuffle: " swap append comment, ;
 

library/inference/shuffle.factor

@@ -10,8 +10,12 @@ TUPLE: shuffle in-d in-r out-d out-r ;
 : load-shuffle ( d r shuffle -- )
     tuck shuffle-in-r [ set ] 2each shuffle-in-d [ set ] 2each ;
 
+: shuffled-values ( values -- values )
+    [ dup literal? [ get ] unless ] map ;
+
 : store-shuffle ( shuffle -- d r )
-    dup shuffle-out-d [ get ] map swap shuffle-out-r [ get ] map ;
+    dup shuffle-out-d shuffled-values
+    swap shuffle-out-r shuffled-values ;
 
 : shuffle* ( d r shuffle -- d r )
     [ [ load-shuffle ] keep store-shuffle ] with-scope ;