{-# LANGUAGE BangPatterns, CPP, MagicHash, OverloadedStrings, UnboxedTuples #-}
module Blaze.Text.Double.Native
(
float
, double
) where
import Blaze.ByteString.Builder (Builder, fromByteString)
import Blaze.ByteString.Builder.Char8 (fromChar)
import Blaze.Text.Int (digit, integral, minus)
import Data.ByteString.Char8 ()
import Data.Monoid (mappend, mconcat, mempty)
import qualified Data.Vector as V
data T = T [Int] {-# UNPACK #-} !Int
float :: Float -> Builder
float :: Float -> Builder
float = Double -> Builder
double (Double -> Builder) -> (Float -> Double) -> Float -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac
double :: Double -> Builder
double :: Double -> Builder
double f :: Double
f
| Double -> Bool
forall a. RealFloat a => a -> Bool
isInfinite Double
f = ByteString -> Builder
fromByteString (ByteString -> Builder) -> ByteString -> Builder
forall a b. (a -> b) -> a -> b
$
if Double
f Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> 0 then "Infinity" else "-Infinity"
| Double
f Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< 0 Bool -> Bool -> Bool
|| Double -> Bool
forall a. RealFloat a => a -> Bool
isNegativeZero Double
f = Builder
minus Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend` T -> Builder
goGeneric (Double -> T
floatToDigits (-Double
f))
| Double
f Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
>= 0 = T -> Builder
goGeneric (Double -> T
floatToDigits Double
f)
| Bool
otherwise = ByteString -> Builder
fromByteString "NaN"
where
goGeneric :: T -> Builder
goGeneric p :: T
p@(T _ e :: Int
e)
| Int
e Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 0 Bool -> Bool -> Bool
|| Int
e Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 7 = T -> Builder
goExponent T
p
| Bool
otherwise = T -> Builder
goFixed T
p
goExponent :: T -> Builder
goExponent (T is :: [Int]
is e :: Int
e) =
case [Int]
is of
[] -> [Char] -> Builder
forall a. HasCallStack => [Char] -> a
error "putFormattedFloat"
[0] -> ByteString -> Builder
fromByteString "0.0e0"
[d :: Int
d] -> Int -> Builder
forall a. Integral a => a -> Builder
digit Int
d Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend` ByteString -> Builder
fromByteString ".0e" Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend` Int -> Builder
forall a. (Integral a, Show a) => a -> Builder
integral (Int
eInt -> Int -> Int
forall a. Num a => a -> a -> a
-1)
(d :: Int
d:ds :: [Int]
ds) -> Int -> Builder
forall a. Integral a => a -> Builder
digit Int
d Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend` Char -> Builder
fromChar '.' Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend` [Int] -> Builder
digits [Int]
ds Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend`
Char -> Builder
fromChar 'e' Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend` Int -> Builder
forall a. (Integral a, Show a) => a -> Builder
integral (Int
eInt -> Int -> Int
forall a. Num a => a -> a -> a
-1)
goFixed :: T -> Builder
goFixed (T is :: [Int]
is e :: Int
e)
| Int
e Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= 0 = Char -> Builder
fromChar '0' Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend` Char -> Builder
fromChar '.' Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend`
[Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat (Int -> Builder -> [Builder]
forall a. Int -> a -> [a]
replicate (-Int
e) (Char -> Builder
fromChar '0')) Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend`
[Int] -> Builder
digits [Int]
is
| Bool
otherwise = let g :: a -> [Int] -> Builder
g 0 rs :: [Int]
rs = Char -> Builder
fromChar '.' Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend` [Int] -> Builder
mk0 [Int]
rs
g n :: a
n [] = Char -> Builder
fromChar '0' Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend` a -> [Int] -> Builder
g (a
na -> a -> a
forall a. Num a => a -> a -> a
-1) []
g n :: a
n (r :: Int
r:rs :: [Int]
rs) = Int -> Builder
forall a. Integral a => a -> Builder
digit Int
r Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend` a -> [Int] -> Builder
g (a
na -> a -> a
forall a. Num a => a -> a -> a
-1) [Int]
rs
in Int -> [Int] -> Builder
forall a. (Eq a, Num a) => a -> [Int] -> Builder
g Int
e [Int]
is
mk0 :: [Int] -> Builder
mk0 [] = Char -> Builder
fromChar '0'
mk0 rs :: [Int]
rs = [Int] -> Builder
digits [Int]
rs
digits :: [Int] -> Builder
digits :: [Int] -> Builder
digits (d :: Int
d:ds :: [Int]
ds) = Int -> Builder
forall a. Integral a => a -> Builder
digit Int
d Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend` [Int] -> Builder
digits [Int]
ds
digits _ = Builder
forall a. Monoid a => a
mempty
{-# INLINE digits #-}
floatToDigits :: Double -> T
floatToDigits :: Double -> T
floatToDigits 0 = [Int] -> Int -> T
T [0] 0
floatToDigits x :: Double
x = [Int] -> Int -> T
T ([Int] -> [Int]
forall a. [a] -> [a]
reverse [Int]
rds) Int
k
where
(f0 :: Integer
f0, e0 :: Int
e0) = Double -> (Integer, Int)
forall a. RealFloat a => a -> (Integer, Int)
decodeFloat Double
x
(minExp0 :: Int
minExp0, _) = Double -> (Int, Int)
forall a. RealFloat a => a -> (Int, Int)
floatRange (Double
forall a. HasCallStack => a
undefined::Double)
p :: Int
p = Double -> Int
forall a. RealFloat a => a -> Int
floatDigits Double
x
b :: Integer
b = Double -> Integer
forall a. RealFloat a => a -> Integer
floatRadix Double
x
minExp :: Int
minExp = Int
minExp0 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
p
(# f :: Integer
f, e :: Int
e #) =
let n :: Int
n = Int
minExp Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
e0 in
if Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 0 then (# Integer
f0 Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`div` (Integer
bInteger -> Int -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^Int
n), Int
e0Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
n #) else (# Integer
f0, Int
e0 #)
(# r :: Integer
r, s :: Integer
s, mUp :: Integer
mUp, mDn :: Integer
mDn #) =
if Int
e Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= 0
then let be :: Integer
be = Integer
bInteger -> Int -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^ Int
e
in if Integer
f Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
bInteger -> Int -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^(Int
pInt -> Int -> Int
forall a. Num a => a -> a -> a
-1)
then (# Integer
fInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
*Integer
beInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
*Integer
bInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
*2, 2Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
*Integer
b, Integer
beInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
*Integer
b, Integer
b #)
else (# Integer
fInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
*Integer
beInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
*2, 2, Integer
be, Integer
be #)
else if Int
e Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
minExp Bool -> Bool -> Bool
&& Integer
f Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
bInteger -> Int -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^(Int
pInt -> Int -> Int
forall a. Num a => a -> a -> a
-1)
then (# Integer
fInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
*Integer
bInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
*2, Integer
bInteger -> Int -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^(-Int
eInt -> Int -> Int
forall a. Num a => a -> a -> a
+1)Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
*2, Integer
b, 1 #)
else (# Integer
fInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
*2, Integer
bInteger -> Int -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^(-Int
e)Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
*2, 1, 1 #)
k :: Int
k = Int -> Int
fixup Int
k0
where
k0 :: Int
k0 | Integer
b Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== 2 = (Int
p Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
e0) Int -> Int -> Int
forall a. Num a => a -> a -> a
* 3 Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` 10
| Bool
otherwise = Double -> Int
forall a b. (RealFrac a, Integral b) => a -> b
ceiling ((Double -> Double
forall a. Floating a => a -> a
log (Integer -> Double
forall a. Num a => Integer -> a
fromInteger (Integer
fInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
+1) :: Double) Double -> Double -> Double
forall a. Num a => a -> a -> a
+
Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
e Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double -> Double
forall a. Floating a => a -> a
log (Integer -> Double
forall a. Num a => Integer -> a
fromInteger Integer
b)) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double -> Double
forall a. Floating a => a -> a
log 10)
fixup :: Int -> Int
fixup n :: Int
n
| Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= 0 = if Integer
r Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
mUp Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Int -> Integer
exp10 Int
n Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
s then Int
n else Int -> Int
fixup (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+1)
| Bool
otherwise = if Int -> Integer
exp10 (-Int
n) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* (Integer
r Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
mUp) Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
s then Int
n else Int -> Int
fixup (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+1)
gen :: [a] -> Integer -> Integer -> Integer -> Integer -> [a]
gen ds :: [a]
ds !Integer
rn !Integer
sN !Integer
mUpN !Integer
mDnN =
let (dn0 :: Integer
dn0, rn' :: Integer
rn') = (Integer
rn Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* 10) Integer -> Integer -> (Integer, Integer)
forall a. Integral a => a -> a -> (a, a)
`divMod` Integer
sN
mUpN' :: Integer
mUpN' = Integer
mUpN Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* 10
mDnN' :: Integer
mDnN' = Integer
mDnN Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* 10
!dn :: a
dn = Integer -> a
forall a. Num a => Integer -> a
fromInteger Integer
dn0
!dn' :: a
dn' = a
dn a -> a -> a
forall a. Num a => a -> a -> a
+ 1
in case (# Integer
rn' Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
mDnN', Integer
rn' Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
mUpN' Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
sN #) of
(# True, False #) -> a
dn a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
ds
(# False, True #) -> a
dn' a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
ds
(# True, True #) -> if Integer
rn' Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* 2 Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
sN then a
dn a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
ds else a
dn' a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
ds
(# False, False #) -> [a] -> Integer -> Integer -> Integer -> Integer -> [a]
gen (a
dna -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
ds) Integer
rn' Integer
sN Integer
mUpN' Integer
mDnN'
rds :: [Int]
rds | Int
k Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= 0 = [Int] -> Integer -> Integer -> Integer -> Integer -> [Int]
forall a.
Num a =>
[a] -> Integer -> Integer -> Integer -> Integer -> [a]
gen [] Integer
r (Integer
s Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Int -> Integer
exp10 Int
k) Integer
mUp Integer
mDn
| Bool
otherwise = [Int] -> Integer -> Integer -> Integer -> Integer -> [Int]
forall a.
Num a =>
[a] -> Integer -> Integer -> Integer -> Integer -> [a]
gen [] (Integer
r Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
bk) Integer
s (Integer
mUp Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
bk) (Integer
mDn Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
bk)
where bk :: Integer
bk = Int -> Integer
exp10 (-Int
k)
exp10 :: Int -> Integer
exp10 :: Int -> Integer
exp10 n :: Int
n
| Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= 0 Bool -> Bool -> Bool
&& Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
maxExpt = Vector Integer -> Int -> Integer
forall a. Vector a -> Int -> a
V.unsafeIndex Vector Integer
expts Int
n
| Bool
otherwise = 10 Integer -> Int -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^ Int
n
where expts :: Vector Integer
expts = Int -> (Int -> Integer) -> Vector Integer
forall a. Int -> (Int -> a) -> Vector a
V.generate Int
maxExpt (10Integer -> Int -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^)
{-# NOINLINE expts #-}
maxExpt :: Int
maxExpt = 17
{-# INLINE exp10 #-}