Adding identity to propagation to remove some redundant bitands

diff --git a/basis/compiler/tree/propagation/propagation-tests.factor b/basis/compiler/tree/propagation/propagation-tests.factor
index 92964654bfac5a462c69a2372c22073011cf154d..c1b66915421e18fed766ae04c5e692b83e6e4e61 100644 (file)
--- a/basis/compiler/tree/propagation/propagation-tests.factor
+++ b/basis/compiler/tree/propagation/propagation-tests.factor
@@ -899,3 +899,6 @@ M: tuple-with-read-only-slot clone
 ! We want this to inline
 [ t ] [ [ void* <c-direct-array> ] { <c-direct-array> } inlined? ] unit-test
 [ V{ void*-array } ] [ [ void* <c-direct-array> ] final-classes ] unit-test
+
+[ t ] [ [ alien-unsigned-1 255 bitand ] { bitand fixnum-bitand } inlined? ] unit-test
+[ t ] [ [ alien-unsigned-1 255 swap bitand ] { bitand fixnum-bitand } inlined? ] unit-test

diff --git a/basis/compiler/tree/propagation/transforms/transforms.factor b/basis/compiler/tree/propagation/transforms/transforms.factor
index 8aa6a821d8eba5ada8e1cc6004d1c6a3f9cd8459..08ac30624851b2fc8db2d1cdb673e789a375c4e5 100644 (file)
--- a/basis/compiler/tree/propagation/transforms/transforms.factor
+++ b/basis/compiler/tree/propagation/transforms/transforms.factor
@@ -45,6 +45,14 @@ IN: compiler.tree.propagation.transforms
 : simplify-bitand? ( value -- ? )
     value-info literal>> positive-fixnum? ;
 
+: redundant-bitand? ( var 111... -- ? )
+    [ value-info ] bi@ { [
+        nip literal>>
+        { [ positive-fixnum? ] [ dup 1 + bitand zero? ] } 1&&
+    ] [
+        [ interval>> ] [ literal>> ] bi* 0 swap [a,b] interval-subset?
+    ] } 2&& ;
+
 {
     bitand-integer-integer
     bitand-integer-fixnum
@@ -53,6 +61,14 @@ IN: compiler.tree.propagation.transforms
 } [
     [
         {
+            {
+                [ dup in-d>> first2 redundant-bitand? ]
+                [ drop [ drop ] ]
+            }
+            {
+                [ dup in-d>> first2 swap redundant-bitand? ]
+                [ drop [ nip ] ]
+            }
             {
                 [ dup in-d>> first simplify-bitand? ]
                 [ drop [ >fixnum fixnum-bitand ] ]