@@ -1,120 +0,0 @@
1−{-# LANGUAGE BangPatterns, CPP, MagicHash, OverloadedStrings, UnboxedTuples #-}
2−
3−-- Module: Data.Aeson.Encode.Number
4−-- Copyright: (c) 2011 MailRank, Inc.
5−-- License: Apache
6−-- Maintainer: Bryan O'Sullivan <bos@mailrank.com>
7−-- Stability: experimental
8−-- Portability: portable
9−--
10−-- Efficiently serialize a Double as a lazy 'L.ByteString'.
11−
12−module Data.Aeson.Encode.Double
13− (
14− double
15− ) where
16−
17−import Blaze.ByteString.Builder (Builder, fromByteString)
18−import Blaze.ByteString.Builder.Char8 (fromChar)
19−import Data.Aeson.Encode.Int (digit, int, minus)
20−import Data.ByteString.Char8 ()
21−import Data.Monoid (mappend, mconcat, mempty)
22−import qualified Data.Vector as V
23−
24−-- The code below is originally from GHC.Float, but has been optimised
25−-- in quite a few ways.
26−
27−data T = T [Int] {-# UNPACK #-} !Int
28−
29−double :: Double -> Builder
30−double f
31− | isNaN f || isInfinite f = fromByteString "null"
32− | f < 0 || isNegativeZero f = minus `mappend` goGeneric (floatToDigits (-f))
33− | otherwise = goGeneric (floatToDigits f)
34− where
35− goGeneric p@(T _ e)
36− | e < 0 || e > 7 = goExponent p
37− | otherwise = goFixed p
38− goExponent (T is e) =
39− case is of
40− [] -> error "putFormattedFloat"
41− [0] -> fromByteString "0.0e0"
42− [d] -> digit d `mappend` fromByteString ".0e" `mappend` int (e-1)
43− (d:ds) -> digit d `mappend` fromChar '.' `mappend` digits ds `mappend`
44− fromChar 'e' `mappend` int (e-1)
45− goFixed (T is e)
46− | e <= 0 = fromChar '0' `mappend` fromChar '.' `mappend`
47− mconcat (replicate (-e) (fromChar '0')) `mappend`
48− digits is
49− | otherwise = let g 0 rs = fromChar '.' `mappend` mk0 rs
50− g n [] = fromChar '0' `mappend` g (n-1) []
51− g n (r:rs) = digit r `mappend` g (n-1) rs
52− in g e is
53− mk0 [] = fromChar '0'
54− mk0 rs = digits rs
55−
56−digits :: [Int] -> Builder
57−digits (d:ds) = digit d `mappend` digits ds
58−digits _ = mempty
59−{-# INLINE digits #-}
60−
61−floatToDigits :: Double -> T
62−floatToDigits 0 = T [0] 0
63−floatToDigits x = T (reverse rds) k
64− where
65− (f0, e0) = decodeFloat x
66− (minExp0, _) = floatRange (undefined::Double)
67− p = floatDigits x
68− b = floatRadix x
69− minExp = minExp0 - p -- the real minimum exponent
70− -- Haskell requires that f be adjusted so denormalized numbers
71− -- will have an impossibly low exponent. Adjust for this.
72− (# f, e #) =
73− let n = minExp - e0 in
74− if n > 0 then (# f0 `div` (b^n), e0+n #) else (# f0, e0 #)
75− (# r, s, mUp, mDn #) =
76− if e >= 0
77− then let be = b^ e
78− in if f == b^(p-1)
79− then (# f*be*b*2, 2*b, be*b, b #)
80− else (# f*be*2, 2, be, be #)
81− else if e > minExp && f == b^(p-1)
82− then (# f*b*2, b^(-e+1)*2, b, 1 #)
83− else (# f*2, b^(-e)*2, 1, 1 #)
84− k = fixup k0
85− where
86− k0 | b == 2 = (p - 1 + e0) * 3 `div` 10
87− -- logBase 10 2 is slightly bigger than 3/10 so the following
88− -- will err on the low side. Ignoring the fraction will make
89− -- it err even more. Haskell promises that p-1 <= logBase b f
90− -- < p.
91− | otherwise = ceiling ((log (fromInteger (f+1) :: Double) +
92− fromIntegral e * log (fromInteger b)) / log 10)
93− fixup n
94− | n >= 0 = if r + mUp <= exp10 n * s then n else fixup (n+1)
95− | otherwise = if exp10 (-n) * (r + mUp) <= s then n else fixup (n+1)
96−
97− gen ds !rn !sN !mUpN !mDnN =
98− let (dn0, rn') = (rn * 10) `divMod` sN
99− mUpN' = mUpN * 10
100− mDnN' = mDnN * 10
101− !dn = fromInteger dn0
102− !dn' = dn + 1
103− in case (# rn' < mDnN', rn' + mUpN' > sN #) of
104− (# True, False #) -> dn : ds
105− (# False, True #) -> dn' : ds
106− (# True, True #) -> if rn' * 2 < sN then dn : ds else dn' : ds
107− (# False, False #) -> gen (dn:ds) rn' sN mUpN' mDnN'
108−
109− rds | k >= 0 = gen [] r (s * exp10 k) mUp mDn
110− | otherwise = gen [] (r * bk) s (mUp * bk) (mDn * bk)
111− where bk = exp10 (-k)
112−
113−exp10 :: Int -> Integer
114−exp10 n
115− | n >= 0 && n < maxExpt = V.unsafeIndex expts n
116− | otherwise = 10 ^ n
117− where expts = V.generate maxExpt (10^)
118− {-# NOINLINE expts #-}
119− maxExpt = 17
120−{-# INLINE exp10 #-}