From f01f7ad6eb2ffe47f758837d71df8a527778a712 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@shill.local>
Date: Thu, 20 Aug 2009 03:47:07 -0500
Subject: [PATCH] compiler.tree.propagation: bitand custom inlining was wrong
if the second input was a bignum
---
.../tree/propagation/propagation-tests.factor | 2 ++
.../propagation/transforms/transforms.factor | 21 +++++++++++++++----
2 files changed, 19 insertions(+), 4 deletions(-)
diff --git a/basis/compiler/tree/propagation/propagation-tests.factor b/basis/compiler/tree/propagation/propagation-tests.factor
index f20afc77f3..511f87dd09 100644
--- a/basis/compiler/tree/propagation/propagation-tests.factor
+++ b/basis/compiler/tree/propagation/propagation-tests.factor
@@ -82,6 +82,8 @@ IN: compiler.tree.propagation.tests
[ bignum ] [ [ { bignum bignum } declare bitxor ] final-math-class ] unit-test
+[ bignum ] [ [ { integer } declare 123 >bignum bitand ] final-math-class ] unit-test
+
[ float ] [ [ { float float } declare mod ] final-math-class ] unit-test
[ V{ fixnum } ] [ [ 255 bitand ] final-classes ] unit-test
diff --git a/basis/compiler/tree/propagation/transforms/transforms.factor b/basis/compiler/tree/propagation/transforms/transforms.factor
index d6c107b74b..683c182903 100644
--- a/basis/compiler/tree/propagation/transforms/transforms.factor
+++ b/basis/compiler/tree/propagation/transforms/transforms.factor
@@ -38,6 +38,12 @@ IN: compiler.tree.propagation.transforms
in-d>> rem-custom-inlining
] "custom-inlining" set-word-prop
+: positive-fixnum? ( obj -- ? )
+ { [ fixnum? ] [ 0 >= ] } 1&& ;
+
+: simplify-bitand? ( value -- ? )
+ value-info literal>> positive-fixnum? ;
+
{
bitand-integer-integer
bitand-integer-fixnum
@@ -45,10 +51,17 @@ IN: compiler.tree.propagation.transforms
bitand
} [
[
- in-d>> second value-info >literal< [
- 0 most-positive-fixnum between?
- [ [ >fixnum ] bi@ fixnum-bitand ] f ?
- ] when
+ {
+ {
+ [ dup in-d>> first simplify-bitand? ]
+ [ drop [ >fixnum fixnum-bitand ] ]
+ }
+ {
+ [ dup in-d>> second simplify-bitand? ]
+ [ drop [ [ >fixnum ] dip fixnum-bitand ] ]
+ }
+ [ drop f ]
+ } cond
] "custom-inlining" set-word-prop
] each