{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Numeric.Rounded.Hardware.Internal.Show where
import           Data.Bifunctor (first)
import           Data.Bits
import           Data.Char (intToDigit)
import           Numeric.Floating.IEEE.Internal (countTrailingZerosInteger)
import           Numeric.Rounded.Hardware.Internal.Rounding

-- $setup
-- >>> import Data.Int

-- ratToDigitsRn :: RoundingMode -> Int -> Int -> Rational -> ([Int], Int)

-- binaryFloatToDecimalDigitsRn _ prec x = ([d1,d2,...,dn], e)
-- 0 <= n <= prec + 1, x = 0.d1d2...dn * (10^^e) up to rounding
-- 0 <= di < 10
-- |
-- >>> binaryFloatToDecimalDigitsRn ToNearest 3 (0.125 :: Double)
-- ([1,2,5],0)
-- >>> binaryFloatToDecimalDigitsRn ToNearest 3 (12.5 :: Double)
-- ([1,2,5],2)
binaryFloatToDecimalDigitsRn :: forall a. RealFloat a
                             => RoundingMode -- ^ rounding mode
                             -> Int -- ^ prec
                             -> a -- ^ a non-negative number (zero, normal or subnormal)
                             -> ([Int], Int)
binaryFloatToDecimalDigitsRn :: RoundingMode -> Int -> a -> ([Int], Int)
binaryFloatToDecimalDigitsRn _rm :: RoundingMode
_rm _prec :: Int
_prec 0 = ([], 0)
binaryFloatToDecimalDigitsRn _rm :: RoundingMode
_rm _prec :: Int
_prec x :: a
x | a -> Integer
forall a. RealFloat a => a -> Integer
floatRadix a
x Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
/= 2 = [Char] -> ([Int], Int)
forall a. HasCallStack => [Char] -> a
error "radix must be 2"
binaryFloatToDecimalDigitsRn rm :: RoundingMode
rm prec :: Int
prec x :: a
x =
  -- x > 0
  let m :: Integer
      n, d, e0 :: Int
      (m :: Integer
m,n :: Int
n) = a -> (Integer, Int)
forall a. RealFloat a => a -> (Integer, Int)
decodeFloat a
x
      d :: Int
d = a -> Int
forall a. RealFloat a => a -> Int
floatDigits a
x -- d=53 for Double
      -- x = m * 2^n, 2^(d-1) <= m < 2^d
      -- 2^(-1074) <= x < 2^1024
      -- => -1074-52=-1126 <= n < 1024-52=972

      e0 :: Int
e0 = a -> Int
forall a b. (RealFrac a, Integral b) => a -> b
floor (Int -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
d Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n) a -> a -> a
forall a. Num a => a -> a -> a
* a -> a -> a
forall a. Floating a => a -> a -> a
logBase 10 2 :: a) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
prec
      -- TODO: precision of logBase 10 2?
      -- TODO: Use rational approximation for logBase 10 2?

      s, t :: Integer
      (s :: Integer
s,t :: Integer
t) | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 0,       0 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
e0 = (Integer
m,     2Integer -> Int -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^(-Int
n) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* 10Integer -> Int -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^Int
e0)
            | {- n >= 0 -} 0 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
e0 = (Integer
m Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* 2Integer -> Int -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^Int
n,        10Integer -> Int -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^Int
e0)
            | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 0   {- e0 < 0 -} = (Integer
m Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* 10Integer -> Int -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^(-Int
e0),  2Integer -> Int -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^(-Int
n))
            | Bool
otherwise            = (Integer
m Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* 2Integer -> Int -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^Int
n Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* 10Integer -> Int -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^(-Int
e0), 1)
      -- s/t = m * 2^n * 10^(-e0) = x * 10^(-e0)

      q, r :: Integer
      (q :: Integer
q,r :: Integer
r) = Integer
s Integer -> Integer -> (Integer, Integer)
forall a. Integral a => a -> a -> (a, a)
`quotRem` Integer
t
      -- s = q * t + r
      -- 10^prec <= q + r/t < 2 * 10^(prec+1)

      q', r', t' :: Integer
      e' :: Int
      (q' :: Integer
q',r' :: Integer
r',t' :: Integer
t',e' :: Int
e') | 10Integer -> Int -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^(Int
precInt -> Int -> Int
forall a. Num a => a -> a -> a
+1) Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
q = case Integer
q Integer -> Integer -> (Integer, Integer)
forall a. Integral a => a -> a -> (a, a)
`quotRem` 10 of
                                           -- q = q''*10+r''
                                           -- s = (q''*10+r'')*t + r = q''*10*t+(r''*t+r)
                                           (q'' :: Integer
q'',r'' :: Integer
r'') -> (Integer
q'', Integer
r''Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
*Integer
tInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
+Integer
r, 10Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
*Integer
t, Int
e0Int -> Int -> Int
forall a. Num a => a -> a -> a
+1)
                    | Bool
otherwise = (Integer
q,Integer
r,Integer
t,Int
e0)
      -- 10^prec <= q' + r'/t' < 10^(prec+1), 0 <= r' < t'

      -- x = m*2^n
      --   = s/t * 10^^(e0)
      --   = (q + r/t) * 10^^(e0)
      --   = (q' + r'/t') * 10^^e'
  in if Integer
r' Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== 0
     then
       -- exact
       Int -> Integer -> ([Int], Int)
loop0 Int
e' Integer
q'
     else
       -- inexact
       case RoundingMode
rm of
         TowardNegInf -> Int -> Integer -> ([Int], Int)
loop0 Int
e' Integer
q'
         TowardZero   -> Int -> Integer -> ([Int], Int)
loop0 Int
e' Integer
q'
         TowardInf    -> Int -> Integer -> ([Int], Int)
loop0 Int
e' (Integer
q' Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ 1)
         ToNearest -> case Integer -> Integer -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (2 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
r') Integer
t' of
           LT -> Int -> Integer -> ([Int], Int)
loop0 Int
e' Integer
q'
           EQ | Integer -> Bool
forall a. Integral a => a -> Bool
even Integer
q' -> Int -> Integer -> ([Int], Int)
loop0 Int
e' Integer
q'
              | Bool
otherwise -> Int -> Integer -> ([Int], Int)
loop0 Int
e' (Integer
q' Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ 1)
           GT -> Int -> Integer -> ([Int], Int)
loop0 Int
e' (Integer
q' Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ 1)
  where
    -- loop0 e n: x = n * 10^(e-prec-1)
    loop0 :: Int -> Integer -> ([Int], Int)
    loop0 :: Int -> Integer -> ([Int], Int)
loop0 !Int
_ 0 = ([], 0) -- should not occur
    loop0 !Int
e a :: Integer
a = case Integer
a Integer -> Integer -> (Integer, Integer)
forall a. Integral a => a -> a -> (a, a)
`quotRem` 10 of
                   (q :: Integer
q,0) -> Int -> Integer -> ([Int], Int)
loop0 (Int
eInt -> Int -> Int
forall a. Num a => a -> a -> a
+1) Integer
q
                   (q :: Integer
q,r :: Integer
r) -> Int -> [Int] -> Integer -> ([Int], Int)
loop (Int
eInt -> Int -> Int
forall a. Num a => a -> a -> a
+1) [Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
r] Integer
q

    -- loop e acc a: (a + 0.<acc>)*10^(e-prec-1)
    loop :: Int -> [Int] -> Integer -> ([Int], Int)
    loop :: Int -> [Int] -> Integer -> ([Int], Int)
loop !Int
e acc :: [Int]
acc 0 = ([Int]
acc, Int
e)
    loop !Int
e acc :: [Int]
acc a :: Integer
a = case Integer
a Integer -> Integer -> (Integer, Integer)
forall a. Integral a => a -> a -> (a, a)
`quotRem` 10 of
                      (q :: Integer
q,r :: Integer
r) -> Int -> [Int] -> Integer -> ([Int], Int)
loop (Int
eInt -> Int -> Int
forall a. Num a => a -> a -> a
+1) (Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
r Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: [Int]
acc) Integer
q
{-# SPECIALIZE binaryFloatToDecimalDigitsRn :: RoundingMode -> Int -> Double -> ([Int], Int) #-}

-- binaryFloatToFixedDecimalDigitsRn _ prec x = [d1,d2,...,dn]
-- x = d1d2...dn * (10^^(-prec)) up to rounding
-- 0 <= di < 10
-- |
-- >>> binaryFloatToFixedDecimalDigitsRn ToNearest 3 (0.125 :: Double)
-- [1,2,5]
-- >>> binaryFloatToFixedDecimalDigitsRn ToNearest 3 (12.5 :: Double)
-- [1,2,5,0,0]
binaryFloatToFixedDecimalDigitsRn :: forall a. RealFloat a
                                  => RoundingMode -- ^ rounding mode
                                  -> Int -- ^ prec
                                  -> a -- ^ a non-negative number (zero, normal or subnormal)
                                  -> [Int]
binaryFloatToFixedDecimalDigitsRn :: RoundingMode -> Int -> a -> [Int]
binaryFloatToFixedDecimalDigitsRn _rm :: RoundingMode
_rm _prec :: Int
_prec x :: a
x | a -> Integer
forall a. RealFloat a => a -> Integer
floatRadix a
x Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
/= 2 = [Char] -> [Int]
forall a. HasCallStack => [Char] -> a
error "radix must be 2"
binaryFloatToFixedDecimalDigitsRn rm :: RoundingMode
rm prec :: Int
prec x :: a
x =
  let m, s, t, q, r :: Integer
      e :: Int
      (m :: Integer
m,e :: Int
e) = a -> (Integer, Int)
forall a. RealFloat a => a -> (Integer, Int)
decodeFloat a
x -- x = m*2^e
      (s :: Integer
s,t :: Integer
t) | Int
prec Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= 0, Int
e Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
prec Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= 0     = (Integer
m Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* 2Integer -> Int -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^(Int
eInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
prec) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* 5Integer -> Int -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^Int
prec, 1)
            | Int
prec Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= 0 {- e + prec < 0 -} = (Integer
m Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* 5Integer -> Int -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^Int
prec, 2Integer -> Int -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^(-Int
eInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
prec))
            | {- prec < 0 -} Int
e Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
prec Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= 0 = (Integer
m Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* 2Integer -> Int -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^(Int
eInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
prec), 5Integer -> Int -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^(-Int
prec))
            | Bool
otherwise {- prec < 0, e + prec < 0 -} = (Integer
m, 2Integer -> Int -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^(-Int
eInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
prec) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* 5Integer -> Int -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^(-Int
prec))
      -- x*10^^prec = s/t
      (q :: Integer
q,r :: Integer
r) = Integer
s Integer -> Integer -> (Integer, Integer)
forall a. Integral a => a -> a -> (a, a)
`quotRem` Integer
t
  in if Integer
r Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== 0
     then
       -- exact
       [Int] -> Integer -> [Int]
loop [] Integer
q
     else
       -- inexact
       case RoundingMode
rm of
         TowardNegInf -> [Int] -> Integer -> [Int]
loop [] Integer
q
         TowardZero -> [Int] -> Integer -> [Int]
loop [] Integer
q
         TowardInf -> [Int] -> Integer -> [Int]
loop [] (Integer
q Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ 1)
         ToNearest -> case Integer -> Integer -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (2 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
r) Integer
t of
           LT -> [Int] -> Integer -> [Int]
loop [] Integer
q
           EQ | Integer -> Bool
forall a. Integral a => a -> Bool
even Integer
q -> [Int] -> Integer -> [Int]
loop [] Integer
q
              | Bool
otherwise -> [Int] -> Integer -> [Int]
loop [] (Integer
q Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ 1)
           GT -> [Int] -> Integer -> [Int]
loop [] (Integer
q Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ 1)
  where
    loop :: [Int] -> Integer -> [Int]
    loop :: [Int] -> Integer -> [Int]
loop acc :: [Int]
acc 0 = [Int]
acc
    loop acc :: [Int]
acc a :: Integer
a = case Integer
a Integer -> Integer -> (Integer, Integer)
forall a. Integral a => a -> a -> (a, a)
`quotRem` 10 of
                   (q :: Integer
q,r :: Integer
r) -> [Int] -> Integer -> [Int]
loop (Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
r Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: [Int]
acc) Integer
q
{-# SPECIALIZE binaryFloatToFixedDecimalDigitsRn :: RoundingMode -> Int -> Double -> [Int] #-}

-- binaryFloatToDecimalDigits x = ([d1,d2,...,dn], e)
-- n >= 0, x = 0.d1d2...dn * (10^^e)
-- 0 <= di < 10
-- |
-- >>> binaryFloatToDecimalDigits (0.125 :: Double)
-- ([1,2,5],0)
-- >>> binaryFloatToDecimalDigits (12.5 :: Double)
-- ([1,2,5],2)
binaryFloatToDecimalDigits :: RealFloat a
                           => a -- ^ a non-negative number (zero, normal or subnormal)
                           -> ([Int], Int)
binaryFloatToDecimalDigits :: a -> ([Int], Int)
binaryFloatToDecimalDigits 0 = ([], 0)
binaryFloatToDecimalDigits x :: a
x | a -> Integer
forall a. RealFloat a => a -> Integer
floatRadix a
x Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
/= 2 = [Char] -> ([Int], Int)
forall a. HasCallStack => [Char] -> a
error "radix must be 2"
binaryFloatToDecimalDigits x :: a
x =
  let m, m', m'' :: Integer
      n, z, n', e :: Int
      (m :: Integer
m,n :: Int
n) = a -> (Integer, Int)
forall a. RealFloat a => a -> (Integer, Int)
decodeFloat a
x -- x = m*2^n
      z :: Int
z = Integer -> Int
countTrailingZerosInteger Integer
m
      (m' :: Integer
m',n' :: Int
n') = (Integer
m Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
`shiftR` Int
z, Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
z)
      -- x = m*2^n = m'*2^n'
      (m'' :: Integer
m'',e :: Int
e) | Int
n' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 0 = (Integer
m' Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* 5Integer -> Int -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^(-Int
n'), Int
n') -- x = m'/2^(-n') = m'*5^(-n') / 10^(-n')
              | Bool
otherwise = (Integer
m' Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* 2Integer -> Int -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^Int
n', 0)
      -- x = m''*10^e, m'' is an integer, e <= 0
  in Int -> Integer -> ([Int], Int)
loop0 Int
e Integer
m''
  where
    -- x = a*10^e, a is an integer
    loop0 :: Int -> Integer -> ([Int], Int)
    loop0 :: Int -> Integer -> ([Int], Int)
loop0 !Int
_ 0 = ([0], 0) -- should not occur
    loop0 !Int
e a :: Integer
a = case Integer
a Integer -> Integer -> (Integer, Integer)
forall a. Integral a => a -> a -> (a, a)
`quotRem` 10 of
                   (q :: Integer
q,0) -> Int -> Integer -> ([Int], Int)
loop0 (Int
eInt -> Int -> Int
forall a. Num a => a -> a -> a
+1) Integer
q
                   (q :: Integer
q,r :: Integer
r) -> Int -> [Int] -> Integer -> ([Int], Int)
loop (Int
eInt -> Int -> Int
forall a. Num a => a -> a -> a
+1) [Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
r] Integer
q

    -- x = (a + 0.<acc>)*10^e, a is an integer
    loop :: Int -> [Int] -> Integer -> ([Int], Int)
    loop :: Int -> [Int] -> Integer -> ([Int], Int)
loop !Int
e acc :: [Int]
acc 0 = ([Int]
acc, Int
e)
    loop !Int
e acc :: [Int]
acc n :: Integer
n = case Integer
n Integer -> Integer -> (Integer, Integer)
forall a. Integral a => a -> a -> (a, a)
`quotRem` 10 of
                      (q :: Integer
q,r :: Integer
r) -> Int -> [Int] -> Integer -> ([Int], Int)
loop (Int
eInt -> Int -> Int
forall a. Num a => a -> a -> a
+1) (Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
r Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: [Int]
acc) Integer
q
{-# SPECIALIZE binaryFloatToDecimalDigits :: Double -> ([Int], Int) #-}

-- TODO: Maybe implement ByteString or Text versions

-- |
-- >>> showEFloatRn ToNearest (Just 0) (0 :: Double) ""
-- "0e0"
-- >>> showEFloatRn ToNearest Nothing (0 :: Double) ""
-- "0.0e0"
-- >>> showEFloatRn ToNearest Nothing (0.5 :: Double) ""
-- "5.0e-1"
showEFloatRn :: RealFloat a => RoundingMode -> Maybe Int -> a -> ShowS
showEFloatRn :: RoundingMode -> Maybe Int -> a -> ShowS
showEFloatRn r :: RoundingMode
r mprec :: Maybe Int
mprec x :: a
x
  | a -> Bool
forall a. RealFloat a => a -> Bool
isNaN a
x = [Char] -> ShowS
showString "NaN"
  | a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< 0 Bool -> Bool -> Bool
|| a -> Bool
forall a. RealFloat a => a -> Bool
isNegativeZero a
x = Char -> ShowS
showChar '-' ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RoundingMode -> Maybe Int -> a -> ShowS
forall a. RealFloat a => RoundingMode -> Maybe Int -> a -> ShowS
showEFloatRn (RoundingMode -> RoundingMode
oppositeRoundingMode RoundingMode
r) Maybe Int
mprec (-a
x)
  | a -> Bool
forall a. RealFloat a => a -> Bool
isInfinite a
x = [Char] -> ShowS
showString "Infinity"
  | Bool
otherwise = let (xs :: [Int]
xs,e :: Int
e) = case Maybe Int
mprec of
                      Nothing -> a -> ([Int], Int)
forall a. RealFloat a => a -> ([Int], Int)
binaryFloatToDecimalDigits a
x
                      Just prec :: Int
prec -> let !prec' :: Int
prec' = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
prec 0
                                   in ([Int] -> [Int]) -> ([Int], Int) -> ([Int], Int)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (Int -> [Int] -> [Int]
padRight0 (Int
prec' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1)) (([Int], Int) -> ([Int], Int)) -> ([Int], Int) -> ([Int], Int)
forall a b. (a -> b) -> a -> b
$ RoundingMode -> Int -> a -> ([Int], Int)
forall a. RealFloat a => RoundingMode -> Int -> a -> ([Int], Int)
binaryFloatToDecimalDigitsRn RoundingMode
r Int
prec' a
x
                    e' :: Int
e' | (Int -> Bool) -> [Int] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 0) [Int]
xs = 0
                       | Bool
otherwise = Int
e Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1
                in case [Int]
xs of
                     [] -> [Char] -> ShowS
showString "0.0e0" -- mprec must be `Nothing`
                     [0] -> [Char] -> ShowS
showString "0e0" -- mprec must be `Just 0`
                     [d :: Int
d] -> case Maybe Int
mprec of
                              Nothing -> [Char] -> ShowS
showString ([Char] -> ShowS) -> [Char] -> ShowS
forall a b. (a -> b) -> a -> b
$ Int -> Char
intToDigit Int
d Char -> ShowS
forall a. a -> [a] -> [a]
: '.' Char -> ShowS
forall a. a -> [a] -> [a]
: '0' Char -> ShowS
forall a. a -> [a] -> [a]
: 'e' Char -> ShowS
forall a. a -> [a] -> [a]
: Int -> [Char]
forall a. Show a => a -> [Char]
show Int
e'
                              _ -> [Char] -> ShowS
showString ([Char] -> ShowS) -> [Char] -> ShowS
forall a b. (a -> b) -> a -> b
$ Int -> Char
intToDigit Int
d Char -> ShowS
forall a. a -> [a] -> [a]
: 'e' Char -> ShowS
forall a. a -> [a] -> [a]
: Int -> [Char]
forall a. Show a => a -> [Char]
show Int
e'
                     (d :: Int
d:ds :: [Int]
ds) -> [Char] -> ShowS
showString ([Char] -> ShowS) -> [Char] -> ShowS
forall a b. (a -> b) -> a -> b
$ (Int -> Char
intToDigit Int
d Char -> ShowS
forall a. a -> [a] -> [a]
: '.' Char -> ShowS
forall a. a -> [a] -> [a]
: (Int -> Char) -> [Int] -> [Char]
forall a b. (a -> b) -> [a] -> [b]
map Int -> Char
intToDigit [Int]
ds) [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ ('e' Char -> ShowS
forall a. a -> [a] -> [a]
: Int -> [Char]
forall a. Show a => a -> [Char]
show Int
e')
  where
    padRight0 :: Int -> [Int] -> [Int]
    padRight0 :: Int -> [Int] -> [Int]
padRight0 0 ys :: [Int]
ys      = [Int]
ys
    padRight0 !Int
n []     = Int -> Int -> [Int]
forall a. Int -> a -> [a]
replicate Int
n 0
    padRight0 !Int
n (y :: Int
y:ys :: [Int]
ys) = Int
y Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: Int -> [Int] -> [Int]
padRight0 (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1) [Int]
ys
{-# SPECIALIZE showEFloatRn :: RoundingMode -> Maybe Int -> Double -> ShowS #-}

-- |
-- >>> showFFloatRn ToNearest (Just 0) (0 :: Double) ""
-- "0"
-- >>> showFFloatRn ToNearest Nothing (0 :: Double) ""
-- "0.0"
-- >>> showFFloatRn ToNearest Nothing (-0 :: Double) ""
-- "-0.0"
-- >>> showFFloatRn ToNearest Nothing (-0.5 :: Double) ""
-- "-0.5"
showFFloatRn :: RealFloat a => RoundingMode -> Maybe Int -> a -> ShowS
showFFloatRn :: RoundingMode -> Maybe Int -> a -> ShowS
showFFloatRn r :: RoundingMode
r mprec :: Maybe Int
mprec x :: a
x
  | a -> Bool
forall a. RealFloat a => a -> Bool
isNaN a
x = [Char] -> ShowS
showString "NaN"
  | a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< 0 Bool -> Bool -> Bool
|| a -> Bool
forall a. RealFloat a => a -> Bool
isNegativeZero a
x = Char -> ShowS
showChar '-' ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RoundingMode -> Maybe Int -> a -> ShowS
forall a. RealFloat a => RoundingMode -> Maybe Int -> a -> ShowS
showFFloatRn (RoundingMode -> RoundingMode
oppositeRoundingMode RoundingMode
r) Maybe Int
mprec (-a
x)
  | a -> Bool
forall a. RealFloat a => a -> Bool
isInfinite a
x = [Char] -> ShowS
showString "Infinity"
  | Bool
otherwise = case Maybe Int
mprec of
                  Nothing -> let (xs :: [Int]
xs,e :: Int
e) = a -> ([Int], Int)
forall a. RealFloat a => a -> ([Int], Int)
binaryFloatToDecimalDigits a
x
                                 l :: Int
l = [Int] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int]
xs
                                 -- binaryFloatToDecimalDigits x = ([d1,d2,...,dl], e)
                                 -- x = 0.d1d2...dl * (10^^e)
                                 -- 0 <= di < 10
                             in if Int
e Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
l then
                                  -- d1d2...dl<replicate (e-l) '0'>.0
                                  if [Int] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Int]
xs then
                                    [Char] -> ShowS
showString "0.0"
                                  else
                                    [Char] -> ShowS
showString ((Int -> Char) -> [Int] -> [Char]
forall a b. (a -> b) -> [a] -> [b]
map Int -> Char
intToDigit [Int]
xs [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> Char -> [Char]
forall a. Int -> a -> [a]
replicate (Int
e Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
l) '0' [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ ".0")
                                else
                                  if Int
e Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 0 then -- 0 < e < l
                                    -- d1d2...d<e>.d<e+1>...dl
                                    if Int
l Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
e then-- null zs
                                      [Char] -> ShowS
showString ((Int -> Char) -> [Int] -> [Char]
forall a b. (a -> b) -> [a] -> [b]
map Int -> Char
intToDigit [Int]
xs [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ ".0")
                                    else
                                      let (ys :: [Int]
ys,zs :: [Int]
zs) = Int -> [Int] -> ([Int], [Int])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
e [Int]
xs
                                          ys' :: [Int]
ys' = if [Int] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Int]
ys then [0] else [Int]
ys
                                      in [Char] -> ShowS
showString ((Int -> Char) -> [Int] -> [Char]
forall a b. (a -> b) -> [a] -> [b]
map Int -> Char
intToDigit [Int]
ys' [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ "." [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ (Int -> Char) -> [Int] -> [Char]
forall a b. (a -> b) -> [a] -> [b]
map Int -> Char
intToDigit [Int]
zs)
                                  else -- e < 0
                                    -- 0.<replicate (-e) '0'>d1d2...dl
                                    [Char] -> ShowS
showString ("0." [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> Char -> [Char]
forall a. Int -> a -> [a]
replicate (-Int
e) '0' [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ (Int -> Char) -> [Int] -> [Char]
forall a b. (a -> b) -> [a] -> [b]
map Int -> Char
intToDigit [Int]
xs)
                  Just prec :: Int
prec -> let prec' :: Int
prec' = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
prec 0
                                   xs :: [Int]
xs = RoundingMode -> Int -> a -> [Int]
forall a. RealFloat a => RoundingMode -> Int -> a -> [Int]
binaryFloatToFixedDecimalDigitsRn RoundingMode
r Int
prec' a
x
                                   l :: Int
l = [Int] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int]
xs
                                   -- binaryFloatToFixedDecimalDigitsRn _ prec' x = [d1,d2,...,dl]
                                   -- x = d1d2...dl * (10^^(-prec')) up to rounding
                                   -- 0 <= di < 10
                               in if Int
prec' Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 0 then
                                    -- d1d2...dl or "0"
                                    if [Int] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Int]
xs then
                                      [Char] -> ShowS
showString "0"
                                    else
                                      [Char] -> ShowS
showString ([Char] -> ShowS) -> [Char] -> ShowS
forall a b. (a -> b) -> a -> b
$ (Int -> Char) -> [Int] -> [Char]
forall a b. (a -> b) -> [a] -> [b]
map Int -> Char
intToDigit [Int]
xs
                                  else
                                    if Int
l Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
prec' then
                                      -- 0.<replicate (prec'-l) '0'>d1d2...dl
                                      [Char] -> ShowS
showString ([Char] -> ShowS) -> [Char] -> ShowS
forall a b. (a -> b) -> a -> b
$ "0." [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> Char -> [Char]
forall a. Int -> a -> [a]
replicate (Int
prec' Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
l) '0' [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ (Int -> Char) -> [Int] -> [Char]
forall a b. (a -> b) -> [a] -> [b]
map Int -> Char
intToDigit [Int]
xs
                                    else
                                      -- l > prec'
                                      -- d1d2...d<l-prec'>.d<l-prec'+1>...dl
                                      let (ys :: [Int]
ys,zs :: [Int]
zs) = Int -> [Int] -> ([Int], [Int])
forall a. Int -> [a] -> ([a], [a])
splitAt (Int
l Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
prec') [Int]
xs
                                          ys' :: [Int]
ys' = if [Int] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Int]
ys then [0] else [Int]
ys
                                      in [Char] -> ShowS
showString ([Char] -> ShowS) -> [Char] -> ShowS
forall a b. (a -> b) -> a -> b
$ (Int -> Char) -> [Int] -> [Char]
forall a b. (a -> b) -> [a] -> [b]
map Int -> Char
intToDigit [Int]
ys' [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ "." [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ (Int -> Char) -> [Int] -> [Char]
forall a b. (a -> b) -> [a] -> [b]
map Int -> Char
intToDigit [Int]
zs
{-# SPECIALIZE showFFloatRn :: RoundingMode -> Maybe Int -> Double -> ShowS #-}

showGFloatRn :: RealFloat a => RoundingMode -> Maybe Int -> a -> ShowS
showGFloatRn :: RoundingMode -> Maybe Int -> a -> ShowS
showGFloatRn r :: RoundingMode
r mprec :: Maybe Int
mprec x :: a
x | a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== 0 Bool -> Bool -> Bool
|| (0.1 a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a -> a
forall a. Num a => a -> a
abs a
x Bool -> Bool -> Bool
&& a -> a
forall a. Num a => a -> a
abs a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< 1e7) = RoundingMode -> Maybe Int -> a -> ShowS
forall a. RealFloat a => RoundingMode -> Maybe Int -> a -> ShowS
showFFloatRn RoundingMode
r Maybe Int
mprec a
x -- Note that 1%10 < toRational (0.1 :: Double)
                       | Bool
otherwise = RoundingMode -> Maybe Int -> a -> ShowS
forall a. RealFloat a => RoundingMode -> Maybe Int -> a -> ShowS
showEFloatRn RoundingMode
r Maybe Int
mprec a
x
{-# SPECIALIZE showGFloatRn :: RoundingMode -> Maybe Int -> Double -> ShowS #-}

{-
showFFloatAltRn :: RoundingMode -> Maybe Int -> Double -> ShowS
showGFloatAltRn :: RoundingMode -> Maybe Int -> Double -> ShowS
-- showFloat :: RoundingMode -> Double -> ShowS
-}