Commit
This commit does not belong to any branch on this repository, and may belong to a fork outside of the repository.
Add a "-fnative" option to build with native double conversion code.
This is slower than the double-conversion package by a factor of 10, but it doesn't have double-conversion's problems with GHCi. --HG-- rename : Blaze/Text/Double.hs => Blaze/Text/Double/Native.hs
- Loading branch information
Showing
3 changed files
with
144 additions
and
1 deletion.
There are no files selected for viewing
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -0,0 +1,124 @@ | ||
{-# LANGUAGE BangPatterns, CPP, MagicHash, OverloadedStrings, UnboxedTuples #-} | ||
|
||
-- Module: Blaze.Text.Double.Native | ||
-- Copyright: (c) 2011 MailRank, Inc. | ||
-- License: BSD3 | ||
-- Maintainer: Bryan O'Sullivan <bos@mailrank.com> | ||
-- Stability: experimental | ||
-- Portability: portable | ||
-- | ||
-- Efficiently serialize a Double as a lazy 'L.ByteString'. | ||
|
||
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 | ||
|
||
-- The code below is originally from GHC.Float, but has been optimised | ||
-- in quite a few ways. | ||
|
||
data T = T [Int] {-# UNPACK #-} !Int | ||
|
||
float :: Float -> Builder | ||
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 #-} |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters