diff --git a/llvm-pretty.cabal b/llvm-pretty.cabal index 85ce328..3191fd7 100644 --- a/llvm-pretty.cabal +++ b/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, diff --git a/src/Text/LLVM/PP.hs b/src/Text/LLVM/PP.hs index c0e2316..5690eb3 100644 --- a/src/Text/LLVM/PP.hs +++ b/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 diff --git a/test/Output.hs b/test/Output.hs index 81701ad..ee5578a 100644 --- a/test/Output.hs +++ b/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" + ] ----------------------------------------------------------------------