a988b91 · streamly · git.iko.soy

git.iko.soy/streamly

on master help sign in

Move out creating declarations into their own functions

a988b91Adithya Kumar3 years ago

core/src/Streamly/Internal/Data/Serialize/TH.hs+48−32

compare with master

unifiedsplit

@@ -440,6 +440,15 @@ mkSizeOfExpr False tyOfTy =

440 [varP _acc, varP _x]

441 (caseE (varE _x) (fmap (matchCons acc) cons))

442

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+

443--------------------------------------------------------------------------------

452--------------------------------------------------------------------------------

444-- Peek

453-- Peek

445--------------------------------------------------------------------------------

454--------------------------------------------------------------------------------

@@ -544,6 +553,23 @@ mkDeserializeExpr False headTy tyOfTy =

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

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

545 []

554 []

546

555

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+

547--------------------------------------------------------------------------------

573--------------------------------------------------------------------------------

548-- Poke

574-- Poke

549--------------------------------------------------------------------------------

575--------------------------------------------------------------------------------

@@ -636,6 +662,23 @@ mkSerializeExpr False tyOfTy =

636 ]))

662 ]))

637 (zip [0 ..] cons))

663 (zip [0 ..] cons))

638

664

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+

639--------------------------------------------------------------------------------

682--------------------------------------------------------------------------------

640-- Main

683-- Main

641--------------------------------------------------------------------------------

684--------------------------------------------------------------------------------

@@ -672,38 +715,11 @@ mkSerializeExpr False tyOfTy =

672-- @

715-- @

673deriveSerializeInternal ::

716deriveSerializeInternal ::

674 Config -> Cxt -> Type -> [DataCon] -> Q [Dec]

717 Config -> Cxt -> Type -> [DataCon] -> Q [Dec]

675−deriveSerializeInternal (Config{..}) preds headTy cons = do

718+deriveSerializeInternal conf preds headTy cons = do

676− sizeOfMethod <- mkSizeOfExpr constructorTagAsString (typeOfType headTy cons)

719+ sizeDec <- mkSizeDec conf headTy cons

677− peekMethod <-

720+ peekDec <- mkDeserializeDec conf headTy cons

678− mkDeserializeExpr constructorTagAsString headTy (typeOfType headTy cons)

721+ pokeDec <- mkSerializeDec conf headTy cons

679− pokeMethod <-

680− mkSerializeExpr constructorTagAsString (typeOfType headTy cons)

681− let methods =

722+ let methods = concat [sizeDec, peekDec, pokeDec]

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− ]

707 return [plainInstanceD preds (AppT (ConT ''Serialize) headTy) methods]

723 return [plainInstanceD preds (AppT (ConT ''Serialize) headTy) methods]

708

724

709-- | Similar to 'deriveSerialize,' but take a 'Config' to control how

725-- | Similar to 'deriveSerialize,' but take a 'Config' to control how