diff --git a/CHANGES.md b/CHANGES.md --- a/CHANGES.md +++ b/CHANGES.md @@ -1,13 +1,13 @@ * Hackage: * GitHub: -* Latest Hackage released version: 0.1, 2017-01-14 +* Latest Hackage released version: 0.2, 2017-01-14 +### Version 0.2, 2017-01-14 + + * Support for parsing nan/infinity values + * Make the printer compliant with printf %a modifier in C + ### Version 0.1, 2017-01-14 * First implementation. The quasiquoter and the pretty-printer are implemented. - - * NB. The pretty-printer is currently not 100% compatible with the %a modifier - of C printf function. While it will print correct values, it will not always - print the same string as C does. (Note that string representations are not - unique for hexadecimal floats, similar to the scientific notation.) diff --git a/Data/Numbers/FloatingHex.hs b/Data/Numbers/FloatingHex.hs --- a/Data/Numbers/FloatingHex.hs +++ b/Data/Numbers/FloatingHex.hs @@ -12,16 +12,29 @@ -- We slightly diverge from the standard and do not allow for the "floating-suffix," -- as the type inference of Haskell makes this unnecessary. ----------------------------------------------------------------------------- -module Data.Numbers.FloatingHex (hf, showHFloat) where +module Data.Numbers.FloatingHex (hf, readHFloat, showHFloat) where import Data.Char (toLower) import Data.Ratio ((%)) -import Numeric (showHex) +import Numeric (showHex, floatToDigits) import qualified Language.Haskell.TH.Syntax as TH import Language.Haskell.TH.Quote --- | Turn a hexadecimal float to an internal double, if parseable. +-- | Read a float in hexadecimal binary format. Supports negative numbers, and nan/infinity as well. +-- For regular usage, the quasiquoter (`hf`) should be employed. But this function can be handy for +-- programmatic interfaces. +readHFloat :: RealFloat a => String -> Maybe a +readHFloat = cvt + where cvt ('-' : cs) = ((-1) *) `fmap` go cs + cvt cs = go cs + + go "NaN" = Just $ 0/0 + go "Infinity" = Just $ 1/0 + go cs = (fromRational . toRational) `fmap` parseHexFloat cs + +-- | Turn a hexadecimal float to an internal double, if parseable. Does not support the leading +-- sign bit. parseHexFloat :: String -> Maybe Double parseHexFloat = go0 . map toLower where go0 ('0':'x':rest) = go1 rest @@ -84,28 +97,34 @@ Just d -> return (TH.LitP (TH.RationalL (toRational d))) Nothing -> fail $ "Invalid hexadecimal floating point number: |" ++ s ++ "|" --- | Show a floating-point value in the hexadecimal format. --- --- NB. While this function will print a faithful (i.e., correct) value, it is --- not 100% compatible with the @%a@ modifier as found in the C's printf implementation. +-- | Show a floating-point value in the hexadecimal format, similar to the @%a@ modifier in C's printf. -- -- >>> showHFloat (212.21 :: Double) "" -- "0x1.a86b851eb851fp7" -- >>> showHFloat (-12.76 :: Float) "" --- "-0xc.c28f6p0" +-- "-0x1.9851ecp3" +-- >>> showHFloat (-0 :: Double) "" +-- "-0x0p+0" showHFloat :: RealFloat a => a -> ShowS -showHFloat x - | isNaN x = showString "nan" - | isInfinite x = showString $ if x > 0 then "+inf" else "-inf" - | isNegativeZero x = showString "-0x0p1" - | x < 0 = showString $ "-0x" ++ body - | True = showString $ "0x" ++ body - where (m, n) = decodeFloat (abs x) - pre = showHex m "" - (pre', l) = case pre of - "" -> error $ "impossible happened! " ++ show (pre, m) - (f:p) -> (f : trim p, length p) - trim s = case dropWhile (== '0') (reverse s) of - "" -> "" - t -> "." ++ reverse t - body = pre' ++ "p" ++ show (n + 4 * l) +showHFloat = showString . fmt + where fmt x | isNaN x = "NaN" + | isInfinite x = (if x < 0 then "-" else "") ++ "Infinity" + | x < 0 || isNegativeZero x = '-' : cvt (-x) + | True = cvt x + + cvt x + | x == 0 = "0x0p+0" + | True = case floatToDigits 2 x of + r@([], _) -> error $ "Impossible happened: showHFloat: " ++ show r + (d:ds, e) -> "0x" ++ show d ++ frac ds ++ "p" ++ show (e-1) + + -- Given binary digits, convert them to hex in blocks of 4 + -- Special case: If all 0's, just drop it. + frac digits + | all (== 0) digits = "" + | True = "." ++ hex digits + where hex ds + | null ds = "" + | length ds < 4 = hex (take 4 (ds ++ repeat 0)) + | True = let (d, r) = splitAt 4 ds in hexDigit d ++ hex r + hexDigit d = showHex (foldl (\a b -> 2*a+b) 0 d) "" diff --git a/FloatingHex.cabal b/FloatingHex.cabal --- a/FloatingHex.cabal +++ b/FloatingHex.cabal @@ -1,5 +1,5 @@ Name: FloatingHex -Version: 0.1 +Version: 0.2 Synopsis: Read and write hexadecimal floating point numbers Description: Read and write hexadecimal floating point numbers. Provides a quasiquoter for entering hex-float literals, and a function for printing them in hexadecimal. @@ -16,7 +16,7 @@ Copyright: Levent Erkok Category: Tools Build-type: Simple -Cabal-version: >= 1.10 +Cabal-version: >= 1.14 Extra-Source-Files: INSTALL, README.md, COPYRIGHT, CHANGES.md source-repository head diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -10,14 +10,14 @@ as the type inference of Haskell makes this unnecessary. Some examples are: ``` - 0x1p+1 - 0x1p+8 - 0x1.b7p-1 - 0x1.fffffffffffffp+1023 - 0X1.921FB4D12D84AP-1 + [hf|0x1p+1|] + [hf|0x1p+8|] + [hf|0x1.b7p-1|] + [hf|0x1.fffffffffffffp+1023|] + [hf|0X1.921FB4D12D84AP-1|] ``` -This format allows for concise and precise string representation for floating point numbers. +This format allows for concise and precise string representation for floating point numbers. Note that you need the `QuasiQuotes` extension of GHC to be able to write these literals. ## Example