on master help sign in
Add options to control inlining using deriveSerializeWith
commit81027f9096d7e8a488d0dee9e931984ff686a01b authorAdithya Kumar <adithya@composewell.com> dateFri 1 Sep 2023, 11:30 (3 years ago) parent9f7b45d
1 file changed+22−13
core/src/Streamly/Internal/Data/Serialize/TH.hs+22−13
core/src/Streamly/Internal/Data/Serialize/TH.hs+22−13
@@ -318,6 +318,7 @@ mkSerializeExpr headTy cons =
318318-- Usage:
319319-- @
320320-- $(deriveSerializeInternal
321+-- defaultSerializeTHConfig
321322-- [AppT (ConT ''Serialize) (VarT (mkName "b"))]
322323-- (AppT
323324-- (AppT (ConT ''CustomDataType) (VarT (mkName "a")))
@@ -331,17 +332,18 @@ mkSerializeExpr headTy cons =
331332-- [(Nothing, (ConT ''Bool)), (Nothing, (VarT (mkName "b")))]
332333-- ])
333334-- @
334−deriveSerializeInternal :: Cxt -> Type -> [DataCon] -> Q [Dec]
335−deriveSerializeInternal preds headTy cons = do
335+deriveSerializeInternal ::
336+ SerializeTHConfig -> Cxt -> Type -> [DataCon] -> Q [Dec]
337+deriveSerializeInternal (SerializeTHConfig{..}) preds headTy cons = do
336338 sizeOfMethod <- mkSizeOfExpr headTy cons
337339 peekMethod <- mkDeserializeExpr headTy cons
338340 pokeMethod <- mkSerializeExpr headTy cons
339341 let methods =
340342 -- INLINE on sizeOf actually worsens some benchmarks, and improves
341343 -- none
342− [ -- PragmaD (InlineP 'size Inlinable FunLike AllPhases)
343− FunD 'size [Clause [] (NormalB sizeOfMethod) []]
344− , PragmaD (InlineP 'deserialize Inline FunLike AllPhases)
344+ [ PragmaD (InlineP 'size inlineSize FunLike AllPhases)
345+ , FunD 'size [Clause [] (NormalB sizeOfMethod) []]
346+ , PragmaD (InlineP 'deserialize inlineDeserialize FunLike AllPhases)
345347 , FunD
346348 'deserialize
347349 [ Clause
@@ -351,7 +353,7 @@ deriveSerializeInternal preds headTy cons = do
351353 (NormalB peekMethod)
352354 []
353355 ]
354− , PragmaD (InlineP 'serialize Inline FunLike AllPhases)
356+ , PragmaD (InlineP 'serialize inlineSerialize FunLike AllPhases)
355357 , FunD
356358 'serialize
357359 [ Clause
@@ -403,13 +405,13 @@ data SerializeTHConfig =
403405 -- @
404406 --
405407 -- @f@ is replaced with 'Identity' and becomes unconstrained.
406−{-
407408 , inlineSize :: Inline
408− -- ^ Inline value for 'size'.
409+ -- ^ Inline value for 'size'. Default is Inline.
409410 , inlineSerialize :: Inline
410− -- ^ Inline value for 'serialize'.
411+ -- ^ Inline value for 'serialize'. Default is Inline.
411412 , inlineDeserialize :: Inline
412− -- ^ Inline value for 'deserialize'.
413+ -- ^ Inline value for 'deserialize'. Default is Inline.
414+{-
413415 , constructorTagAsString :: Bool
414416 -- ^ If True, encode constructors as Latin-1 byte sequence. This
415417 -- allows addition, removal, and reordering of constructors. If False
@@ -422,19 +424,26 @@ data SerializeTHConfig =
422424 }
423425
424426defaultSerializeTHConfig :: SerializeTHConfig
425−defaultSerializeTHConfig = SerializeTHConfig {unconstrainedTypeVars = [], typeVarSubstitutions = []}
427+defaultSerializeTHConfig =
428+ SerializeTHConfig
429+ { unconstrainedTypeVars = []
430+ , typeVarSubstitutions = []
431+ , inlineSize = Inline
432+ , inlineSerialize = Inline
433+ , inlineDeserialize = Inline
434+ }
426435
427436-- | Similar to 'deriveSerialize,' but take a 'SerializeTHConfig' to control how
428437-- the instance is generated.
429438--
430439-- Usage: @$(deriveSerializeWith config ''CustomDataType)@
431440deriveSerializeWith :: SerializeTHConfig -> Name -> Q [Dec]
432−deriveSerializeWith (SerializeTHConfig {..}) name = do
441+deriveSerializeWith conf@(SerializeTHConfig {..}) name = do
433442 dt <- reifyDataType name
434443 let preds = map (unboxPred . VarT) (filterOutVars (dtTvs dt))
435444 headTy = appsT (ConT name) (map substituteVar (dtTvs dt))
436445 cons = dtCons dt
437− deriveSerializeInternal preds headTy cons
446+ deriveSerializeInternal conf preds headTy cons
438447
439448 where
440449 allUnconstrainedTypeVars =