Implement the basics of hex floating point literals

Implement hexadecmial floating point literals.

The digits of the mantissa are hexadecimal.
The exponent is written in base 10, and the base for the exponentiation is 2.
Hexadecimal literals look a lot like ordinary decimal literals, except that
they use hexadecmial digits, and the exponent is written using `p` rather than `e`.

The specification of the feature is available here:
https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0004-hexFloats.rst

For a discussion of the various choices:
https://github.com/ghc-proposals/ghc-proposals/pull/37

Reviewers: mpickering, goldfire, austin, bgamari, hvr

Reviewed By: bgamari

Subscribers: mpickering, thomie

Differential Revision: https://phabricator.haskell.org/D3066

1 files changed, 48 insertions, 0 deletions

diff --git a/libraries/base/Numeric.hs b/libraries/base/Numeric.hs
index e040c455d6..00e5f674de 100644
--- a/libraries/base/Numeric.hs
+++ b/libraries/base/Numeric.hs
@@ -33,6 +33,7 @@ module Numeric (
         showFFloatAlt,
         showGFloatAlt,
         showFloat,
+        showHFloat,
 
         floatToDigits,
 
@@ -69,6 +70,7 @@ import GHC.Show
 import Text.ParserCombinators.ReadP( ReadP, readP_to_S, pfail )
 import qualified Text.Read.Lex as L
 
+
 -- -----------------------------------------------------------------------------
 -- Reading
 
@@ -213,6 +215,52 @@ showGFloatAlt    :: (RealFloat a) => Maybe Int -> a -> ShowS
 showFFloatAlt d x =  showString (formatRealFloatAlt FFFixed d True x)
 showGFloatAlt d x =  showString (formatRealFloatAlt FFGeneric d True x)
 
+{- | Show a floating-point value in the hexadecimal format,
+similar to the @%a@ specifier in C's printf.
+
+  >>> showHFloat (212.21 :: Double) ""
+  "0x1.a86b851eb851fp7"
+  >>> showHFloat (-12.76 :: Float) ""
+  "-0x1.9851ecp3"
+  >>> showHFloat (-0 :: Double) ""
+  "-0x0p+0"
+-}
+showHFloat :: RealFloat a => a -> ShowS
+showHFloat = showString . fmt
+  where
+  fmt x
+    | isNaN x                   = "NaN"
+    | isInfinite x              = (if x < 0 then "-" else "") ++ "Infinity"
+    | x < 0 || isNegativeZero x = '-' : cvt (-x)
+    | otherwise                 = cvt x
+
+  cvt x
+    | x == 0 = "0x0p+0"
+    | otherwise =
+      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
+    | allZ digits = ""
+    | otherwise   = "." ++ hex digits
+    where
+    hex ds =
+      case ds of
+        []                -> ""
+        [a]               -> hexDigit a 0 0 0 ""
+        [a,b]             -> hexDigit a b 0 0 ""
+        [a,b,c]           -> hexDigit a b c 0 ""
+        a : b : c : d : r -> hexDigit a b c d (hex r)
+
+  hexDigit a b c d = showHex (8*a + 4*b + 2*c + d)
+
+  allZ xs = case xs of
+              x : more -> x == 0 && allZ more
+              []       -> True
+
 -- ---------------------------------------------------------------------------
 -- Integer printing functions