Commit 3c6a0578 authored by Simon Peyton Jones's avatar Simon Peyton Jones Committed by Ben Gamari

Fix over-eager constant folding in bitInteger

The RULE for bitInteger was trying to constant-fold

    bitInteger 9223372036854775807#

which meant constructing a gigantic Integer at compile
time.  Very bad idea!  Easily fixed.

Fixes Trac #14959, #14962.

(cherry picked from commit efc844f5)
parent bd85d963
...@@ -1090,7 +1090,7 @@ builtinIntegerRules = ...@@ -1090,7 +1090,7 @@ builtinIntegerRules =
ru_try = match_Integer_unop op } ru_try = match_Integer_unop op }
rule_bitInteger str name rule_bitInteger str name
= BuiltinRule { ru_name = fsLit str, ru_fn = name, ru_nargs = 1, = BuiltinRule { ru_name = fsLit str, ru_fn = name, ru_nargs = 1,
ru_try = match_IntToInteger_unop (bit . fromIntegral) } ru_try = match_bitInteger }
rule_binop str name op rule_binop str name op
= BuiltinRule { ru_name = fsLit str, ru_fn = name, ru_nargs = 2, = BuiltinRule { ru_name = fsLit str, ru_fn = name, ru_nargs = 2,
ru_try = match_Integer_binop op } ru_try = match_Integer_binop op }
...@@ -1245,22 +1245,8 @@ match_Word64ToInteger _ id_unf id [xl] ...@@ -1245,22 +1245,8 @@ match_Word64ToInteger _ id_unf id [xl]
match_Word64ToInteger _ _ _ _ = Nothing match_Word64ToInteger _ _ _ _ = Nothing
------------------------------------------------- -------------------------------------------------
match_Integer_convert :: Num a
=> (DynFlags -> a -> Expr CoreBndr)
-> RuleFun
match_Integer_convert convert dflags id_unf _ [xl]
| Just (LitInteger x _) <- exprIsLiteral_maybe id_unf xl
= Just (convert dflags (fromInteger x))
match_Integer_convert _ _ _ _ _ = Nothing
match_Integer_unop :: (Integer -> Integer) -> RuleFun
match_Integer_unop unop _ id_unf _ [xl]
| Just (LitInteger x i) <- exprIsLiteral_maybe id_unf xl
= Just (Lit (LitInteger (unop x) i))
match_Integer_unop _ _ _ _ _ = Nothing
{- Note [Rewriting bitInteger] {- Note [Rewriting bitInteger]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
For most types the bitInteger operation can be implemented in terms of shifts. For most types the bitInteger operation can be implemented in terms of shifts.
The integer-gmp package, however, can do substantially better than this if The integer-gmp package, however, can do substantially better than this if
allowed to provide its own implementation. However, in so doing it previously lost allowed to provide its own implementation. However, in so doing it previously lost
...@@ -1275,6 +1261,40 @@ should expect some funniness given that they will have at very least ignored a ...@@ -1275,6 +1261,40 @@ should expect some funniness given that they will have at very least ignored a
warning in this case. warning in this case.
-} -}
match_bitInteger :: RuleFun
-- Just for GHC.Integer.Type.bitInteger :: Int# -> Integer
match_bitInteger dflags id_unf fn [arg]
| Just (MachInt x) <- exprIsLiteral_maybe id_unf arg
, x >= 0
, x <= (wordSizeInBits dflags - 1)
-- Make sure x is small enough to yield a decently small iteger
-- Attempting to construct the Integer for
-- (bitInteger 9223372036854775807#)
-- would be a bad idea (Trac #14959)
, let x_int = fromIntegral x :: Int
= case splitFunTy_maybe (idType fn) of
Just (_, integerTy)
-> Just (Lit (LitInteger (bit x_int) integerTy))
_ -> panic "match_IntToInteger_unop: Id has the wrong type"
match_bitInteger _ _ _ _ = Nothing
-------------------------------------------------
match_Integer_convert :: Num a
=> (DynFlags -> a -> Expr CoreBndr)
-> RuleFun
match_Integer_convert convert dflags id_unf _ [xl]
| Just (LitInteger x _) <- exprIsLiteral_maybe id_unf xl
= Just (convert dflags (fromInteger x))
match_Integer_convert _ _ _ _ _ = Nothing
match_Integer_unop :: (Integer -> Integer) -> RuleFun
match_Integer_unop unop _ id_unf _ [xl]
| Just (LitInteger x i) <- exprIsLiteral_maybe id_unf xl
= Just (Lit (LitInteger (unop x) i))
match_Integer_unop _ _ _ _ _ = Nothing
match_IntToInteger_unop :: (Integer -> Integer) -> RuleFun match_IntToInteger_unop :: (Integer -> Integer) -> RuleFun
match_IntToInteger_unop unop _ id_unf fn [xl] match_IntToInteger_unop unop _ id_unf fn [xl]
| Just (MachInt x) <- exprIsLiteral_maybe id_unf xl | Just (MachInt x) <- exprIsLiteral_maybe id_unf xl
......
module T14959 where
import Data.Bits (setBit)
f = foldl setBit 0 [x | (x,_) <- zip [0..] [1]] :: Integer
...@@ -294,3 +294,4 @@ test('T14152', [ only_ways(['optasm']), check_errmsg(r'dead code') ], compile, [ ...@@ -294,3 +294,4 @@ test('T14152', [ only_ways(['optasm']), check_errmsg(r'dead code') ], compile, [
test('T14152a', [ only_ways(['optasm']), check_errmsg(r'dead code') ], compile, ['-fno-exitification -ddump-simpl']) test('T14152a', [ only_ways(['optasm']), check_errmsg(r'dead code') ], compile, ['-fno-exitification -ddump-simpl'])
test('T13990', normal, compile, ['-dcore-lint -O']) test('T13990', normal, compile, ['-dcore-lint -O'])
test('T14650', normal, compile, ['-O2']) test('T14650', normal, compile, ['-O2'])
test('T14959', normal, compile, ['-O'])
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment