Safe Haskell | None |
---|---|
Language | Haskell2010 |
Generating derived instance declarations
This module is nominally `subordinate'
to GHC.Tc.Deriv, which is the
`official'
interface to deriving-related things.
This is where we do all the grimy bindings' generation.
Synopsis
- type BagDerivStuff = Bag DerivStuff
- data DerivStuff
- = DerivAuxBind AuxBindSpec
- | DerivFamInst FamInst
- gen_Eq_binds :: SrcSpan -> TyCon -> TcM (LHsBinds GhcPs, BagDerivStuff)
- gen_Ord_binds :: SrcSpan -> TyCon -> TcM (LHsBinds GhcPs, BagDerivStuff)
- gen_Enum_binds :: SrcSpan -> TyCon -> TcM (LHsBinds GhcPs, BagDerivStuff)
- gen_Bounded_binds :: SrcSpan -> TyCon -> (LHsBinds GhcPs, BagDerivStuff)
- gen_Ix_binds :: SrcSpan -> TyCon -> TcM (LHsBinds GhcPs, BagDerivStuff)
- gen_Show_binds :: (Name -> Fixity) -> SrcSpan -> TyCon -> (LHsBinds GhcPs, BagDerivStuff)
- gen_Read_binds :: (Name -> Fixity) -> SrcSpan -> TyCon -> (LHsBinds GhcPs, BagDerivStuff)
- gen_Data_binds :: SrcSpan -> TyCon -> TcM (LHsBinds GhcPs, BagDerivStuff)
- gen_Lift_binds :: SrcSpan -> TyCon -> (LHsBinds GhcPs, BagDerivStuff)
- gen_Newtype_binds :: SrcSpan -> Class -> [TyVar] -> [Type] -> Type -> TcM (LHsBinds GhcPs, [LSig GhcPs], BagDerivStuff)
- mkCoerceClassMethEqn :: Class -> [TyVar] -> [Type] -> Type -> Id -> Pair Type
- genAuxBinds :: DynFlags -> SrcSpan -> BagDerivStuff -> SeparateBagsDerivStuff
- ordOpTbl :: [(Type, (RdrName, RdrName, RdrName, RdrName, RdrName))]
- boxConTbl :: [(Type, LHsExpr GhcPs -> LHsExpr GhcPs)]
- litConTbl :: [(Type, LHsExpr GhcPs -> LHsExpr GhcPs)]
- mkRdrFunBind :: Located RdrName -> [LMatch GhcPs (LHsExpr GhcPs)] -> LHsBind GhcPs
- mkRdrFunBindEC :: Arity -> (LHsExpr GhcPs -> LHsExpr GhcPs) -> Located RdrName -> [LMatch GhcPs (LHsExpr GhcPs)] -> LHsBind GhcPs
- mkRdrFunBindSE :: Arity -> Located RdrName -> [LMatch GhcPs (LHsExpr GhcPs)] -> LHsBind GhcPs
- error_Expr :: String -> LHsExpr GhcPs
Documentation
type BagDerivStuff = Bag DerivStuff Source #
data DerivStuff Source #
DerivAuxBind AuxBindSpec | A new, top-level auxiliary binding. Used for deriving |
DerivFamInst FamInst | A new type family instance. Used for:
|
gen_Eq_binds :: SrcSpan -> TyCon -> TcM (LHsBinds GhcPs, BagDerivStuff) Source #
gen_Ord_binds :: SrcSpan -> TyCon -> TcM (LHsBinds GhcPs, BagDerivStuff) Source #
gen_Enum_binds :: SrcSpan -> TyCon -> TcM (LHsBinds GhcPs, BagDerivStuff) Source #
gen_Bounded_binds :: SrcSpan -> TyCon -> (LHsBinds GhcPs, BagDerivStuff) Source #
gen_Ix_binds :: SrcSpan -> TyCon -> TcM (LHsBinds GhcPs, BagDerivStuff) Source #
gen_Show_binds :: (Name -> Fixity) -> SrcSpan -> TyCon -> (LHsBinds GhcPs, BagDerivStuff) Source #
gen_Read_binds :: (Name -> Fixity) -> SrcSpan -> TyCon -> (LHsBinds GhcPs, BagDerivStuff) Source #
gen_Data_binds :: SrcSpan -> TyCon -> TcM (LHsBinds GhcPs, BagDerivStuff) Source #
gen_Lift_binds :: SrcSpan -> TyCon -> (LHsBinds GhcPs, BagDerivStuff) Source #
gen_Newtype_binds :: SrcSpan -> Class -> [TyVar] -> [Type] -> Type -> TcM (LHsBinds GhcPs, [LSig GhcPs], BagDerivStuff) Source #
genAuxBinds :: DynFlags -> SrcSpan -> BagDerivStuff -> SeparateBagsDerivStuff Source #
Take a BagDerivStuff
and partition it into SeparateBagsDerivStuff
.
Also generate the code for auxiliary bindings based on the declarative
descriptions in the supplied AuxBindSpec
s. See Note [Auxiliary binders]
.
mkRdrFunBindEC :: Arity -> (LHsExpr GhcPs -> LHsExpr GhcPs) -> Located RdrName -> [LMatch GhcPs (LHsExpr GhcPs)] -> LHsBind GhcPs Source #
Produces a function binding. When no equations are given, it generates a binding of the given arity and an empty case expression for the last argument that it passes to the given function to produce the right-hand side.