diff options
| -rw-r--r-- | compiler/GHC/Core/Opt/ConstantFold.hs | 6 | ||||
| -rw-r--r-- | testsuite/tests/numeric/should_compile/T23019.hs | 21 | ||||
| -rw-r--r-- | testsuite/tests/numeric/should_compile/all.T | 1 |
3 files changed, 23 insertions, 5 deletions
diff --git a/compiler/GHC/Core/Opt/ConstantFold.hs b/compiler/GHC/Core/Opt/ConstantFold.hs index 7ace3124e9..2e5c6aabf6 100644 --- a/compiler/GHC/Core/Opt/ConstantFold.hs +++ b/compiler/GHC/Core/Opt/ConstantFold.hs @@ -1110,14 +1110,10 @@ doubleOp2 _ _ _ _ = Nothing -------------------------- doubleDecodeOp :: RuleOpts -> Literal -> Maybe CoreExpr doubleDecodeOp env (LitDouble ((decodeFloat . fromRational @Double) -> (m, e))) - = Just $ mkCoreUnboxedTuple [ Lit (mkLitINT64 (toInteger m)) + = Just $ mkCoreUnboxedTuple [ Lit (mkLitInt64Wrap (toInteger m)) , mkIntVal platform (toInteger e) ] where platform = roPlatform env - mkLitINT64 | platformWordSizeInBits platform < 64 - = mkLitInt64Wrap - | otherwise - = mkLitIntWrap platform doubleDecodeOp _ _ = Nothing diff --git a/testsuite/tests/numeric/should_compile/T23019.hs b/testsuite/tests/numeric/should_compile/T23019.hs new file mode 100644 index 0000000000..6b3e3d92ba --- /dev/null +++ b/testsuite/tests/numeric/should_compile/T23019.hs @@ -0,0 +1,21 @@ +module T23019 + ( + eexponent + ) where + +-- spine lazy, value strict list of doubles +data List + = Nil + | {-# UNPACK #-} !Double :! List + +infixr 5 :! + +newtype TowerDouble = Tower { getTower :: List } + +primal :: TowerDouble -> Double +primal (Tower (x:!_)) = x +primal _ = 0 + +eexponent :: TowerDouble -> Int +eexponent = exponent . primal + diff --git a/testsuite/tests/numeric/should_compile/all.T b/testsuite/tests/numeric/should_compile/all.T index 0c22811cc8..6f55e3b2fd 100644 --- a/testsuite/tests/numeric/should_compile/all.T +++ b/testsuite/tests/numeric/should_compile/all.T @@ -19,3 +19,4 @@ test('T20347', normal, compile, ['-ddump-simpl -O -dsuppress-all -dno-typeable-b test('T20448', normal, compile, ['-ddump-simpl -O -dsuppress-all -dno-typeable-binds -dsuppress-uniques']) test('T19641', normal, compile, ['-ddump-simpl -O -dsuppress-all -dno-typeable-binds -dsuppress-uniques']) test('T15547', normal, compile, ['-ddump-simpl -O -dsuppress-all -dno-typeable-binds -dsuppress-uniques']) +test('T23019', normal, compile, ['-O']) |