Commits

Bryan O'Sullivan committed 40f58b5

Use double-conversion for rendering Double values.

This has a knock-on effect of improving aeson's encoding performance
for Double values by a factor of 10. Nice!

Comments (0)

Files changed (2)

Blaze/Text/Double.hs

-{-# LANGUAGE BangPatterns, CPP, MagicHash, OverloadedStrings, UnboxedTuples #-}
-
 -- Module:      Blaze.Text.Double
 -- Copyright:   (c) 2011 MailRank, Inc.
 -- License:     BSD3
     ) 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
-
--- The code below is originally from GHC.Float, but has been optimised
--- in quite a few ways.
-
-data T = T [Int] {-# UNPACK #-} !Int
+import Data.Double.Conversion.ByteString (toShortest)
 
 float :: Float -> Builder
-float = double . fromRational . toRational
+float = double . realToFrac
 
 double :: Double -> Builder
-double f
-    | isNaN f || isInfinite f   = fromByteString "null"
-    | f < 0 || isNegativeZero f = minus `mappend` goGeneric (floatToDigits (-f))
-    | otherwise                 = goGeneric (floatToDigits f)
-  where
-   goGeneric p@(T _ e)
-     | e < 0 || e > 7 = goExponent p
-     | otherwise      = goFixed    p
-   goExponent (T is e) =
-       case is of
-         []     -> error "putFormattedFloat"
-         [0]    -> fromByteString "0.0e0"
-         [d]    -> digit d `mappend` fromByteString ".0e" `mappend` integral (e-1)
-         (d:ds) -> digit d `mappend` fromChar '.' `mappend` digits ds `mappend`
-                   fromChar 'e' `mappend` integral (e-1)
-   goFixed (T is e)
-       | e <= 0    = fromChar '0' `mappend` fromChar '.' `mappend`
-                     mconcat (replicate (-e) (fromChar '0')) `mappend`
-                     digits is
-       | otherwise = let g 0 rs     = fromChar '.' `mappend` mk0 rs
-                         g n []     = fromChar '0' `mappend` g (n-1) []
-                         g n (r:rs) = digit r `mappend` g (n-1) rs
-                     in g e is
-   mk0 [] = fromChar '0'
-   mk0 rs = digits rs
-
-digits :: [Int] -> Builder
-digits (d:ds) = digit d `mappend` digits ds
-digits _      = mempty
-{-# INLINE digits #-}
-
-floatToDigits :: Double -> T
-floatToDigits 0 = T [0] 0
-floatToDigits x = T (reverse rds) k
- where
-  (f0, e0)     = decodeFloat x
-  (minExp0, _) = floatRange (undefined::Double)
-  p = floatDigits x
-  b = floatRadix x
-  minExp = minExp0 - p -- the real minimum exponent
-  -- Haskell requires that f be adjusted so denormalized numbers
-  -- will have an impossibly low exponent.  Adjust for this.
-  (# f, e #) =
-   let n = minExp - e0 in
-   if n > 0 then (# f0 `div` (b^n), e0+n #) else (# f0, e0 #)
-  (# r, s, mUp, mDn #) =
-   if e >= 0
-   then let be = b^ e
-        in if f == b^(p-1)
-           then (# f*be*b*2, 2*b, be*b, b #)
-           else (# f*be*2, 2, be, be #)
-   else if e > minExp && f == b^(p-1)
-        then (# f*b*2, b^(-e+1)*2, b, 1 #)
-        else (# f*2, b^(-e)*2, 1, 1 #)
-  k = fixup k0
-   where
-    k0 | b == 2 = (p - 1 + e0) * 3 `div` 10
-        -- logBase 10 2 is slightly bigger than 3/10 so the following
-        -- will err on the low side.  Ignoring the fraction will make
-        -- it err even more.  Haskell promises that p-1 <= logBase b f
-        -- < p.
-       | otherwise = ceiling ((log (fromInteger (f+1) :: Double) +
-                               fromIntegral e * log (fromInteger b)) / log 10)
-    fixup n
-      | n >= 0    = if r + mUp <= exp10 n * s then n else fixup (n+1)
-      | otherwise = if exp10 (-n) * (r + mUp) <= s then n else fixup (n+1)
-
-  gen ds !rn !sN !mUpN !mDnN =
-   let (dn0, rn') = (rn * 10) `divMod` sN
-       mUpN' = mUpN * 10
-       mDnN' = mDnN * 10
-       !dn   = fromInteger dn0
-       !dn'  = dn + 1
-   in case (# rn' < mDnN', rn' + mUpN' > sN #) of
-        (# True,  False #) -> dn : ds
-        (# False, True #)  -> dn' : ds
-        (# True,  True #)  -> if rn' * 2 < sN then dn : ds else dn' : ds
-        (# False, False #) -> gen (dn:ds) rn' sN mUpN' mDnN'
-
-  rds | k >= 0    = gen [] r (s * exp10 k) mUp mDn
-      | otherwise = gen [] (r * bk) s (mUp * bk) (mDn * bk)
-      where bk = exp10 (-k)
-                    
-exp10 :: Int -> Integer
-exp10 n
-    | n >= 0 && n < maxExpt = V.unsafeIndex expts n
-    | otherwise             = 10 ^ n
-  where expts = V.generate maxExpt (10^)
-        {-# NOINLINE expts #-}
-        maxExpt = 17
-{-# INLINE exp10 #-}
+double f = fromByteString (toShortest f)

blaze-textual.cabal

     base == 4.*,
     blaze-builder >= 0.2.1.4,
     bytestring,
+    double-conversion >= 0.2.0.0,
     ghc-prim,
-    integer-gmp,
     old-locale,
     text >= 0.11.0.2,
     time,
Tip: Filter by directory path e.g. /media app.js to search for public/media/app.js.
Tip: Use camelCasing e.g. ProjME to search for ProjectModifiedEvent.java.
Tip: Filter by extension type e.g. /repo .js to search for all .js files in the /repo directory.
Tip: Separate your search with spaces e.g. /ssh pom.xml to search for src/ssh/pom.xml.
Tip: Use ↑ and ↓ arrow keys to navigate and return to view the file.
Tip: You can also navigate files with Ctrl+j (next) and Ctrl+k (previous) and view the file with Ctrl+o.
Tip: You can also navigate files with Alt+j (next) and Alt+k (previous) and view the file with Alt+o.