Commits

basvandijk committed 0027f76

Improved performance of generic parseJSON of products even further
Improved by a factor of 4.4 (on the BigProduct benchmark)
Now we are faster than TH!

Comments (0)

Files changed (1)

Data/Aeson/Types/Internal.hs

 import Control.Monad.State.Strict
 import Data.Aeson.Functions
 import Data.Attoparsec.Char8 (Number(..))
+import Data.Bits (shiftR)
 import Data.Data (Data)
 import Data.Hashable (Hashable(..))
 import Data.Int (Int8, Int16, Int32, Int64)
 instance ( GFromProduct a, GFromProduct b
          , ProductSize a, ProductSize b) => GFromJSON (a :*: b) where
     gParseJSON (Array arr)
-        | lenArray == lenProduct = gParseProduct arr
+        | lenArray == lenProduct = gParseProduct arr 0 lenProduct
         | otherwise =
             fail $ "When expecting a product of " ++ show lenProduct ++
                    " values, encountered an Array of " ++ show lenArray ++
 --------------------------------------------------------------------------------
 
 class GFromProduct f where
-    gParseProduct :: Array -> Parser (f a)
+    gParseProduct :: Array -> Int -> Int -> Parser (f a)
 
 instance (GFromProduct a, GFromProduct b) => GFromProduct (a :*: b) where
-    gParseProduct arr = (:*:) <$> gParseProduct arrL <*> gParseProduct arrR
+    gParseProduct arr ix len = (:*:) <$> gParseProduct arr ix  lenL
+                                     <*> gParseProduct arr ixR lenR
         where
-          (arrL, arrR) = V.splitAt (V.length arr `div` 2) arr
+          lenL = len `shiftR` 1
+          ixR  = ix + lenL
+          lenR = len - lenL
     {-# INLINE gParseProduct #-}
 
 instance (GFromJSON a) => GFromProduct (S1 s a) where
-    gParseProduct arr = gParseJSON $ V.unsafeIndex arr 0
+    gParseProduct arr ix _ = gParseJSON $ V.unsafeIndex arr ix
     {-# INLINE gParseProduct #-}
 
 --------------------------------------------------------------------------------