[Git][ghc/ghc][master] LLVM backend: Use correct rounding for Float literals

[Marge Bot (@marge-bot)]

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


Commits:
55b83587 by ARATA Mizuki at 2024-10-14T22:16:49-04:00
LLVM backend: Use correct rounding for Float literals

Fixes #22033

- - - - -


5 changed files:

- compiler/GHC/CmmToLlvm/CodeGen.hs
- compiler/GHC/CmmToLlvm/Data.hs
- + testsuite/tests/llvm/should_run/T22033.hs
- + testsuite/tests/llvm/should_run/T22033.stdout
- testsuite/tests/llvm/should_run/all.T


Changes:

=====================================
compiler/GHC/CmmToLlvm/CodeGen.hs
=====================================
@@ -2107,10 +2107,17 @@ genLit opt (CmmInt i w)
         --                 ]
     in return (mkIntLit width i, nilOL, [])
 
-genLit _ (CmmFloat r w)
-  = return (LMLitVar $ LMFloatLit (fromRational r) (widthToLlvmFloat w),
+genLit _ (CmmFloat r W32)
+  = return (LMLitVar $ LMFloatLit (widenFp (fromRational r :: Float)) (widthToLlvmFloat W32),
               nilOL, [])
 
+genLit _ (CmmFloat r W64)
+  = return (LMLitVar $ LMFloatLit (fromRational r :: Double) (widthToLlvmFloat W64),
+              nilOL, [])
+
+genLit _ (CmmFloat _r _w)
+  = panic "genLit (CmmLit:CmmFloat), unsupported float lit"
+
 genLit opt (CmmVec ls)
   = do llvmLits <- mapM toLlvmLit ls
        return (LMLitVar $ LMVectorLit llvmLits, nilOL, [])


=====================================
compiler/GHC/CmmToLlvm/Data.hs
=====================================
@@ -10,6 +10,7 @@ module GHC.CmmToLlvm.Data (
 import GHC.Prelude
 
 import GHC.Llvm
+import GHC.Llvm.Types (widenFp)
 import GHC.CmmToLlvm.Base
 import GHC.CmmToLlvm.Config
 
@@ -193,8 +194,14 @@ genStaticLit :: CmmLit -> LlvmM LlvmStatic
 genStaticLit (CmmInt i w)
     = return $ LMStaticLit (LMIntLit i (LMInt $ widthInBits w))
 
-genStaticLit (CmmFloat r w)
-    = return $ LMStaticLit (LMFloatLit (fromRational r) (widthToLlvmFloat w))
+genStaticLit (CmmFloat r W32)
+    = return $ LMStaticLit (LMFloatLit (widenFp (fromRational r :: Float)) (widthToLlvmFloat W32))
+
+genStaticLit (CmmFloat r W64)
+    = return $ LMStaticLit (LMFloatLit (fromRational r :: Double) (widthToLlvmFloat W64))
+
+genStaticLit (CmmFloat _r _w)
+    = panic "genStaticLit (CmmLit:CmmFloat), unsupported float lit"
 
 genStaticLit (CmmVec ls)
     = do sls <- mapM toLlvmLit ls


=====================================
testsuite/tests/llvm/should_run/T22033.hs
=====================================
@@ -0,0 +1,16 @@
+-- Minimal reproducer for https://gitlab.haskell.org/ghc/ghc/-/issues/22033
+{-# LANGUAGE MagicHash #-}
+import Numeric
+import GHC.Exts
+
+a :: Float
+a = F# (int2Float# 0xFFFFFF7FFFFFFFF#)
+
+f :: Int# -> Float#
+f x = int2Float# x
+{-# NOINLINE f #-}
+
+main :: IO ()
+main = do
+    putStrLn (showHFloat a "")
+    putStrLn (showHFloat (F# (f 0xFFFFFF7FFFFFFFF#)) "")


=====================================
testsuite/tests/llvm/should_run/T22033.stdout
=====================================
@@ -0,0 +1,2 @@
+0x1.fffffep59
+0x1.fffffep59


=====================================
testsuite/tests/llvm/should_run/all.T
=====================================
@@ -13,3 +13,4 @@ def ignore_llvm_and_vortex( msg ):
      return re.sub(r".* is not a recognized processor for this target.*\n",r"",msg)
 
 test('T22487', [normal, normalise_errmsg_fun(ignore_llvm_and_vortex)], compile_and_run, [''])
+test('T22033', [normal, normalise_errmsg_fun(ignore_llvm_and_vortex)], compile_and_run, [''])



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

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/55b83587d7a7288b243b8d3e5ec79a411bffdcbd
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/20241014/bfb7f7d2/attachment-0001.html>