git.iko.soy/typeable/aeson
on master help sign in
Improve the performance of Double rendering by about 23%
8ab11d9Bryan O'Sullivan
Data/Aeson/Encode/Double.hsnew file+99
compare with master
unifiedsplit
@@ -0,0 +1,99 @@
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 GHC.Float
18+
19+import Data.ByteString.Char8 ()
20+import Data.Monoid
21+import Data.Aeson.Encode.Int
22+import Blaze.ByteString.Builder
23+import Blaze.ByteString.Builder.Char8
24+
25+double :: Double -> Builder
26+double = showpGFloat Nothing
27+
28+-- | Show a signed RealFloat value using decimal notation when the
29+-- absolute value lies between 0.1 and 9,999,999, and scientific
30+-- notation otherwise. The optional integer can be used to specify
31+-- precision.
32+showpGFloat :: RealFloat a => Maybe Int -> a -> Builder
33+showpGFloat = putFormattedFloat FFGeneric
34+
35+-- | Show a signed RealFloat value using decimal notation. The optional
36+-- integer can be used to specify precision.
37+showpFFloat :: RealFloat a => Maybe Int -> a -> Builder
38+showpFFloat = putFormattedFloat FFFixed
39+
40+-- | Show a signed RealFloat value using scientific (exponential) notation.
41+-- The optional integer can be used to specify precision.
42+showpEFloat :: RealFloat a => Maybe Int -> a -> Builder
43+showpEFloat = putFormattedFloat FFExponent
44+
45+putFormattedFloat :: RealFloat a => FFFormat -> Maybe Int -> a -> Builder
46+putFormattedFloat fmt decs f
47+ | isNaN f = fromChar 'N' `mappend` fromChar 'a' `mappend` fromChar 'N'
48+ | isInfinite f = fromByteString (if f < 0 then "-Infinity" else "Infinity")
49+ | f < 0 || isNegativeZero f = fromChar '-' `mappend` go fmt (floatToDigits (toInteger base) (-f))
50+ | otherwise = go fmt (floatToDigits (toInteger base) f)
51+ where
52+ base = 10
53+
54+ go FFGeneric p@(_,e)
55+ | e < 0 || e > 7 = go FFExponent p
56+ | otherwise = go FFFixed p
57+ go FFExponent (is, e) =
58+ case decs of
59+ Nothing -> case is of
60+ [] -> error "putFormattedFloat"
61+ [0] -> fromByteString "0.0e0"
62+ [d] -> digit d `mappend` fromByteString ".0e" `mappend` int (e-1)
63+ (d:ds) -> digit d `mappend` fromChar '.' `mappend` mconcat (map digit ds)
64+ `mappend` fromChar 'e' `mappend` int (e-1)
65+ Just dec ->
66+ let dec' = max dec 1 in
67+ case is of
68+ [0] -> fromChar '0' `mappend` fromChar '.' `mappend` mconcat (replicate dec' (fromChar '0'))
69+ `mappend` fromChar 'e' `mappend` fromChar '0'
70+ _ ->
71+ let (ei, is') = roundTo base (dec'+1) is
72+ (d:ds) = if ei > 0 then init is' else is'
73+ in digit d `mappend` fromChar '.' `mappend` mconcat (map digit ds)
74+ `mappend` fromChar 'e' `mappend` int (e - 1 + ei)
75+ go FFFixed (is, e) = case decs of
76+ Nothing
77+ | e <= 0 -> fromChar '0' `mappend` fromChar '.' `mappend` mconcat (replicate (-e) (fromChar '0'))
78+ `mappend` mconcat (map digit is)
79+ | otherwise -> let g 0 rs = fromChar '.' `mappend` mk0 rs
80+ g n [] = fromChar '0' `mappend` g (n-1) []
81+ g n (r:rs) = digit r `mappend` g (n-1) rs
82+ in g e is
83+ Just dec ->
84+ let dec' = max dec 0 in
85+ if e >= 0 then
86+ let (ei, is') = roundTo base (dec' + e) is
87+ (ls,rs) = splitAt (e+ei) is'
88+ in if null ls
89+ then mk0 ls
90+ else mk0 ls `mappend` (fromChar '.' `mappend` mconcat (map digit rs))
91+ else
92+ let (ei, is') = roundTo base dec' (replicate (-e) 0 ++ is)
93+ d:ds = if ei > 0 then is' else 0:is'
94+ in if null ds
95+ then digit d
96+ else digit d `mappend` (fromChar '.' `mappend` mconcat (map digit ds))
97+
98+ mk0 [] = fromChar '0'
99+ mk0 rs = mconcat (map digit rs)
Data/Aeson/Encode/Int.hsnew file+34
@@ -0,0 +1,34 @@
1+{-# LANGUAGE BangPatterns, CPP, MagicHash, UnboxedTuples #-}
2+
3+-- Module: Data.Aeson.Encode.Int
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 an integral JSON value as a lazy 'L.ByteString'.
11+
12+module Data.Aeson.Encode.Int
13+ (
14+ digit
15+ , int
16+ , minus
17+ ) where
18+
19+import Blaze.ByteString.Builder
20+import Data.Monoid (mappend)
21+
22+int :: Int -> Builder
23+int i
24+ | i < 0 = minus `mappend` go (-i)
25+ | otherwise = go i
26+ where
27+ go n | n < 10 = digit n
28+ | otherwise = go (n `rem` 10) `mappend` digit (n `quot` 10)
29+
30+digit :: Int -> Builder
31+digit n = fromWord8 $! fromIntegral n + 48
32+
33+minus :: Builder
34+minus = fromWord8 45
Data/Aeson/Encode/Number.hs+3−15
@@ -16,6 +16,8 @@ module Data.Aeson.Encode.Number
16
16
17import Data.Monoid (mappend, mempty)
17import Data.Monoid (mappend, mempty)
18import Data.Attoparsec.Number (Number(..))
18import Data.Attoparsec.Number (Number(..))
19+import Data.Aeson.Encode.Double
20+import Data.Aeson.Encode.Int
19import Blaze.ByteString.Builder
21import Blaze.ByteString.Builder
20import GHC.Num (quotRemInteger)
22import GHC.Num (quotRemInteger)
21import GHC.Types (Int(..))
23import GHC.Types (Int(..))
@@ -37,7 +39,7 @@ import GHC.Integer.GMP.Internals
37
39
38fromNumber :: Number -> Builder
40fromNumber :: Number -> Builder
39fromNumber (I i) = integer i
41fromNumber (I i) = integer i
40−fromNumber (D d) = fromLazyByteString (S.show d)
42+fromNumber (D d) = double d
41
43
42integer :: Integer -> Builder
44integer :: Integer -> Builder
43integer (S# i#) = int (I# i#)
45integer (S# i#) = int (I# i#)
@@ -61,17 +63,6 @@ integer i
61 PAIR(q,r) -> q : r : splitb p ns
63 PAIR(q,r) -> q : r : splitb p ns
62 splitb _ _ = []
64 splitb _ _ = []
63
65
64−int :: Int -> Builder
65−int i
66− | i < 0 = minus `mappend` go (-i)
67− | otherwise = go i
68− where
69− go n | n < 10 = digit n
70− | otherwise = go (n `rem` 10) `mappend` digit (n `quot` 10)
71−
72−digit :: Int -> Builder
73−digit n = fromWord8 $! fromIntegral n + 48
74−
75data T = T !Integer !Int
66data T = T !Integer !Int
76
67
77fstT :: T -> Integer
68fstT :: T -> Integer
@@ -107,6 +98,3 @@ pblock = go maxDigits
107 | otherwise = go (d-1) q `mappend` digit r
98 | otherwise = go (d-1) q `mappend` digit r
108 where q = n `quot` 10
99 where q = n `quot` 10
109 r = n `rem` 10
100 r = n `rem` 10
110−
111−minus :: Builder
112−minus = fromWord8 45
aeson.cabal+2
@@ -83,6 +83,8 @@ library
83 Data.Aeson.Types
83 Data.Aeson.Types
84
84
85 other-modules:
85 other-modules:
86+ Data.Aeson.Encode.Double
87+ Data.Aeson.Encode.Int
86 Data.Aeson.Encode.Number
88 Data.Aeson.Encode.Number
87 Data.Aeson.Functions
89 Data.Aeson.Functions
88
90