{-# LANGUAGE CPP, OverloadedStrings #-}
{-# LANGUAGE Trustworthy #-}
module Data.Text.Lazy.Builder.RealFloat
(
FPFormat(..)
, realFloat
, formatRealFloat
) where
import Data.Array.Base (unsafeAt)
import Data.Array.IArray
import Data.Text.Internal.Builder.Functions ((<>), i2d)
import Data.Text.Lazy.Builder.Int (decimal)
import Data.Text.Internal.Builder.RealFloat.Functions (roundTo)
import Data.Text.Lazy.Builder
import qualified Data.Text as T
#if MIN_VERSION_base(4,11,0)
import Prelude hiding ((<>))
#endif
data FPFormat = Exponent
| Fixed
| Generic
deriving (Int -> FPFormat
FPFormat -> Int
FPFormat -> [FPFormat]
FPFormat -> FPFormat
FPFormat -> FPFormat -> [FPFormat]
FPFormat -> FPFormat -> FPFormat -> [FPFormat]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: FPFormat -> FPFormat -> FPFormat -> [FPFormat]
$cenumFromThenTo :: FPFormat -> FPFormat -> FPFormat -> [FPFormat]
enumFromTo :: FPFormat -> FPFormat -> [FPFormat]
$cenumFromTo :: FPFormat -> FPFormat -> [FPFormat]
enumFromThen :: FPFormat -> FPFormat -> [FPFormat]
$cenumFromThen :: FPFormat -> FPFormat -> [FPFormat]
enumFrom :: FPFormat -> [FPFormat]
$cenumFrom :: FPFormat -> [FPFormat]
fromEnum :: FPFormat -> Int
$cfromEnum :: FPFormat -> Int
toEnum :: Int -> FPFormat
$ctoEnum :: Int -> FPFormat
pred :: FPFormat -> FPFormat
$cpred :: FPFormat -> FPFormat
succ :: FPFormat -> FPFormat
$csucc :: FPFormat -> FPFormat
Enum, ReadPrec [FPFormat]
ReadPrec FPFormat
Int -> ReadS FPFormat
ReadS [FPFormat]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [FPFormat]
$creadListPrec :: ReadPrec [FPFormat]
readPrec :: ReadPrec FPFormat
$creadPrec :: ReadPrec FPFormat
readList :: ReadS [FPFormat]
$creadList :: ReadS [FPFormat]
readsPrec :: Int -> ReadS FPFormat
$creadsPrec :: Int -> ReadS FPFormat
Read, Int -> FPFormat -> ShowS
[FPFormat] -> ShowS
FPFormat -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [FPFormat] -> ShowS
$cshowList :: [FPFormat] -> ShowS
show :: FPFormat -> [Char]
$cshow :: FPFormat -> [Char]
showsPrec :: Int -> FPFormat -> ShowS
$cshowsPrec :: Int -> FPFormat -> ShowS
Show)
realFloat :: (RealFloat a) => a -> Builder
{-# SPECIALIZE realFloat :: Float -> Builder #-}
{-# SPECIALIZE realFloat :: Double -> Builder #-}
realFloat :: forall a. RealFloat a => a -> Builder
realFloat a
x = forall a. RealFloat a => FPFormat -> Maybe Int -> a -> Builder
formatRealFloat FPFormat
Generic forall a. Maybe a
Nothing a
x
formatRealFloat :: (RealFloat a) =>
FPFormat
-> Maybe Int
-> a
-> Builder
{-# SPECIALIZE formatRealFloat :: FPFormat -> Maybe Int -> Float -> Builder #-}
{-# SPECIALIZE formatRealFloat :: FPFormat -> Maybe Int -> Double -> Builder #-}
formatRealFloat :: forall a. RealFloat a => FPFormat -> Maybe Int -> a -> Builder
formatRealFloat FPFormat
fmt Maybe Int
decs a
x
| forall a. RealFloat a => a -> Bool
isNaN a
x = Builder
"NaN"
| forall a. RealFloat a => a -> Bool
isInfinite a
x = if a
x forall a. Ord a => a -> a -> Bool
< a
0 then Builder
"-Infinity" else Builder
"Infinity"
| a
x forall a. Ord a => a -> a -> Bool
< a
0 Bool -> Bool -> Bool
|| forall a. RealFloat a => a -> Bool
isNegativeZero a
x = Char -> Builder
singleton Char
'-' Builder -> Builder -> Builder
<> FPFormat -> ([Int], Int) -> Builder
doFmt FPFormat
fmt (forall a. RealFloat a => a -> ([Int], Int)
floatToDigits (-a
x))
| Bool
otherwise = FPFormat -> ([Int], Int) -> Builder
doFmt FPFormat
fmt (forall a. RealFloat a => a -> ([Int], Int)
floatToDigits a
x)
where
doFmt :: FPFormat -> ([Int], Int) -> Builder
doFmt FPFormat
format ([Int]
is, Int
e) =
let ds :: [Char]
ds = forall a b. (a -> b) -> [a] -> [b]
map Int -> Char
i2d [Int]
is in
case FPFormat
format of
FPFormat
Generic ->
FPFormat -> ([Int], Int) -> Builder
doFmt (if Int
e forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
e forall a. Ord a => a -> a -> Bool
> Int
7 then FPFormat
Exponent else FPFormat
Fixed)
([Int]
is,Int
e)
FPFormat
Exponent ->
case Maybe Int
decs of
Maybe Int
Nothing ->
let show_e' :: Builder
show_e' = forall a. Integral a => a -> Builder
decimal (Int
eforall a. Num a => a -> a -> a
-Int
1) in
case [Char]
ds of
[Char]
"0" -> Builder
"0.0e0"
[Char
d] -> Char -> Builder
singleton Char
d Builder -> Builder -> Builder
<> Builder
".0e" Builder -> Builder -> Builder
<> Builder
show_e'
(Char
d:[Char]
ds') -> Char -> Builder
singleton Char
d Builder -> Builder -> Builder
<> Char -> Builder
singleton Char
'.' Builder -> Builder -> Builder
<> [Char] -> Builder
fromString [Char]
ds' Builder -> Builder -> Builder
<> Char -> Builder
singleton Char
'e' Builder -> Builder -> Builder
<> Builder
show_e'
[] -> forall a. HasCallStack => [Char] -> a
error [Char]
"formatRealFloat/doFmt/Exponent/Nothing: []"
Just Int
dec ->
let dec' :: Int
dec' = forall a. Ord a => a -> a -> a
max Int
dec Int
1 in
case [Int]
is of
[Int
0] -> Builder
"0." Builder -> Builder -> Builder
<> Text -> Builder
fromText (Int -> Text -> Text
T.replicate Int
dec' Text
"0") Builder -> Builder -> Builder
<> Builder
"e0"
[Int]
_ ->
let (Int
ei,[Int]
is') = Int -> [Int] -> (Int, [Int])
roundTo (Int
dec'forall a. Num a => a -> a -> a
+Int
1) [Int]
is
is'' :: [Char]
is'' = forall a b. (a -> b) -> [a] -> [b]
map Int -> Char
i2d (if Int
ei forall a. Ord a => a -> a -> Bool
> Int
0 then forall a. [a] -> [a]
init [Int]
is' else [Int]
is')
in case [Char]
is'' of
[] -> forall a. HasCallStack => [Char] -> a
error [Char]
"formatRealFloat/doFmt/Exponent/Just: []"
(Char
d:[Char]
ds') -> Char -> Builder
singleton Char
d Builder -> Builder -> Builder
<> Char -> Builder
singleton Char
'.' Builder -> Builder -> Builder
<> [Char] -> Builder
fromString [Char]
ds' Builder -> Builder -> Builder
<> Char -> Builder
singleton Char
'e' Builder -> Builder -> Builder
<> forall a. Integral a => a -> Builder
decimal (Int
eforall a. Num a => a -> a -> a
-Int
1forall a. Num a => a -> a -> a
+Int
ei)
FPFormat
Fixed ->
let
mk0 :: [Char] -> Builder
mk0 [Char]
ls = case [Char]
ls of { [Char]
"" -> Builder
"0" ; [Char]
_ -> [Char] -> Builder
fromString [Char]
ls}
in
case Maybe Int
decs of
Maybe Int
Nothing
| Int
e forall a. Ord a => a -> a -> Bool
<= Int
0 -> Builder
"0." Builder -> Builder -> Builder
<> Text -> Builder
fromText (Int -> Text -> Text
T.replicate (-Int
e) Text
"0") Builder -> Builder -> Builder
<> [Char] -> Builder
fromString [Char]
ds
| Bool
otherwise ->
let
f :: t -> [Char] -> [Char] -> Builder
f t
0 [Char]
s [Char]
rs = [Char] -> Builder
mk0 (forall a. [a] -> [a]
reverse [Char]
s) Builder -> Builder -> Builder
<> Char -> Builder
singleton Char
'.' Builder -> Builder -> Builder
<> [Char] -> Builder
mk0 [Char]
rs
f t
n [Char]
s [Char]
"" = t -> [Char] -> [Char] -> Builder
f (t
nforall a. Num a => a -> a -> a
-t
1) (Char
'0'forall a. a -> [a] -> [a]
:[Char]
s) [Char]
""
f t
n [Char]
s (Char
r:[Char]
rs) = t -> [Char] -> [Char] -> Builder
f (t
nforall a. Num a => a -> a -> a
-t
1) (Char
rforall a. a -> [a] -> [a]
:[Char]
s) [Char]
rs
in
forall {t}. (Eq t, Num t) => t -> [Char] -> [Char] -> Builder
f Int
e [Char]
"" [Char]
ds
Just Int
dec ->
let dec' :: Int
dec' = forall a. Ord a => a -> a -> a
max Int
dec Int
0 in
if Int
e forall a. Ord a => a -> a -> Bool
>= Int
0 then
let
(Int
ei,[Int]
is') = Int -> [Int] -> (Int, [Int])
roundTo (Int
dec' forall a. Num a => a -> a -> a
+ Int
e) [Int]
is
([Char]
ls,[Char]
rs) = forall a. Int -> [a] -> ([a], [a])
splitAt (Int
eforall a. Num a => a -> a -> a
+Int
ei) (forall a b. (a -> b) -> [a] -> [b]
map Int -> Char
i2d [Int]
is')
in
[Char] -> Builder
mk0 [Char]
ls Builder -> Builder -> Builder
<> (if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Char]
rs then Builder
"" else Char -> Builder
singleton Char
'.' Builder -> Builder -> Builder
<> [Char] -> Builder
fromString [Char]
rs)
else
let (Int
ei,[Int]
is') = Int -> [Int] -> (Int, [Int])
roundTo Int
dec' (forall a. Int -> a -> [a]
replicate (-Int
e) Int
0 forall a. [a] -> [a] -> [a]
++ [Int]
is)
is'' :: [Char]
is'' = forall a b. (a -> b) -> [a] -> [b]
map Int -> Char
i2d (if Int
ei forall a. Ord a => a -> a -> Bool
> Int
0 then [Int]
is' else Int
0forall a. a -> [a] -> [a]
:[Int]
is')
in case [Char]
is'' of
[] -> forall a. HasCallStack => [Char] -> a
error [Char]
"formatRealFloat/doFmt/Fixed: []"
(Char
d:[Char]
ds') -> Char -> Builder
singleton Char
d Builder -> Builder -> Builder
<> (if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Char]
ds' then Builder
"" else Char -> Builder
singleton Char
'.' Builder -> Builder -> Builder
<> [Char] -> Builder
fromString [Char]
ds')
floatToDigits :: (RealFloat a) => a -> ([Int], Int)
{-# SPECIALIZE floatToDigits :: Float -> ([Int], Int) #-}
{-# SPECIALIZE floatToDigits :: Double -> ([Int], Int) #-}
floatToDigits :: forall a. RealFloat a => a -> ([Int], Int)
floatToDigits a
0 = ([Int
0], Int
0)
floatToDigits a
x =
let
(Integer
f0, Int
e0) = forall a. RealFloat a => a -> (Integer, Int)
decodeFloat a
x
(Int
minExp0, Int
_) = forall a. RealFloat a => a -> (Int, Int)
floatRange a
x
p :: Int
p = forall a. RealFloat a => a -> Int
floatDigits a
x
b :: Integer
b = forall a. RealFloat a => a -> Integer
floatRadix a
x
minExp :: Int
minExp = Int
minExp0 forall a. Num a => a -> a -> a
- Int
p
(Integer
f, Int
e) =
let n :: Int
n = Int
minExp forall a. Num a => a -> a -> a
- Int
e0 in
if Int
n forall a. Ord a => a -> a -> Bool
> Int
0 then (Integer
f0 forall a. Integral a => a -> a -> a
`quot` (Integer -> Int -> Integer
expt Integer
b Int
n), Int
e0forall a. Num a => a -> a -> a
+Int
n) else (Integer
f0, Int
e0)
(Integer
r, Integer
s, Integer
mUp, Integer
mDn) =
if Int
e forall a. Ord a => a -> a -> Bool
>= Int
0 then
let be :: Integer
be = Integer -> Int -> Integer
expt Integer
b Int
e in
if Integer
f forall a. Eq a => a -> a -> Bool
== Integer -> Int -> Integer
expt Integer
b (Int
pforall a. Num a => a -> a -> a
-Int
1) then
(Integer
fforall a. Num a => a -> a -> a
*Integer
beforall a. Num a => a -> a -> a
*Integer
bforall a. Num a => a -> a -> a
*Integer
2, Integer
2forall a. Num a => a -> a -> a
*Integer
b, Integer
beforall a. Num a => a -> a -> a
*Integer
b, Integer
be)
else
(Integer
fforall a. Num a => a -> a -> a
*Integer
beforall a. Num a => a -> a -> a
*Integer
2, Integer
2, Integer
be, Integer
be)
else
if Int
e forall a. Ord a => a -> a -> Bool
> Int
minExp Bool -> Bool -> Bool
&& Integer
f forall a. Eq a => a -> a -> Bool
== Integer -> Int -> Integer
expt Integer
b (Int
pforall a. Num a => a -> a -> a
-Int
1) then
(Integer
fforall a. Num a => a -> a -> a
*Integer
bforall a. Num a => a -> a -> a
*Integer
2, Integer -> Int -> Integer
expt Integer
b (-Int
eforall a. Num a => a -> a -> a
+Int
1)forall a. Num a => a -> a -> a
*Integer
2, Integer
b, Integer
1)
else
(Integer
fforall a. Num a => a -> a -> a
*Integer
2, Integer -> Int -> Integer
expt Integer
b (-Int
e)forall a. Num a => a -> a -> a
*Integer
2, Integer
1, Integer
1)
k :: Int
k :: Int
k =
let
k0 :: Int
k0 :: Int
k0 =
if Integer
b forall a. Eq a => a -> a -> Bool
== Integer
2 then
let lx :: Int
lx = Int
p forall a. Num a => a -> a -> a
- Int
1 forall a. Num a => a -> a -> a
+ Int
e0
k1 :: Int
k1 = (Int
lx forall a. Num a => a -> a -> a
* Int
8651) forall a. Integral a => a -> a -> a
`quot` Int
28738
in if Int
lx forall a. Ord a => a -> a -> Bool
>= Int
0 then Int
k1 forall a. Num a => a -> a -> a
+ Int
1 else Int
k1
else
forall a b. (RealFrac a, Integral b) => a -> b
ceiling ((forall a. Floating a => a -> a
log (forall a. Num a => Integer -> a
fromInteger (Integer
fforall a. Num a => a -> a -> a
+Integer
1) :: Float) forall a. Num a => a -> a -> a
+
Int -> Float
intToFloat Int
e forall a. Num a => a -> a -> a
* forall a. Floating a => a -> a
log (forall a. Num a => Integer -> a
fromInteger Integer
b)) forall a. Fractional a => a -> a -> a
/
forall a. Floating a => a -> a
log Float
10)
fixup :: Int -> Int
fixup Int
n =
if Int
n forall a. Ord a => a -> a -> Bool
>= Int
0 then
if Integer
r forall a. Num a => a -> a -> a
+ Integer
mUp forall a. Ord a => a -> a -> Bool
<= Integer -> Int -> Integer
expt Integer
10 Int
n forall a. Num a => a -> a -> a
* Integer
s then Int
n else Int -> Int
fixup (Int
nforall a. Num a => a -> a -> a
+Int
1)
else
if Integer -> Int -> Integer
expt Integer
10 (-Int
n) forall a. Num a => a -> a -> a
* (Integer
r forall a. Num a => a -> a -> a
+ Integer
mUp) forall a. Ord a => a -> a -> Bool
<= Integer
s then Int
n else Int -> Int
fixup (Int
nforall a. Num a => a -> a -> a
+Int
1)
in
Int -> Int
fixup Int
k0
gen :: [t] -> t -> t -> t -> t -> [t]
gen [t]
ds t
rn t
sN t
mUpN t
mDnN =
let
(t
dn, t
rn') = (t
rn forall a. Num a => a -> a -> a
* t
10) forall a. Integral a => a -> a -> (a, a)
`quotRem` t
sN
mUpN' :: t
mUpN' = t
mUpN forall a. Num a => a -> a -> a
* t
10
mDnN' :: t
mDnN' = t
mDnN forall a. Num a => a -> a -> a
* t
10
in
case (t
rn' forall a. Ord a => a -> a -> Bool
< t
mDnN', t
rn' forall a. Num a => a -> a -> a
+ t
mUpN' forall a. Ord a => a -> a -> Bool
> t
sN) of
(Bool
True, Bool
False) -> t
dn forall a. a -> [a] -> [a]
: [t]
ds
(Bool
False, Bool
True) -> t
dnforall a. Num a => a -> a -> a
+t
1 forall a. a -> [a] -> [a]
: [t]
ds
(Bool
True, Bool
True) -> if t
rn' forall a. Num a => a -> a -> a
* t
2 forall a. Ord a => a -> a -> Bool
< t
sN then t
dn forall a. a -> [a] -> [a]
: [t]
ds else t
dnforall a. Num a => a -> a -> a
+t
1 forall a. a -> [a] -> [a]
: [t]
ds
(Bool
False, Bool
False) -> [t] -> t -> t -> t -> t -> [t]
gen (t
dnforall a. a -> [a] -> [a]
:[t]
ds) t
rn' t
sN t
mUpN' t
mDnN'
rds :: [Integer]
rds =
if Int
k forall a. Ord a => a -> a -> Bool
>= Int
0 then
forall {t}. Integral t => [t] -> t -> t -> t -> t -> [t]
gen [] Integer
r (Integer
s forall a. Num a => a -> a -> a
* Integer -> Int -> Integer
expt Integer
10 Int
k) Integer
mUp Integer
mDn
else
let bk :: Integer
bk = Integer -> Int -> Integer
expt Integer
10 (-Int
k) in
forall {t}. Integral t => [t] -> t -> t -> t -> t -> [t]
gen [] (Integer
r forall a. Num a => a -> a -> a
* Integer
bk) Integer
s (Integer
mUp forall a. Num a => a -> a -> a
* Integer
bk) (Integer
mDn forall a. Num a => a -> a -> a
* Integer
bk)
in
(forall a b. (a -> b) -> [a] -> [b]
map forall a. Num a => Integer -> a
fromInteger (forall a. [a] -> [a]
reverse [Integer]
rds), Int
k)
minExpt, maxExpt :: Int
minExpt :: Int
minExpt = Int
0
maxExpt :: Int
maxExpt = Int
1100
expt :: Integer -> Int -> Integer
expt :: Integer -> Int -> Integer
expt Integer
base Int
n
| Integer
base forall a. Eq a => a -> a -> Bool
== Integer
2 Bool -> Bool -> Bool
&& Int
n forall a. Ord a => a -> a -> Bool
>= Int
minExpt Bool -> Bool -> Bool
&& Int
n forall a. Ord a => a -> a -> Bool
<= Int
maxExpt = Array Int Integer
expts forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> Int -> e
`unsafeAt` Int
n
| Integer
base forall a. Eq a => a -> a -> Bool
== Integer
10 Bool -> Bool -> Bool
&& Int
n forall a. Ord a => a -> a -> Bool
<= Int
maxExpt10 = Array Int Integer
expts10 forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> Int -> e
`unsafeAt` Int
n
| Bool
otherwise = Integer
baseforall a b. (Num a, Integral b) => a -> b -> a
^Int
n
expts :: Array Int Integer
expts :: Array Int Integer
expts = forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
(i, i) -> [(i, e)] -> a i e
array (Int
minExpt,Int
maxExpt) [(Int
n,Integer
2forall a b. (Num a, Integral b) => a -> b -> a
^Int
n) | Int
n <- [Int
minExpt .. Int
maxExpt]]
maxExpt10 :: Int
maxExpt10 :: Int
maxExpt10 = Int
324
expts10 :: Array Int Integer
expts10 :: Array Int Integer
expts10 = forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
(i, i) -> [(i, e)] -> a i e
array (Int
minExpt,Int
maxExpt10) [(Int
n,Integer
10forall a b. (Num a, Integral b) => a -> b -> a
^Int
n) | Int
n <- [Int
minExpt .. Int
maxExpt10]]
intToFloat :: Int -> Float
intToFloat :: Int -> Float
intToFloat = forall a b. (Integral a, Num b) => a -> b
fromIntegral