Commits

Bryan O'Sullivan  committed a6bb084

Improve encoding performance for integers by 3x

  • Participants
  • Parent commits 0a7f329

Comments (0)

Files changed (3)

File Data/Aeson/Encode.hs

 
 import Blaze.ByteString.Builder
 import Blaze.ByteString.Builder.Char.Utf8
+import Data.Aeson.Encode.Number (fromNumber)
 import Data.Aeson.Types (ToJSON(..), Value(..))
-import Data.Attoparsec.Number (Number(..))
 import Data.Monoid (mappend)
 import Numeric (showHex)
 import qualified Data.ByteString.Lazy.Char8 as L
 import qualified Data.Map as M
 import qualified Data.Text as T
 import qualified Data.Vector as V
-import qualified Text.Show.ByteString as S
 
 -- | Encode a JSON value to a 'Builder'.
 fromValue :: Value -> Builder
 fromValue Null = fromByteString "null"
 fromValue (Bool b) = fromByteString $ if b then "true" else "false"
-fromValue (Number (I n)) = fromLazyByteString (S.show n)
-fromValue (Number (D n)) = fromLazyByteString (S.show n)
+fromValue (Number n) = fromNumber n
 fromValue (String s) = string s
 fromValue (Array v)
     | V.null v = fromByteString "[]"

File Data/Aeson/Encode/Number.hs

+{-# LANGUAGE BangPatterns, CPP, MagicHash, UnboxedTuples #-}
+
+-- Module:      Data.Aeson.Encode.Number
+-- Copyright:   (c) 2011 MailRank, Inc.
+-- License:     Apache
+-- Maintainer:  Bryan O'Sullivan <bos@mailrank.com>
+-- Stability:   experimental
+-- Portability: portable
+--
+-- Efficiently serialize a numeric JSON value as a lazy 'L.ByteString'.
+
+module Data.Aeson.Encode.Number
+    (
+      fromNumber
+    ) where
+
+import Data.Monoid (mappend, mempty)
+import Data.Attoparsec.Number (Number(..))
+import Blaze.ByteString.Builder
+import GHC.Num (quotRemInt, quotRemInteger)
+import GHC.Types (Int(..))
+import qualified Text.Show.ByteString as S
+
+#ifdef  __GLASGOW_HASKELL__
+# if __GLASGOW_HASKELL__ < 611
+import GHC.Integer.Internals
+# else
+import GHC.Integer.GMP.Internals
+# endif
+#endif
+
+fromNumber :: Number -> Builder
+fromNumber (I i) = integer i
+fromNumber (D d) = fromLazyByteString (S.show d)
+
+integer :: Integer -> Builder
+integer (S# i#) = int (I# i#)
+integer i
+    | i < 0     = fromWord8 45 `mappend` go (-i)
+    | otherwise = go i
+  where
+    go n | n < maxInt = int (fromInteger n)
+         | otherwise  = putH (splitf (maxInt * maxInt) n)
+
+    splitf :: Integer -> Integer -> [Integer]
+    splitf p n
+      | p > n     = [n]
+      | otherwise = splith p (splitf (p*p) n)
+
+    splith :: Integer -> [Integer] -> [Integer]
+    splith _ [    ] = error "splith: the impossible happened."
+    splith p (n:ns) = case n `quotRemInteger` p of
+#ifdef INTEGER_GMP
+      (# q, r #) ->
+#else
+      (q, r) -> 
+#endif
+              if q > 0
+                then q : r : splitb p ns
+                else r : splitb p ns
+    splitb :: Integer -> [Integer] -> [Integer]
+    splitb _ [    ] = []
+    splitb p (n:ns) = case n `quotRemInteger` p of
+#ifdef INTEGER_GMP
+      (# q, r #) ->
+#else
+      (q, r) ->
+#endif
+                q : r : splitb p ns
+
+int :: Int -> Builder
+int i
+    | i < 0     = fromWord8 45 `mappend` go (-i)
+    | otherwise = go i
+  where
+    go n | n < 10    = digit n
+         | otherwise = go (n `rem` 10) `mappend` digit (n `quot` 10)
+
+digit :: Int -> Builder
+digit n = fromWord8 (fromIntegral n + 48)
+
+data T = T !Integer !Int
+
+fstT :: T -> Integer
+fstT (T a _) = a
+
+maxInt :: Integer
+maxDigits :: Int
+T maxInt maxDigits =
+    until ((>mi) . (*10) . fstT) (\(T n d) -> T (n*10) (d+1)) (T 10 1)
+  where mi = fromIntegral (maxBound :: Int)
+
+putH :: [Integer] -> Builder
+putH (n:ns) = case n `quotRemInteger` maxInt of
+#ifdef INTEGER_GMP
+  (# q', r' #) ->
+#else
+  (q', r') ->
+#endif
+    let q = fromInteger q'
+        r = fromInteger r'
+    in if q > 0
+       then int q `mappend` pblock r `mappend` putB ns
+       else int r `mappend` putB ns
+putH _ = error "putH: the impossible happened"
+
+putB :: [Integer] -> Builder
+putB (n:ns) = case n `quotRemInteger` maxInt of
+#ifdef INTEGER_GMP
+  (# q', r' #) ->
+#else
+  (q', r') ->
+#endif
+    let q = fromInteger q'
+        r = fromInteger r'
+    in pblock q `mappend` pblock r `mappend` putB ns
+putB _ = mempty
+
+pblock :: Int -> Builder
+pblock = go maxDigits
+  where
+    go !d !n
+        | d == 1    = digit n
+        | otherwise = go (d-1) q `mappend` digit r
+        where (q, r) = n `quotRemInt` 10
     Data.Aeson.Types
 
   other-modules:
+    Data.Aeson.Encode.Number
     Data.Aeson.Functions
 
   build-depends:
     bytestring-show,
     containers,
     deepseq,
+    ghc-prim,
     hashable,
+    integer-gmp,
     monads-fd,
     old-locale,
     syb,
 
   ghc-options:      -Wall
 
+  if impl(ghc >= 6.11)
+    cpp-options: -DINTEGER_GMP
+    build-depends: integer-gmp >= 0.2 && < 0.3
+
+  if impl(ghc >= 6.9) && impl(ghc < 6.11)
+    cpp-options: -DINTEGER_GMP
+    build-depends: integer >= 0.1 && < 0.2
+
 source-repository head
   type:     git
   location: http://github.com/mailrank/aeson