working on the optimizer

library/compiler/optimizer.factor

@@ -56,14 +56,25 @@ USE: logic
     #! literal?
     [ dup cons? [ car over = ] [ drop f ] ifte ] some? ;
 
-: (can-kill?) ( literal node -- ? )
+: default-kill? ( literal node -- ? )
-    #! Return false if the literal appears as input to this
-    #! node, and this node is not a stack operation.
     [
         node-consume-d get mentions-literal? swap
         node-consume-r get mentions-literal? nip or not
     ] bind ;
 
+: (can-kill?) ( literal node -- ? )
+    #! Return false if the literal appears as input to this
+    #! node, and this node is not a stack operation.
+    dup [ node-op get ] bind dup "shuffle" word-property [
+        3drop t
+    ] [
+        "can-kill" word-property dup [
+            call
+        ] [
+            drop default-kill?
+        ] ifte
+    ] ifte ;
+
 : can-kill? ( literal dataflow -- ? )
     [ dupd (can-kill?) ] all? nip ;
 
@@ -71,7 +82,13 @@ USE: logic
     #! Push a list of literals that may be killed in the IR.
     dup scan-literals [ over can-kill? ] subset nip ;
 
+: can-kill-branches? ( literal node -- ? )
+    [ node-param get ] bind [ dupd can-kill? ] all? nip ;
+
 #push [ , ] "scan-literal" set-word-property
 #ifte [ scan-branches ] "scan-literal" set-word-property
+#ifte [ can-kill-branches? ] "can-kill" set-word-property
 #generic [ scan-branches ] "scan-literal" set-word-property
+#generic [ can-kill-branches? ] "can-kill" set-word-property
 #2generic [ scan-branches ] "scan-literal" set-word-property
+#2generic [ can-kill-branches? ] "can-kill" set-word-property

library/inference/dataflow.factor

@@ -47,6 +47,18 @@ SYMBOL: #2generic
 
 SYMBOL: #return
 
+SYMBOL: #drop
+SYMBOL: #dup
+SYMBOL: #swap
+SYMBOL: #over
+SYMBOL: #pick
+SYMBOL: #nip
+SYMBOL: #tuck
+SYMBOL: #rot
+
+SYMBOL: #>r
+SYMBOL: #r>
+
 SYMBOL: node-consume-d
 SYMBOL: node-produce-d
 SYMBOL: node-consume-r
@@ -93,7 +105,7 @@ SYMBOL: node-param
 : dataflow-drop, ( -- )
     #! Remove the top stack element and add a dataflow node
     #! noting this.
-    \ drop #call dataflow, [ 1 0 node-inputs ] bind ;
+    f #drop dataflow, [ 1 0 node-inputs ] bind ;
 
 : apply-dataflow ( dataflow name default -- )
     #! For the dataflow node, look up named word property,

library/inference/stack.factor

@@ -33,31 +33,37 @@ USE: lists
 USE: namespaces
 
 \ >r [
-    \ >r #call dataflow, [ 1 0 node-inputs ] extend
+    f #>r dataflow, [ 1 0 node-inputs ] extend
     pop-d push-r
     [ 0 1 node-outputs ] bind
 ] "infer" set-word-property
 
+\ >r t "shuffle" set-word-property
+
 \ r> [
-    \ r> #call dataflow, [ 0 1 node-inputs ] extend
+    f #r> dataflow, [ 0 1 node-inputs ] extend
     pop-r push-d
     [ 1 0 node-outputs ] bind
 ] "infer" set-word-property
 
-: meta-infer ( word -- )
+\ r> t "shuffle" set-word-property
+
+: meta-infer ( word op -- )
     #! Mark a word as being partially evaluated.
-    dup [
+    dup t "shuffle" set-word-property
-       dup unit , \ car , \ dup ,
+    dupd [
-       "infer-effect" word-property ,
+        over unit , \ car ,
-       [ drop host-word ] ,
+        f , ,
-       \ with-dataflow ,
+        "infer-effect" word-property ,
+        [ drop host-word ] ,
+        \ with-dataflow ,
     ] make-list "infer" set-word-property ;
 
-\ drop meta-infer
+\ drop #drop meta-infer
-\ dup meta-infer
+\ dup #dup meta-infer
-\ swap meta-infer
+\ swap #swap meta-infer
-\ over meta-infer
+\ over #over meta-infer
-\ pick meta-infer
+\ pick #pick meta-infer
-\ nip meta-infer
+\ nip #nip meta-infer
-\ tuck meta-infer
+\ tuck #tuck meta-infer
-\ rot meta-infer
+\ rot #rot meta-infer

library/inference/words.factor

@@ -41,19 +41,18 @@ USE: words
 USE: hashtables
 USE: prettyprint
 
-: with-dataflow ( word [ in | out ] quot -- )
+: with-dataflow ( param op [ in | out ] quot -- )
     #! Take input parameters, execute quotation, take output
     #! parameters, add node. The quotation is called with the
     #! stack effect.
-    over car ensure-d
+    >r dup car ensure-d >r dataflow, r> r> rot
-    rot #call dataflow,
     [ pick swap dataflow-inputs ] keep
     pick 2slip swap dataflow-outputs ; inline
 
 : consume/produce ( word [ in | out ] -- )
     #! Add a node to the dataflow graph that consumes and
     #! produces a number of values.
-    [ unswons consume-d produce-d ] with-dataflow ;
+    #call swap [ unswons consume-d produce-d ] with-dataflow ;
 
 : apply-effect ( word [ in | out ] -- )
     #! If a word does not have special inference behavior, we

library/test/optimizer.factor

@@ -3,7 +3,11 @@ USE: test
 USE: compiler
 USE: inference
 USE: words
+USE: math
+USE: combinators
 
 : foo 1 2 3 ;
 
 [ [ ] ] [ \ foo word-parameter dataflow kill-set ] unit-test
+
+[ [ [ + ] [ - ] ] ] [ [ 3 4 1 2 > [ + ] [ - ] ifte ] dataflow kill-set ] unit-test