Safe Haskell | Safe-Inferred |
---|---|
Language | Haskell2010 |
Error-checking and other utilities for deriving
clauses or declarations.
Synopsis
- type DerivM = ReaderT DerivEnv TcRn
- data DerivEnv = DerivEnv {}
- data DerivSpec theta = DS {
- ds_loc :: SrcSpan
- ds_name :: Name
- ds_tvs :: [TyVar]
- ds_theta :: theta
- ds_cls :: Class
- ds_tys :: [Type]
- ds_skol_info :: SkolemInfo
- ds_user_ctxt :: UserTypeCtxt
- ds_overlap :: Maybe OverlapMode
- ds_standalone_wildcard :: Maybe SrcSpan
- ds_mechanism :: DerivSpecMechanism
- pprDerivSpec :: Outputable theta => DerivSpec theta -> SDoc
- setDerivSpecTheta :: theta' -> DerivSpec theta -> DerivSpec theta'
- zonkDerivSpec :: DerivSpec ThetaType -> TcM (DerivSpec ThetaType)
- data DerivSpecMechanism
- derivSpecMechanismToStrategy :: DerivSpecMechanism -> DerivStrategy GhcTc
- isDerivSpecStock :: DerivSpecMechanism -> Bool
- isDerivSpecNewtype :: DerivSpecMechanism -> Bool
- isDerivSpecAnyClass :: DerivSpecMechanism -> Bool
- isDerivSpecVia :: DerivSpecMechanism -> Bool
- zonkDerivSpecMechanism :: ZonkEnv -> DerivSpecMechanism -> TcM DerivSpecMechanism
- data DerivContext
- data OriginativeDerivStatus
- data StockGenFns = StockGenFns {
- stock_gen_binds :: SrcSpan -> DerivInstTys -> TcM (LHsBinds GhcPs, [LSig GhcPs], Bag AuxBindSpec, [Name])
- stock_gen_fam_insts :: SrcSpan -> DerivInstTys -> TcM [FamInst]
- isStandaloneDeriv :: DerivM Bool
- isStandaloneWildcardDeriv :: DerivM Bool
- askDerivUserTypeCtxt :: DerivM UserTypeCtxt
- mkDerivOrigin :: Bool -> CtOrigin
- data PredSpec
- type ThetaSpec = [PredSpec]
- mkDirectThetaSpec :: CtOrigin -> TypeOrKind -> ThetaType -> ThetaSpec
- substPredSpec :: HasCallStack => Subst -> PredSpec -> PredSpec
- captureThetaSpecConstraints :: UserTypeCtxt -> ThetaSpec -> TcM (TcLevel, WantedConstraints)
- checkOriginativeSideConditions :: DerivInstTys -> DerivM OriginativeDerivStatus
- hasStockDeriving :: Class -> Maybe StockGenFns
- std_class_via_coercible :: Class -> Bool
- non_coercible_class :: Class -> Bool
- newDerivClsInst :: DerivSpec ThetaType -> TcM ClsInst
- extendLocalInstEnv :: [ClsInst] -> TcM a -> TcM a
Documentation
type DerivM = ReaderT DerivEnv TcRn Source #
To avoid having to manually plumb everything in DerivEnv
throughout
various functions in GHC.Tc.Deriv and GHC.Tc.Deriv.Infer, we use DerivM
, which
is a simple reader around TcRn
.
Contains all of the information known about a derived instance when
determining what its EarlyDerivSpec
should be.
See Note [DerivEnv and DerivSpecMechanism]
.
DerivEnv | |
|
Instances
DS | |
|
Instances
Outputable theta => Outputable (DerivSpec theta) Source # | |
pprDerivSpec :: Outputable theta => DerivSpec theta -> SDoc Source #
setDerivSpecTheta :: theta' -> DerivSpec theta -> DerivSpec theta' Source #
zonkDerivSpec :: DerivSpec ThetaType -> TcM (DerivSpec ThetaType) Source #
Zonk the TcTyVar
s in a DerivSpec
to TyVar
s.
See Note [What is zonking?]
in GHC.Tc.Utils.TcMType.
This is only used in the final zonking step when inferring
the context for a derived instance.
See Note [Overlap and deriving]
in GHC.Tc.Deriv.Infer.
data DerivSpecMechanism Source #
What action to take in order to derive a class instance.
See Note [DerivEnv and DerivSpecMechanism]
, as well as
Note [Deriving strategies]
in GHC.Tc.Deriv.
DerivSpecStock | "Standard" classes |
| |
DerivSpecNewtype | GeneralizedNewtypeDeriving |
| |
DerivSpecAnyClass | DeriveAnyClass |
DerivSpecVia | DerivingVia |
|
Instances
Outputable DerivSpecMechanism Source # | |
Defined in GHC.Tc.Deriv.Utils ppr :: DerivSpecMechanism -> SDoc Source # |
derivSpecMechanismToStrategy :: DerivSpecMechanism -> DerivStrategy GhcTc Source #
Convert a DerivSpecMechanism
to its corresponding DerivStrategy
.
zonkDerivSpecMechanism :: ZonkEnv -> DerivSpecMechanism -> TcM DerivSpecMechanism Source #
Zonk the TcTyVar
s in a DerivSpecMechanism
to TyVar
s.
See Note [What is zonking?]
in GHC.Tc.Utils.TcMType.
This is only used in the final zonking step when inferring
the context for a derived instance.
See Note [Overlap and deriving]
in GHC.Tc.Deriv.Infer.
data DerivContext Source #
Whether GHC is processing a deriving
clause or a standalone deriving
declaration.
InferContext (Maybe SrcSpan) |
GHC should infer the context. |
SupplyContext ThetaType |
|
Instances
Outputable DerivContext Source # | |
Defined in GHC.Tc.Deriv.Utils ppr :: DerivContext -> SDoc Source # |
data OriginativeDerivStatus Source #
Records whether a particular class can be derived by way of an
originative deriving strategy (i.e., stock
or anyclass
).
See Note [Deriving strategies]
in GHC.Tc.Deriv.
data StockGenFns Source #
Describes how to generate instance bindings (stock_gen_binds
) and
associated type family instances (stock_gen_fam_insts
) for a particular
stock-derived instance.
StockGenFns | |
|
isStandaloneDeriv :: DerivM Bool Source #
Is GHC processing a standalone deriving declaration?
isStandaloneWildcardDeriv :: DerivM Bool Source #
Is GHC processing a standalone deriving declaration with an
extra-constraints wildcard as the context?
(e.g., deriving instance _ => Eq (Foo a)
)
askDerivUserTypeCtxt :: DerivM UserTypeCtxt Source #
Return InstDeclCtxt
if processing with a standalone deriving
declaration or DerivClauseCtxt
if processing a deriving
clause.
mkDerivOrigin :: Bool -> CtOrigin Source #
returns mkDerivOrigin
wcStandAloneDerivOrigin
if wc
is True
,
and DerivClauseOrigin
if wc
is False
. Useful for error-reporting.
A PredSpec
specifies a constraint to emitted when inferring the
instance context for a derived instance in simplifyInfer
.
SimplePredSpec | An ordinary |
| |
SubTypePredSpec | A special |
|
Instances
type ThetaSpec = [PredSpec] Source #
A list of PredSpec
constraints to simplify when inferring a
derived instance's context. For the stock
, newtype
, and via
deriving
strategies, these will consist of SimplePredSpec
s, and for
DeriveAnyClass
, these will consist of SubTypePredSpec
s. Here is an
example to illustrate the latter:
class Foo a where bar :: forall b. Ix b => a -> b -> String default bar :: forall y. (Show a, Ix y) => a -> y -> String bar x y = show x ++ show (range (y, y)) baz :: Eq a => a -> a -> Bool default baz :: Ord a => a -> a -> Bool baz x y = compare x y == EQ data Quux q = Quux deriving anyclass Foo
Then it would generate two SubTypePredSpec
s, one for each method:
[ SubTypePredSpec { stps_ty_actual = forall y. (Show (Quux q), Ix y) => Quux q -> y -> String , stps_ty_expected = forall b. (Ix b) => Quux q -> b -> String , stps_ty_origin = DerivClauseCtxt } , SubTypePredSpec { stps_ty_actual = Ord (Quux q) => Quux q -> Quux q -> Bool , stps_ty_expected = Eq (Quux q) => Quux q -> Quux q -> Bool , stps_ty_origin = DerivClauseCtxt } ]
(Note that the type variable q
is bound by the data type Quux
, and thus
appears free in the stps_ty_actual
s and stps_ty_expected
s.)
See Note [Gathering and simplifying constraints for DeriveAnyClass]
in GHC.Tc.Deriv.Infer for an explanation of how these SubTypePredSpec
s
are used to compute implication constraints.
mkDirectThetaSpec :: CtOrigin -> TypeOrKind -> ThetaType -> ThetaSpec Source #
Build a list of SimplePredSpec
s, using the supplied CtOrigin
and
TypeOrKind
values for each PredType
.
substPredSpec :: HasCallStack => Subst -> PredSpec -> PredSpec Source #
captureThetaSpecConstraints Source #
:: UserTypeCtxt | Used to inform error messages as to whether
we are in a |
-> ThetaSpec | The specs from which constraints will be created |
-> TcM (TcLevel, WantedConstraints) |
Capture wanted constraints from a ThetaSpec
.
hasStockDeriving :: Class -> Maybe StockGenFns Source #
std_class_via_coercible :: Class -> Bool Source #
non_coercible_class :: Class -> Bool Source #