fix printing of Infinites and NaNs

llvm-pretty.cabal

@@ -46,7 +46,7 @@ Library
                        Text.LLVM.Triple.Parse.LookupTable
                        Text.LLVM.Util
 
-  Build-depends:       base             >= 4.9 && < 5,
+  Build-depends:       base             >= 4.11 && < 5,
                        containers       >= 0.4,
                        parsec           >= 3,
                        pretty           >= 1.0.1,

src/Text/LLVM/PP.hs

@@ -27,6 +27,7 @@ import Data.Char (isAlphaNum,isAscii,isDigit,isPrint,ord,toUpper)
 import Data.List (intersperse)
 import qualified Data.Map as Map
 import Data.Maybe (catMaybes,fromMaybe,isJust)
+import GHC.Float (castDoubleToWord64, castFloatToWord32)
 import Numeric (showHex)
 import Text.PrettyPrint.HughesPJ
 import Data.Int
@@ -813,8 +814,15 @@ ppValue' :: Fmt i -> Fmt (Value' i)
 ppValue' pp val = case val of
   ValInteger i       -> integer i
   ValBool b          -> ppBool b
-  ValFloat i         -> float i
-  ValDouble i        -> double i
+  -- Note: for +Inf/-Inf/NaNs, we want to output the bit-correct sequence
+  ValFloat f         ->
+    if isInfinite f || isNaN f
+      then text "0x" <> text (showHex (castFloatToWord32 f) "")
+      else float f
+  ValDouble d        ->
+    if isInfinite d || isNaN d
+      then text "0x" <> text (showHex (castDoubleToWord64 d) "")
+      else double d
   ValFP80 (FP80_LongDouble e s) ->
     -- shown as 0xK<<20-hex-digits>>, per
     -- https://llvm.org/docs/LangRef.html#simple-constants

test/Output.hs

@@ -13,6 +13,7 @@ module Output ( tests ) where
 
 import           Control.Monad ( unless )
 import qualified Data.Text as T
+import           GHC.Float (castWord32ToFloat, castWord64ToDouble)
 import qualified Test.Tasty as Tasty
 import           Test.Tasty.HUnit
 import qualified Text.PrettyPrint as PP
@@ -243,6 +244,46 @@ tests = Tasty.testGroup "LLVM pretty-printing output tests"
       --------
       |]
 
+  , testCase "Positive Infinity (float)" $
+    assertEqLines
+      (ppToText $ ppLLVM37 ppValue (ValFloat (castWord32ToFloat 0x7F800000)))
+      "0x7f800000"
+
+  , testCase "Negative Infinity (float)" $
+    assertEqLines
+      (ppToText $ ppLLVM37 ppValue (ValFloat (castWord32ToFloat 0xFF800000)))
+      "0xff800000"
+
+  , testCase "NaN 1 (float)" $
+    assertEqLines
+      (ppToText $ ppLLVM37 ppValue (ValFloat (castWord32ToFloat 0x7FC00000)))
+      "0x7fc00000"
+
+  , testCase "NaN 2 (float)" $
+    assertEqLines
+      (ppToText $ ppLLVM37 ppValue (ValFloat (castWord32ToFloat 0x7FD00000)))
+      "0x7fd00000"
+
+  , testCase "Positive Infinity (double)" $
+    assertEqLines
+      (ppToText $ ppLLVM37 ppValue (ValDouble (castWord64ToDouble 0x7FF0000000000000)))
+      "0x7ff0000000000000"
+
+  , testCase "Negative Infinity (double)" $
+    assertEqLines
+      (ppToText $ ppLLVM37 ppValue (ValDouble (castWord64ToDouble 0xFFF0000000000000)))
+      "0xfff0000000000000"
+
+  , testCase "NaN 1 (double)" $
+    assertEqLines
+      (ppToText $ ppLLVM37 ppValue (ValDouble (castWord64ToDouble 0x7FFC000000000000)))
+      "0x7ffc000000000000"
+
+  , testCase "NaN 2 (double)" $
+    assertEqLines
+      (ppToText $ ppLLVM37 ppValue (ValDouble (castWord64ToDouble 0x7FFD000000000000)))
+      "0x7ffd000000000000"
+
   ]
 
 ----------------------------------------------------------------------