[Git][ghc/ghc][master] constant folding: Correct type of decodeDouble_Int64 rule

[Marge Bot (@marge-bot)]

Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC


Commits:
a86aae8b by Matthew Pickering at 2023-03-02T22:43:59-05:00
constant folding: Correct type of decodeDouble_Int64 rule

The first argument is Int64# unconditionally, so we better produce
something of that type. This fixes a core lint error found in the ad
package.

Fixes #23019

- - - - -


3 changed files:

- compiler/GHC/Core/Opt/ConstantFold.hs
- + testsuite/tests/numeric/should_compile/T23019.hs
- testsuite/tests/numeric/should_compile/all.T


Changes:

=====================================
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
 


=====================================
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
+


=====================================
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'])



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a86aae8b562c12bb3cee8dcae5156b647f1a74ad

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a86aae8b562c12bb3cee8dcae5156b647f1a74ad
You're receiving this email because of your account on gitlab.haskell.org.


-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20230302/ef57a7c6/attachment-0001.html>