summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--compiler/GHC/Core/Opt/ConstantFold.hs6
-rw-r--r--testsuite/tests/numeric/should_compile/T23019.hs21
-rw-r--r--testsuite/tests/numeric/should_compile/all.T1
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'])