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 =
ru_try = match_Integer_unop op }
rule_bitInteger str name
= 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
= BuiltinRule { ru_name = fsLit str, ru_fn = name, ru_nargs = 2,
ru_try = match_Integer_binop op }
......@@ -1245,22 +1245,8 @@ match_Word64ToInteger _ id_unf id [xl]
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]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
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
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
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 unop _ id_unf fn [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, [
test('T14152a', [ only_ways(['optasm']), check_errmsg(r'dead code') ], compile, ['-fno-exitification -ddump-simpl'])
test('T13990', normal, compile, ['-dcore-lint -O'])
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