blaze-textual 0.2.0.1 → 0.2.0.2
raw patch · 4 files changed
+211/−15 lines, 4 filesdep +QuickCheckdep +blaze-textualdep +test-frameworkdep ~basedep ~blaze-builderdep ~double-conversionPVP ok
version bump matches the API change (PVP)
Dependencies added: QuickCheck, blaze-textual, test-framework, test-framework-quickcheck2
Dependency ranges changed: base, blaze-builder, double-conversion
API changes (from Hackage documentation)
Files
- Blaze/Text/Double.hs +6/−0
- Blaze/Text/Double/Native.hs +126/−0
- Blaze/Text/Int.hs +49/−13
- blaze-textual.cabal +30/−2
Blaze/Text/Double.hs view
@@ -1,3 +1,5 @@+{-# LANGUAGE CPP #-}+ -- Module: Blaze.Text.Double -- Copyright: (c) 2011 MailRank, Inc. -- License: BSD3@@ -13,6 +15,9 @@ , double ) where +#ifdef NATIVE+import Blaze.Text.Double.Native+#else import Blaze.ByteString.Builder (Builder, fromByteString) import Data.Double.Conversion.ByteString (toShortest) @@ -21,3 +26,4 @@ double :: Double -> Builder double f = fromByteString (toShortest f)+#endif
+ Blaze/Text/Double/Native.hs view
@@ -0,0 +1,126 @@+{-# 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+ | isInfinite f = fromByteString $+ if f > 0 then "Infinity" else "-Infinity"+ | f < 0 || isNegativeZero f = minus `mappend` goGeneric (floatToDigits (-f))+ | f >= 0 = goGeneric (floatToDigits f)+ | otherwise = fromByteString "NaN"+ 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 #-}
Blaze/Text/Int.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE BangPatterns, CPP, MagicHash, UnboxedTuples #-}+{-# LANGUAGE BangPatterns, CPP, MagicHash, OverloadedStrings, UnboxedTuples #-} -- Module: Blaze.Text.Int -- Copyright: (c) 2011 MailRank, Inc.@@ -17,6 +17,8 @@ ) where import Blaze.ByteString.Builder+import Blaze.ByteString.Builder.Char8+import Data.ByteString.Char8 () import Data.Int (Int8, Int16, Int32, Int64) import Data.Monoid (mappend, mempty) import Data.Word (Word, Word8, Word16, Word32, Word64)@@ -39,20 +41,54 @@ #endif integral :: Integral a => a -> Builder-{-# SPECIALIZE integral :: Int -> Builder #-}-{-# SPECIALIZE integral :: Int8 -> Builder #-}-{-# SPECIALIZE integral :: Int16 -> Builder #-}-{-# SPECIALIZE integral :: Int32 -> Builder #-}-{-# SPECIALIZE integral :: Int64 -> Builder #-}-{-# SPECIALIZE integral :: Word -> Builder #-}-{-# SPECIALIZE integral :: Word8 -> Builder #-}-{-# SPECIALIZE integral :: Word16 -> Builder #-}-{-# SPECIALIZE integral :: Word32 -> Builder #-}-{-# SPECIALIZE integral :: Word64 -> Builder #-}+{-# RULES "integral/Int" integral = bounded :: Int -> Builder #-}+{-# RULES "integral/Int8" integral = bounded :: Int8 -> Builder #-}+{-# RULES "integral/Int16" integral = bounded :: Int16 -> Builder #-}+{-# RULES "integral/Int32" integral = bounded :: Int32 -> Builder #-}+{-# RULES "integral/Int64" integral = bounded :: Int64 -> Builder #-}+{-# RULES "integral/Word" integral = nonNegative :: Word -> Builder #-}+{-# RULES "integral/Word8" integral = nonNegative :: Word8 -> Builder #-}+{-# RULES "integral/Word16" integral = nonNegative :: Word16 -> Builder #-}+{-# RULES "integral/Word32" integral = nonNegative :: Word32 -> Builder #-}+{-# RULES "integral/Word64" integral = nonNegative :: Word64 -> Builder #-} {-# RULES "integral/Integer" integral = integer :: Integer -> Builder #-}++-- This definition of the function is here PURELY to be used by ghci+-- and those rare cases where GHC is being invoked without+-- optimization, as otherwise the rewrite rules above should fire. The+-- test for "-0" catches an overflow if we render minBound. integral i- | i < 0 = minus `mappend` go (-i)- | otherwise = go i+ | i >= 0 = nonNegative i+ | toByteString b == "-0" = fromString (show i)+ | otherwise = b+ where b = minus `mappend` nonNegative (-i)++bounded :: (Bounded a, Integral a) => a -> Builder+{-# SPECIALIZE bounded :: Int -> Builder #-}+{-# SPECIALIZE bounded :: Int8 -> Builder #-}+{-# SPECIALIZE bounded :: Int16 -> Builder #-}+{-# SPECIALIZE bounded :: Int32 -> Builder #-}+{-# SPECIALIZE bounded :: Int64 -> Builder #-}+bounded i+ | i >= 0 = nonNegative i+ | i > minBound = minus `mappend` nonNegative (-i)+ | otherwise = minus `mappend`+ nonNegative (negate (k `quot` 10)) `mappend`+ digit (negate (k `rem` 10))+ where k = minBound `asTypeOf` i++nonNegative :: Integral a => a -> Builder+{-# SPECIALIZE nonNegative :: Int -> Builder #-}+{-# SPECIALIZE nonNegative :: Int8 -> Builder #-}+{-# SPECIALIZE nonNegative :: Int16 -> Builder #-}+{-# SPECIALIZE nonNegative :: Int32 -> Builder #-}+{-# SPECIALIZE nonNegative :: Int64 -> Builder #-}+{-# SPECIALIZE nonNegative :: Word -> Builder #-}+{-# SPECIALIZE nonNegative :: Word8 -> Builder #-}+{-# SPECIALIZE nonNegative :: Word16 -> Builder #-}+{-# SPECIALIZE nonNegative :: Word32 -> Builder #-}+{-# SPECIALIZE nonNegative :: Word64 -> Builder #-}+nonNegative = go where go n | n < 10 = digit n | otherwise = go (n `quot` 10) `mappend` digit (n `rem` 10)
blaze-textual.cabal view
@@ -1,5 +1,5 @@ name: blaze-textual-version: 0.2.0.1+version: 0.2.0.2 license: BSD3 license-file: LICENSE category: Text@@ -23,27 +23,40 @@ description: operate in developer mode default: False +flag native+ description: use slow native code for double conversion+ default: False+ library exposed-modules: Blaze.Text Blaze.Text.Double Blaze.Text.Int + if flag(native)+ other-modules: Blaze.Text.Double.Native+ build-depends: base == 4.*, blaze-builder >= 0.2.1.4, bytestring,- double-conversion >= 0.2.0.1, ghc-prim, old-locale, text >= 0.11.0.2, time, vector + if !flag(native)+ build-depends:+ double-conversion >= 0.2.0.1+ if flag(developer) ghc-options: -Werror ghc-prof-options: -auto-all + if flag(native)+ cpp-options: -DNATIVE+ ghc-options: -Wall if impl(ghc >= 6.11)@@ -53,6 +66,21 @@ if impl(ghc >= 6.9) && impl(ghc < 6.11) cpp-options: -DINTEGER_GMP build-depends: integer >= 0.1 && < 0.2++test-suite tests+ type: exitcode-stdio-1.0+ hs-source-dirs: tests+ main-is: QC.hs+ ghc-options: -Wall -threaded -rtsopts+ build-depends:+ QuickCheck >= 2.4.0.1,+ base,+ blaze-builder,+ blaze-textual,+ bytestring,+ double-conversion,+ test-framework >= 0.3.3 && < 0.5,+ test-framework-quickcheck2 >= 0.2.9 && < 0.3 source-repository head type: git