f7f42e0 · streamly · git.iko.soy

git.iko.soy/streamly

on master help sign in

Improve "size" op performance in Serialize

f7f42e0Harendra Kumar3 years ago

benchmark/Streamly/Benchmark/Data/Serialize.hs+4−5

compare with master

unifiedsplit

@@ -208,8 +208,7 @@ getSize _ = sizeOf (Proxy :: Proxy a)

208#else

209getSize val =

210 case size :: Size a of

211− ConstSize x -> x

212− VarSize f -> f val

211+ Size f -> f 0 val

213#endif

212#endif

214

213

215#ifndef USE_UNBOX

214#ifndef USE_UNBOX

@@ -422,7 +421,7 @@ main = do

422 -- Approximately 100000 constructors

421 -- Approximately 100000 constructors

423 -- Assuming Leaf nodes constitute two constructors (Leaf, Int) and internal

422 -- Assuming Leaf nodes constitute two constructors (Leaf, Int) and internal

424 -- nodes 1 level = log_2 (100001/3) + 1 = 16

423 -- nodes 1 level = log_2 (100001/3) + 1 = 16

425− !tInt <- force <$> mkBinTree 16

424+ !(tInt :: BinTree Int) <- force <$> mkBinTree 16

426

425

427 -- Approximately 100000 constructors, assuming two constructors (Cons, Int)

426 -- Approximately 100000 constructors, assuming two constructors (Cons, Int)

428 -- per element.

427 -- per element.

@@ -442,14 +441,14 @@ main = do

442 -- Enable one benchmark below, and run the benchmark

441 -- Enable one benchmark below, and run the benchmark

443 -- Check the .dump-simpl output

442 -- Check the .dump-simpl output

444 let value = 100000

443 let value = 100000

444+ -- print $ getSize (CDT1C3 4 2)

445 -- peekTimes ((CDT1C2 (5 :: Int)) :: CustomDT1) value

446 -- peekTimes (Sum2525) value

447 -- peekTimes (Product25 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25) value

448 -- !(tInt :: BinTree Int) <- force <$> mkBinTree 16

449 -- print $ sizeOfOnce tInt

450+ print $ sizeOfOnce lInt

450 -- peekTimes tInt 1

451 -- peekTimes tInt 1

451 -- roundtrip ((CDT1C2 (5 :: Int)) :: CustomDT1) value

452 -- roundtrip ((CDT1C2 (5 :: Int)) :: CustomDT1) value

452− let !n = getSize lEnum

453− in peekTimes n lEnum 1

454 return ()

453 return ()

455#endif

454#endif

core/src/Streamly/Internal/Data/Serialize.hs+14−25

@@ -39,11 +39,10 @@ import GHC.Exts

39-- Types

40--------------------------------------------------------------------------------

42−-- | Info about the length of a serializable type. Length can depend on the

42+-- XXX Use (a -> Sum Int) instead, remove the Size type

43−-- value or can be independent.

43+

44−data Size a

44+-- | A left fold step to fold a generic structure to its serializable size.

45− = VarSize (a -> Int)

45+newtype Size a = Size (Int -> a -> Int) -- a left fold or Sum monoid

46− | ConstSize !Int

48-- | A type implementing the 'Serialize' interface supplies operations for

47-- | A type implementing the 'Serialize' interface supplies operations for

49-- reading and writing the type from and to a mutable byte array (an unboxed

48-- reading and writing the type from and to a mutable byte array (an unboxed

@@ -63,8 +62,8 @@ data Size a

63--

62--

64-- >>> :{

63-- >>> :{

65-- data Object = Object

64-- data Object = Object

66−-- { _varLen :: [Int]

65+-- { _obj1 :: [Int]

67−-- , _constLen :: Int

66+-- , _obj2 :: Int

68-- }

67-- }

69-- :}

68-- :}

70--

69--

@@ -72,10 +71,9 @@ data Size a

72-- instance Serialize Object where

71-- instance Serialize Object where

73-- size =

72-- size =

74-- case (size :: Size [Int], size :: Size Int) of

73-- case (size :: Size [Int], size :: Size Int) of

75−-- (VarSize f, ConstSize g) ->

74+-- (Size f, Size g) ->

76−-- VarSize $ \obj ->

75+-- Size $ \acc obj ->

77−-- f (_varLen obj) + g

76+-- acc + f 0 (_obj1 obj) + g 0 (_obj2 obj)

78−-- _ -> error "size is not defined properly"

79-- deserialize i arr = do

77-- deserialize i arr = do

80-- (i1, x0) <- deserialize i arr

78-- (i1, x0) <- deserialize i arr

81-- (i2, x1) <- deserialize i1 arr

79-- (i2, x1) <- deserialize i1 arr

@@ -110,7 +108,7 @@ class Serialize a where

110#define DERIVE_SERIALIZE_FROM_UNBOX(_type) \

108#define DERIVE_SERIALIZE_FROM_UNBOX(_type) \

111instance Serialize _type where \

109instance Serialize _type where \

112; {-# INLINE size #-} \

110; {-# INLINE size #-} \

113−; size = ConstSize $ Unbox.sizeOf (Proxy :: Proxy _type) \

111+; size = Size (\acc _ -> acc + Unbox.sizeOf (Proxy :: Proxy _type)) \

114; {-# INLINE deserialize #-} \

112; {-# INLINE deserialize #-} \

115; deserialize off arr = \

113; deserialize off arr = \

116 Unbox.peekByteIndex off arr >>= \

114 Unbox.peekByteIndex off arr >>= \

@@ -142,18 +140,10 @@ DERIVE_SERIALIZE_FROM_UNBOX((FunPtr a))

142

140

143instance forall a. Serialize a => Serialize [a] where

141instance forall a. Serialize a => Serialize [a] where

144

142

145− {-# INLINE size #-}

143+ -- {-# INLINE size #-}

146− size = VarSize $ \lst ->

144+ size = Size $ \acc xs ->

147 case size :: Size a of

145 case size :: Size a of

148− VarSize f ->

149− foldl'

150− (\acc x -> acc + f x)

151− (Unbox.sizeOf (Proxy :: Proxy Int))

146+ Size f -> foldl' f (acc + (Unbox.sizeOf (Proxy :: Proxy Int))) xs

152− lst

153− ConstSize sz ->

154− length lst

155− * sz

156− + Unbox.sizeOf (Proxy :: Proxy Int)

157

147

158 {-# INLINE deserialize #-}

148 {-# INLINE deserialize #-}

159 deserialize off arr = do

149 deserialize off arr = do

@@ -185,8 +175,7 @@ encodeAs ps a =

185 unsafeInlineIO $ do

175 unsafeInlineIO $ do

186 let len =

176 let len =

187 case size :: Size a of

177 case size :: Size a of

188− ConstSize sz -> sz

178+ Size f -> f 0 a

189− VarSize f -> f a

190 -- We encode the length of the encoding as a header hence the 8 extra

179 -- We encode the length of the encoding as a header hence the 8 extra

191 -- bytes to encode Int64

180 -- bytes to encode Int64

192 mbarr <- Unbox.newBytesAs ps (8 + len)

181 mbarr <- Unbox.newBytesAs ps (8 + len)

core/src/Streamly/Internal/Data/Serialize/TH.hs+42−35

@@ -17,6 +17,7 @@ module Streamly.Internal.Data.Serialize.TH

17-- Imports

18--------------------------------------------------------------------------------

20+import Data.List (foldl')

20import Data.Word (Word16, Word32, Word64, Word8)

21import Data.Word (Word16, Word32, Word64, Word8)

22import Language.Haskell.TH

23import Language.Haskell.TH

@@ -40,6 +41,9 @@ type Field = (Maybe Name, Type)

40_x :: Name

41_x :: Name

41_x = mkName "x"

42_x = mkName "x"

44+_acc :: Name

45+_acc = mkName "acc"

46+

43_arr :: Name

47_arr :: Name

44_arr = mkName "arr"

48_arr = mkName "arr"

@@ -72,22 +76,10 @@ matchConstructor cname numFields exp0 =

72 (normalB exp0)

76 (normalB exp0)

73 []

77 []

75−exprGetSize :: Int -> Type -> Q Exp

79+exprGetSize :: Q Exp -> (Int, Type) -> Q Exp

76−exprGetSize i ty =

80+exprGetSize acc (i, ty) =

77− caseE

78− (sigE (varE 'size) (appT (conT ''Size) (pure ty)))

81+ [|case size :: Size $(pure ty) of

79− [ match

80− (conP 'VarSize [varP _f])

81− (normalB (appE (varE _f) (varE (mkFieldName i))))

82+ Size f -> f $(acc) $(varE (mkFieldName i))|]

82− []

83− , match (conP 'ConstSize [varP _sz]) (normalB (varE _sz)) []

84− ]

85−

86− where

87−

88− _f = mkName $ "f"

89− _sz = mkName $ "sz"

90−

92getTagSize :: Int -> Int

84getTagSize :: Int -> Int

93getTagSize numConstructors

85getTagSize numConstructors

@@ -123,16 +115,23 @@ mkSizeOfExpr headTy constructors =

123 ("Attempting to get size with no constructors (" ++

115 ("Attempting to get size with no constructors (" ++

124 $(lift (pprint headTy)) ++ ")")|]

116 $(lift (pprint headTy)) ++ ")")|]

125 -- One constructor with no fields is a unit type. Size of a unit type is

117 -- One constructor with no fields is a unit type. Size of a unit type is

126− -- 1.

118+ -- 1. XXX Use isUnitType?

127 [constructor@(DataCon _ _ _ fields)] ->

119 [constructor@(DataCon _ _ _ fields)] ->

128 case fields of

120 case fields of

129− [] -> appE (conE 'ConstSize) (litE (IntegerL 1))

121+ -- Unit type

122+ [] ->

123+ appE

124+ (conE 'Size)

125+ (lamE [varP _acc, wildP] [| $(varE _acc) + 1 |])

126+ -- Product type

130 _ ->

127 _ ->

131 appE

128 appE

132− (conE 'VarSize)

129+ (conE 'Size)

133 (lamE

130 (lamE

134− [varP _x]

131+ [varP _acc, varP _x]

132+ (caseE (varE _x)

135− (caseE (varE _x) [matchCons constructor]))

133+ [matchCons (varE _acc) constructor]))

134+ -- Sum type

136 _ -> sizeOfHeadDt

135 _ -> sizeOfHeadDt

137

136

138 where

137 where

@@ -140,22 +139,30 @@ mkSizeOfExpr headTy constructors =

140 tagSizeExp =

139 tagSizeExp =

141 litE (IntegerL (fromIntegral (getTagSize (length constructors))))

140 litE (IntegerL (fromIntegral (getTagSize (length constructors))))

142

141

143− sizeOfField (i, (_, ty)) = exprGetSize i ty

142+ -- XXX fields of the same type can be folded together, will reduce the code

144−

143+ -- size when there are many fields of the same type.

145− sizeOfFields fields =

144+ -- XXX const size fields can be calculated statically.

145+ -- XXX This can result in large compilation times due to nesting when there

146+ -- are many constructors. We can create a list and sum the list at run time

147+ -- to avoid that depending on the number of constructors. Or using a let

148+ -- statement for each case may help?

146− appE (varE 'sum) (listE (map sizeOfField (zip [0..] fields)))

149+ -- appE (varE 'sum) (listE (acc : map (exprGetSize (litE (IntegerL 0))) (zip [0..] fields)))

147−

150+ sizeOfFields acc fields =

151+ foldl' exprGetSize acc $ zip [0..] fields

152+

148− matchCons (DataCon cname _ _ fields) =

153+ matchCons acc (DataCon cname _ _ fields) =

154+ let expr = sizeOfFields acc (map snd fields)

149− matchConstructor cname (length fields) (sizeOfFields fields)

155+ in matchConstructor cname (length fields) expr

150

156

151 -- XXX We fix VarSize for simplicity. Should be changed later.

157 -- XXX We fix VarSize for simplicity. Should be changed later.

152 sizeOfHeadDt =

158 sizeOfHeadDt =

153− appE

159+ let acc = [|$(varE _acc) + $(tagSizeExp)|]

154− (conE 'VarSize)

160+ f =

155− (lamE

161+ (lamE

156− [varP _x]

162+ [varP _acc, varP _x]

157− [|$(tagSizeExp)

158− + $(caseE (varE _x) (fmap matchCons constructors))|])

163+ (caseE (varE _x) (fmap (matchCons acc) constructors))

164+ )

165+ in appE (conE 'Size) f

159

166

160--------------------------------------------------------------------------------

167--------------------------------------------------------------------------------

161-- Peek

168-- Peek

@@ -328,7 +335,7 @@ deriveSerializeInternal preds headTy cons = do

328 let methods =

335 let methods =

329 -- INLINE on sizeOf actually worsens some benchmarks, and improves

336 -- INLINE on sizeOf actually worsens some benchmarks, and improves

330 -- none

337 -- none

331− [ -- PragmaD (InlineP 'size Inline FunLike AllPhases)

338+ [ -- PragmaD (InlineP 'size Inlinable FunLike AllPhases)

332 FunD 'size [Clause [] (NormalB sizeOfMethod) []]

339 FunD 'size [Clause [] (NormalB sizeOfMethod) []]

333 , PragmaD (InlineP 'deserialize Inline FunLike AllPhases)

340 , PragmaD (InlineP 'deserialize Inline FunLike AllPhases)

334 , FunD

341 , FunD

test/Streamly/Test/Data/Serialize.hs+6−4

@@ -59,9 +59,12 @@ roundtrip val = do

60 let sz =

61 case Serialize.size :: Serialize.Size a of

62− Serialize.VarSize f -> f val

62+ Serialize.Size f -> f 0 val

63− Serialize.ConstSize csz -> csz

64+ -- putStrLn "----------------------------------------------------------------"

65+ -- putStrLn $ show val

66+ -- putStrLn $ "Size is: " ++ show sz

67+ -- putStrLn "----------------------------------------------------------------"

65 arr <- newBytes sz

68 arr <- newBytes sz

67 off1 <- Serialize.serialize 0 arr val

70 off1 <- Serialize.serialize 0 arr val

@@ -78,8 +81,7 @@ testSerializeList sizeOfA val = do

79 let sz =

82 let sz =

80 case Serialize.size :: Serialize.Size a of

83 case Serialize.size :: Serialize.Size a of

81− Serialize.VarSize f -> f val

84+ Serialize.Size f -> f 0 val

82− Serialize.ConstSize csz -> csz

84 sz `shouldBe` sizeOfA

86 sz `shouldBe` sizeOfA

test/Streamly/Test/Data/Unbox.hs+1−2

@@ -181,8 +181,7 @@ variableSizeOf ::

181 -> Int

182variableSizeOf val =

183 case size :: Size a of

184− ConstSize x -> x

185− VarSize f -> f val

184+ Size f -> f 0 val

186#endif

185#endif

187

186

188testSerialization ::

187testSerialization ::