From ec0bbe7e2d897c86a99ac038d67acd4596504b9d Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@factorcode.org>
Date: Mon, 25 Jul 2005 05:04:33 +0000
Subject: [PATCH] fix problem in optimizer

---
 library/compiler/optimizer.factor      | 14 ++++++++------
 library/test/compiler/optimizer.factor | 10 +++++++---
 2 files changed, 15 insertions(+), 9 deletions(-)

diff --git a/library/compiler/optimizer.factor b/library/compiler/optimizer.factor
index 682300ae26..8dc963bfe1 100644
--- a/library/compiler/optimizer.factor
+++ b/library/compiler/optimizer.factor
@@ -1,7 +1,8 @@
 ! Copyright (C) 2004, 2005 Slava Pestov.
 ! See http://factor.sf.net/license.txt for BSD license.
 IN: compiler-frontend
-USING: hashtables inference kernel lists namespaces sequences ;
+USING: generic hashtables inference kernel lists matrices
+namespaces sequences ;
 
 ! The optimizer transforms dataflow IR to dataflow IR. Currently
 ! it removes literals that are eventually dropped, and never
@@ -125,7 +126,7 @@ M: #drop useless-node? ( node -- ? )
 
 ! #call
 M: #call can-kill* ( literal node -- ? )
-    nip node-param {{
+    dup node-param {{
         [[ dup t ]]
         [[ drop t ]]
         [[ swap t ]]
@@ -133,9 +134,10 @@ M: #call can-kill* ( literal node -- ? )
         [[ pick t ]] 
         [[ >r t ]]
         [[ r> t ]]
-    }} hash ;
+    }} hash >r delegate can-kill* r> or ;
 
-: kill-mask ( killing inputs -- mask )
+: kill-mask ( killing node -- mask )
+    dup node-param \ r> = [ node-in-r ] [ node-in-d ] ifte
     [ swap memq? ] map-with ;
 
 : (kill-shuffle) ( word -- map )
@@ -159,13 +161,13 @@ M: #call can-kill* ( literal node -- ? )
     }} hash ;
 
 : lookup-mask ( mask word -- word )
-    over [ not ] all? [ nip ] [ (kill-shuffle) hash ] ifte ;
+    over disj [ (kill-shuffle) hash ] [ nip ] ifte ;
 
 : kill-shuffle ( literals node -- )
     #! If certain values passing through a stack op are being
     #! killed, the stack op can be reduced, in extreme cases
     #! to a no-op.
-    [ [ node-in-d kill-mask ] keep node-param lookup-mask ] keep
+    [ [ kill-mask ] keep node-param lookup-mask ] keep
     set-node-param ;
 
 M: #call kill-node* ( literals node -- )
diff --git a/library/test/compiler/optimizer.factor b/library/test/compiler/optimizer.factor
index de0fe83399..90fce73b48 100644
--- a/library/test/compiler/optimizer.factor
+++ b/library/test/compiler/optimizer.factor
@@ -21,9 +21,9 @@ USE: sequences
 
 [ [ [ 1 ] [ 2 ] ] ] [ [ [ 1 ] [ 2 ] ifte ] kill-set* ] unit-test
 
-[ [ t t f ] ] [ [ 1 2 3 ] [
-    f <literal> ] map
-    [ [ literal-value 2 <= ] subset ] keep kill-mask
+[ [ t t f ] ] [
+    [ 1 2 3 ] [ f <literal> ] map
+    [ [ literal-value 2 <= ] subset ] keep in-d-node <#drop> kill-mask
 ] unit-test
 
 [ t ] [
@@ -69,3 +69,7 @@ USE: sequences
 
 [ [ 5 [ dup ] [ dup ] ] ] [ \ literal-kill-test-6 word-def kill-set* ] unit-test
 
+: literal-kill-test-7
+    [ 1 2 3 ] >r + r> drop ; compiled
+
+[ 4 ] [ 2 2 literal-kill-test-7 ] unit-test