{-# 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 RoundingMode
_rm Int
_prec a
0 = ([], Int
0)
binaryFloatToDecimalDigitsRn RoundingMode
_rm Int
_prec a
x | a -> Integer
forall a. RealFloat a => a -> Integer
floatRadix a
x Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
/= Integer
2 = [Char] -> ([Int], Int)
forall a. HasCallStack => [Char] -> a
error [Char]
"radix must be 2"
binaryFloatToDecimalDigitsRn RoundingMode
rm Int
prec a
x =
  -- x > 0
  let m :: Integer
      n, d, e0 :: Int
      (Integer
m,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
- Int
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 a
10 a
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
      (Integer
s,Integer
t) | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0,       Int
0 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
e0 = (Integer
m,     Integer
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
* Integer
10Integer -> Int -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^Int
e0)
            | {- n >= 0 -} Int
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
* Integer
2Integer -> Int -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^Int
n,        Integer
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
< Int
0   {- e0 < 0 -} = (Integer
m Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
10Integer -> Int -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^(-Int
e0),  Integer
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
* Integer
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
* Integer
10Integer -> Int -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^(-Int
e0), Integer
1)
      -- s/t = m * 2^n * 10^(-e0) = x * 10^(-e0)

      q, r :: Integer
      (Integer
q,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
      (Integer
q',Integer
r',Integer
t',Int
e') | Integer
10Integer -> Int -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^(Int
precInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
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` Integer
10 of
                                           -- q = q''*10+r''
                                           -- s = (q''*10+r'')*t + r = q''*10*t+(r''*t+r)
                                           (Integer
q'',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, Integer
10Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
*Integer
t, Int
e0Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
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
== Integer
0
     then
       -- exact
       Int -> Integer -> ([Int], Int)
loop0 Int
e' Integer
q'
     else
       -- inexact
       case RoundingMode
rm of
         RoundingMode
TowardNegInf -> Int -> Integer -> ([Int], Int)
loop0 Int
e' Integer
q'
         RoundingMode
TowardZero   -> Int -> Integer -> ([Int], Int)
loop0 Int
e' Integer
q'
         RoundingMode
TowardInf    -> Int -> Integer -> ([Int], Int)
loop0 Int
e' (Integer
q' Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
1)
         RoundingMode
ToNearest -> case Integer -> Integer -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Integer
2 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
r') Integer
t' of
           Ordering
LT -> Int -> Integer -> ([Int], Int)
loop0 Int
e' Integer
q'
           Ordering
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
+ Integer
1)
           Ordering
GT -> Int -> Integer -> ([Int], Int)
loop0 Int
e' (Integer
q' Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
1)
  where
    -- loop0 e n: x = n * 10^(e-prec-1)
    loop0 :: Int -> Integer -> ([Int], Int)
    loop0 :: Int -> Integer -> ([Int], Int)
loop0 !Int
_ Integer
0 = ([], Int
0) -- should not occur
    loop0 !Int
e Integer
a = case Integer
a Integer -> Integer -> (Integer, Integer)
forall a. Integral a => a -> a -> (a, a)
`quotRem` Integer
10 of
                   (Integer
q,Integer
0) -> Int -> Integer -> ([Int], Int)
loop0 (Int
eInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Integer
q
                   (Integer
q,Integer
r) -> Int -> [Int] -> Integer -> ([Int], Int)
loop (Int
eInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
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 [Int]
acc Integer
0 = ([Int]
acc, Int
e)
    loop !Int
e [Int]
acc Integer
a = case Integer
a Integer -> Integer -> (Integer, Integer)
forall a. Integral a => a -> a -> (a, a)
`quotRem` Integer
10 of
                      (Integer
q,Integer
r) -> Int -> [Int] -> Integer -> ([Int], Int)
loop (Int
eInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
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 RoundingMode
_rm Int
_prec a
x | a -> Integer
forall a. RealFloat a => a -> Integer
floatRadix a
x Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
/= Integer
2 = [Char] -> [Int]
forall a. HasCallStack => [Char] -> a
error [Char]
"radix must be 2"
binaryFloatToFixedDecimalDigitsRn RoundingMode
rm Int
prec a
x =
  let m, s, t, q, r :: Integer
      e :: Int
      (Integer
m,Int
e) = a -> (Integer, Int)
forall a. RealFloat a => a -> (Integer, Int)
decodeFloat a
x -- x = m*2^e
      (Integer
s,Integer
t) | Int
prec Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
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
>= Int
0     = (Integer
m Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
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
* Integer
5Integer -> Int -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^Int
prec, Integer
1)
            | Int
prec Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 {- e + prec < 0 -} = (Integer
m Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
5Integer -> Int -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^Int
prec, Integer
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
>= Int
0 = (Integer
m Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
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
5Integer -> Int -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^(-Int
prec))
            | Bool
otherwise {- prec < 0, e + prec < 0 -} = (Integer
m, Integer
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
* Integer
5Integer -> Int -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^(-Int
prec))
      -- x*10^^prec = s/t
      (Integer
q,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
== Integer
0
     then
       -- exact
       [Int] -> Integer -> [Int]
loop [] Integer
q
     else
       -- inexact
       case RoundingMode
rm of
         RoundingMode
TowardNegInf -> [Int] -> Integer -> [Int]
loop [] Integer
q
         RoundingMode
TowardZero -> [Int] -> Integer -> [Int]
loop [] Integer
q
         RoundingMode
TowardInf -> [Int] -> Integer -> [Int]
loop [] (Integer
q Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
1)
         RoundingMode
ToNearest -> case Integer -> Integer -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Integer
2 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
r) Integer
t of
           Ordering
LT -> [Int] -> Integer -> [Int]
loop [] Integer
q
           Ordering
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
+ Integer
1)
           Ordering
GT -> [Int] -> Integer -> [Int]
loop [] (Integer
q Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
1)
  where
    loop :: [Int] -> Integer -> [Int]
    loop :: [Int] -> Integer -> [Int]
loop [Int]
acc Integer
0 = [Int]
acc
    loop [Int]
acc Integer
a = case Integer
a Integer -> Integer -> (Integer, Integer)
forall a. Integral a => a -> a -> (a, a)
`quotRem` Integer
10 of
                   (Integer
q,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 a
0 = ([], Int
0)
binaryFloatToDecimalDigits a
x | a -> Integer
forall a. RealFloat a => a -> Integer
floatRadix a
x Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
/= Integer
2 = [Char] -> ([Int], Int)
forall a. HasCallStack => [Char] -> a
error [Char]
"radix must be 2"
binaryFloatToDecimalDigits a
x =
  let m, m', m'' :: Integer
      n, z, n', e :: Int
      (Integer
m,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
      (Integer
m',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'
      (Integer
m'',Int
e) | Int
n' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = (Integer
m' Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
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
* Integer
2Integer -> Int -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^Int
n', Int
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
_ Integer
0 = ([Int
0], Int
0) -- should not occur
    loop0 !Int
e Integer
a = case Integer
a Integer -> Integer -> (Integer, Integer)
forall a. Integral a => a -> a -> (a, a)
`quotRem` Integer
10 of
                   (Integer
q,Integer
0) -> Int -> Integer -> ([Int], Int)
loop0 (Int
eInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Integer
q
                   (Integer
q,Integer
r) -> Int -> [Int] -> Integer -> ([Int], Int)
loop (Int
eInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
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 [Int]
acc Integer
0 = ([Int]
acc, Int
e)
    loop !Int
e [Int]
acc Integer
n = case Integer
n Integer -> Integer -> (Integer, Integer)
forall a. Integral a => a -> a -> (a, a)
`quotRem` Integer
10 of
                      (Integer
q,Integer
r) -> Int -> [Int] -> Integer -> ([Int], Int)
loop (Int
eInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
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 RoundingMode
r Maybe Int
mprec a
x
  | a -> Bool
forall a. RealFloat a => a -> Bool
isNaN a
x = [Char] -> ShowS
showString [Char]
"NaN"
  | a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
0 Bool -> Bool -> Bool
|| a -> Bool
forall a. RealFloat a => a -> Bool
isNegativeZero a
x = Char -> ShowS
showChar Char
'-' 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 [Char]
"Infinity"
  | Bool
otherwise = let ([Int]
xs,Int
e) = case Maybe Int
mprec of
                      Maybe Int
Nothing -> a -> ([Int], Int)
forall a. RealFloat a => a -> ([Int], Int)
binaryFloatToDecimalDigits a
x
                      Just Int
prec -> let !prec' :: Int
prec' = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
prec Int
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
+ Int
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
== Int
0) [Int]
xs = Int
0
                       | Bool
otherwise = Int
e Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
                in case [Int]
xs of
                     [] -> [Char] -> ShowS
showString [Char]
"0.0e0" -- mprec must be `Nothing`
                     [Int
0] -> [Char] -> ShowS
showString [Char]
"0e0" -- mprec must be `Just 0`
                     [Int
d] -> case Maybe Int
mprec of
                              Maybe Int
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
'.' Char -> ShowS
forall a. a -> [a] -> [a]
: Char
'0' Char -> ShowS
forall a. a -> [a] -> [a]
: Char
'e' Char -> ShowS
forall a. a -> [a] -> [a]
: Int -> [Char]
forall a. Show a => a -> [Char]
show Int
e'
                              Maybe Int
_ -> [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
'e' Char -> ShowS
forall a. a -> [a] -> [a]
: Int -> [Char]
forall a. Show a => a -> [Char]
show Int
e'
                     (Int
d:[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
'.' 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]
++ (Char
'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 Int
0 [Int]
ys      = [Int]
ys
    padRight0 !Int
n []     = Int -> Int -> [Int]
forall a. Int -> a -> [a]
replicate Int
n Int
0
    padRight0 !Int
n (Int
y:[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
- Int
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 RoundingMode
r Maybe Int
mprec a
x
  | a -> Bool
forall a. RealFloat a => a -> Bool
isNaN a
x = [Char] -> ShowS
showString [Char]
"NaN"
  | a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
0 Bool -> Bool -> Bool
|| a -> Bool
forall a. RealFloat a => a -> Bool
isNegativeZero a
x = Char -> ShowS
showChar Char
'-' 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 [Char]
"Infinity"
  | Bool
otherwise = case Maybe Int
mprec of
                  Maybe Int
Nothing -> let ([Int]
xs,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 [Char]
"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) Char
'0' [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
".0")
                                else
                                  if Int
e Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
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]
++ [Char]
".0")
                                    else
                                      let ([Int]
ys,[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 [Int
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]
"." [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 ([Char]
"0." [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> Char -> [Char]
forall a. Int -> a -> [a]
replicate (-Int
e) Char
'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 Int
prec -> let prec' :: Int
prec' = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
prec Int
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
== Int
0 then
                                    -- d1d2...dl or "0"
                                    if [Int] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Int]
xs then
                                      [Char] -> ShowS
showString [Char]
"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
$ [Char]
"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) Char
'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 ([Int]
ys,[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 [Int
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]
"." [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 RoundingMode
r Maybe Int
mprec a
x | a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
0 Bool -> Bool -> Bool
|| (a
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
< a
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
-}