@@ -440,6 +440,15 @@ mkSizeOfExpr False tyOfTy =
440440 [varP _acc, varP _x]
441441 (caseE (varE _x) (fmap (matchCons acc) cons))
442442
443+mkSizeDec :: Config -> Type -> [DataCon] -> Q [Dec]
444+mkSizeDec (Config {..}) headTy cons = do
445+ -- INLINE on sizeOf actually worsens some benchmarks, and improves none
446+ sizeOfMethod <- mkSizeOfExpr constructorTagAsString (typeOfType headTy cons)
447+ pure
448+ [ PragmaD (InlineP 'size inlineSize FunLike AllPhases)
449+ , FunD 'size [Clause [] (NormalB sizeOfMethod) []]
450+ ]
451+
443452--------------------------------------------------------------------------------
444453-- Peek
445454--------------------------------------------------------------------------------
@@ -544,6 +553,23 @@ mkDeserializeExpr False headTy tyOfTy =
544553 $(lift (pprint headTy)) ++ ")")|])
545554 []
546555
556+mkDeserializeDec :: Config -> Type -> [DataCon] -> Q [Dec]
557+mkDeserializeDec (Config {..}) headTy cons = do
558+ peekMethod <-
559+ mkDeserializeExpr constructorTagAsString headTy (typeOfType headTy cons)
560+ pure
561+ [ PragmaD (InlineP 'deserialize inlineDeserialize FunLike AllPhases)
562+ , FunD
563+ 'deserialize
564+ [ Clause
565+ (if isUnitType cons && not constructorTagAsString
566+ then [VarP _initialOffset, WildP, WildP]
567+ else [VarP _initialOffset, VarP _arr, VarP _endOffset])
568+ (NormalB peekMethod)
569+ []
570+ ]
571+ ]
572+
547573--------------------------------------------------------------------------------
548574-- Poke
549575--------------------------------------------------------------------------------
@@ -636,6 +662,23 @@ mkSerializeExpr False tyOfTy =
636662 ]))
637663 (zip [0 ..] cons))
638664
665+mkSerializeDec :: Config -> Type -> [DataCon] -> Q [Dec]
666+mkSerializeDec (Config {..}) headTy cons = do
667+ pokeMethod <-
668+ mkSerializeExpr constructorTagAsString (typeOfType headTy cons)
669+ pure
670+ [ PragmaD (InlineP 'serialize inlineSerialize FunLike AllPhases)
671+ , FunD
672+ 'serialize
673+ [ Clause
674+ (if isUnitType cons && not constructorTagAsString
675+ then [VarP _initialOffset, WildP, WildP]
676+ else [VarP _initialOffset, VarP _arr, VarP _val])
677+ (NormalB pokeMethod)
678+ []
679+ ]
680+ ]
681+
639682--------------------------------------------------------------------------------
640683-- Main
641684--------------------------------------------------------------------------------
@@ -672,38 +715,11 @@ mkSerializeExpr False tyOfTy =
672715-- @
673716deriveSerializeInternal ::
674717 Config -> Cxt -> Type -> [DataCon] -> Q [Dec]
675−deriveSerializeInternal (Config{..}) preds headTy cons = do
676− sizeOfMethod <- mkSizeOfExpr constructorTagAsString (typeOfType headTy cons)
677− peekMethod <-
678− mkDeserializeExpr constructorTagAsString headTy (typeOfType headTy cons)
679− pokeMethod <-
680− mkSerializeExpr constructorTagAsString (typeOfType headTy cons)
681− let methods =
682− -- INLINE on sizeOf actually worsens some benchmarks, and improves
683− -- none
684− [ PragmaD (InlineP 'size inlineSize FunLike AllPhases)
685− , FunD 'size [Clause [] (NormalB sizeOfMethod) []]
686− , PragmaD (InlineP 'deserialize inlineDeserialize FunLike AllPhases)
687− , FunD
688− 'deserialize
689− [ Clause
690− (if isUnitType cons && not constructorTagAsString
691− then [VarP _initialOffset, WildP, WildP]
692− else [VarP _initialOffset, VarP _arr, VarP _endOffset])
693− (NormalB peekMethod)
694− []
695− ]
696− , PragmaD (InlineP 'serialize inlineSerialize FunLike AllPhases)
697− , FunD
698− 'serialize
699− [ Clause
700− (if isUnitType cons && not constructorTagAsString
701− then [VarP _initialOffset, WildP, WildP]
702− else [VarP _initialOffset, VarP _arr, VarP _val])
703− (NormalB pokeMethod)
704− []
705− ]
706− ]
718+deriveSerializeInternal conf preds headTy cons = do
719+ sizeDec <- mkSizeDec conf headTy cons
720+ peekDec <- mkDeserializeDec conf headTy cons
721+ pokeDec <- mkSerializeDec conf headTy cons
722+ let methods = concat [sizeDec, peekDec, pokeDec]
707723 return [plainInstanceD preds (AppT (ConT ''Serialize) headTy) methods]
708724
709725-- | Similar to 'deriveSerialize,' but take a 'Config' to control how