on master help sign in
Add a dumb usage of recordSyntaxWithHeader option in Serialize.TH
commitde89f36b3bc8d520108b90bbcd20654cd4021b55 authorAdithya Kumar <adithya@composewell.com> dateWed 13 Sep 2023, 12:58 (3 years ago) parenta27e20d
1 file changed+29−12
core/src/Streamly/Internal/Data/Serialize/TH.hs+29−12
core/src/Streamly/Internal/Data/Serialize/TH.hs+29−12
@@ -79,8 +79,8 @@ conEncLen cname = getNameBaseLen cname + 1
7979-- Size
8080--------------------------------------------------------------------------------
8181
82−mkSizeOfExpr :: Bool -> TypeOfType -> Q Exp
83−mkSizeOfExpr True tyOfTy =
82+mkSizeOfExpr :: Bool -> Bool -> TypeOfType -> Q Exp
83+mkSizeOfExpr True False tyOfTy =
8484 case tyOfTy of
8585 UnitType cname ->
8686 lamE
@@ -109,7 +109,7 @@ mkSizeOfExpr True tyOfTy =
109109 [varP _acc, varP _x]
110110 (caseE (varE _x) (fmap (matchCons acc) cons))
111111
112−mkSizeOfExpr False tyOfTy =
112+mkSizeOfExpr False False tyOfTy =
113113 case tyOfTy of
114114 UnitType _ -> lamE [varP _acc, wildP] [|$(varE _acc) + 1|]
115115 TheType con ->
@@ -146,10 +146,16 @@ mkSizeOfExpr False tyOfTy =
146146 [varP _acc, varP _x]
147147 (caseE (varE _x) (fmap (matchCons acc) cons))
148148
149+mkSizeOfExpr _ _ _ = errorUnimplemented
150+
149151mkSizeDec :: Config -> Type -> [DataCon] -> Q [Dec]
150152mkSizeDec (Config {..}) headTy cons = do
151153 -- INLINE on sizeOf actually worsens some benchmarks, and improves none
152− sizeOfMethod <- mkSizeOfExpr constructorTagAsString (typeOfType headTy cons)
154+ sizeOfMethod <-
155+ mkSizeOfExpr
156+ constructorTagAsString
157+ recordSyntaxWithHeader
158+ (typeOfType headTy cons)
153159 pure
154160 [ PragmaD (InlineP 'size inlineSize FunLike AllPhases)
155161 , FunD 'size [Clause [] (NormalB sizeOfMethod) []]
@@ -159,8 +165,8 @@ mkSizeDec (Config {..}) headTy cons = do
159165-- Peek
160166--------------------------------------------------------------------------------
161167
162−mkDeserializeExpr :: Bool -> Type -> TypeOfType -> Q Exp
163−mkDeserializeExpr True headTy tyOfTy =
168+mkDeserializeExpr :: Bool -> Bool -> Type -> TypeOfType -> Q Exp
169+mkDeserializeExpr True False headTy tyOfTy =
164170 case tyOfTy of
165171 UnitType cname -> deserializeConsExpr [SimpleDataCon cname []]
166172 TheType con -> deserializeConsExpr [con]
@@ -194,7 +200,7 @@ mkDeserializeExpr True headTy tyOfTy =
194200 [|let $(varP (makeI 0)) = $(varE off) + $(litIntegral lenCname)
195201 in $(mkDeserializeExprOne 'deserialize con)|]
196202
197−mkDeserializeExpr False headTy tyOfTy =
203+mkDeserializeExpr False False headTy tyOfTy =
198204 case tyOfTy of
199205 -- Unit constructor
200206 UnitType cname ->
@@ -232,10 +238,16 @@ mkDeserializeExpr False headTy tyOfTy =
232238 $(lift (pprint headTy)) ++ ")")|])
233239 []
234240
241+mkDeserializeExpr _ _ _ _ = errorUnimplemented
242+
235243mkDeserializeDec :: Config -> Type -> [DataCon] -> Q [Dec]
236244mkDeserializeDec (Config {..}) headTy cons = do
237245 peekMethod <-
238− mkDeserializeExpr constructorTagAsString headTy (typeOfType headTy cons)
246+ mkDeserializeExpr
247+ constructorTagAsString
248+ recordSyntaxWithHeader
249+ headTy
250+ (typeOfType headTy cons)
239251 pure
240252 [ PragmaD (InlineP 'deserialize inlineDeserialize FunLike AllPhases)
241253 , FunD
@@ -260,8 +272,8 @@ mkSerializeExprTag tagType tagVal =
260272 $(varE _arr)
261273 $((sigE (litE (IntegerL (fromIntegral tagVal))) (conT tagType)))|]
262274
263−mkSerializeExpr :: Bool -> TypeOfType -> Q Exp
264−mkSerializeExpr True tyOfTy =
275+mkSerializeExpr :: Bool -> Bool -> TypeOfType -> Q Exp
276+mkSerializeExpr True False tyOfTy =
265277 case tyOfTy of
266278 -- Unit type
267279 UnitType cname ->
@@ -293,7 +305,7 @@ mkSerializeExpr True tyOfTy =
293305 , noBindS (mkSerializeExprFields 'serialize fields)
294306 ])
295307
296−mkSerializeExpr False tyOfTy =
308+mkSerializeExpr False False tyOfTy =
297309 case tyOfTy of
298310 -- Unit type
299311 UnitType _ -> [|pure ($(varE _initialOffset) + 1)|]
@@ -328,10 +340,15 @@ mkSerializeExpr False tyOfTy =
328340 ]))
329341 (zip [0 ..] cons))
330342
343+mkSerializeExpr _ _ _ = errorUnimplemented
344+
331345mkSerializeDec :: Config -> Type -> [DataCon] -> Q [Dec]
332346mkSerializeDec (Config {..}) headTy cons = do
333347 pokeMethod <-
334− mkSerializeExpr constructorTagAsString (typeOfType headTy cons)
348+ mkSerializeExpr
349+ constructorTagAsString
350+ recordSyntaxWithHeader
351+ (typeOfType headTy cons)
335352 pure
336353 [ PragmaD (InlineP 'serialize inlineSerialize FunLike AllPhases)
337354 , FunD