Safe Haskell | None |
---|---|
Language | GHC2021 |
Type subsumption and unification
Synopsis
- tcWrapResult :: HsExpr GhcRn -> HsExpr GhcTc -> TcSigmaType -> ExpRhoType -> TcM (HsExpr GhcTc)
- tcWrapResultO :: CtOrigin -> HsExpr GhcRn -> HsExpr GhcTc -> TcSigmaType -> ExpRhoType -> TcM (HsExpr GhcTc)
- tcWrapResultMono :: HsExpr GhcRn -> HsExpr GhcTc -> TcRhoType -> ExpRhoType -> TcM (HsExpr GhcTc)
- tcSubType :: CtOrigin -> UserTypeCtxt -> TcSigmaType -> ExpRhoType -> TcM HsWrapper
- tcSubTypeSigma :: CtOrigin -> UserTypeCtxt -> TcSigmaType -> TcSigmaType -> TcM HsWrapper
- tcSubTypePat :: CtOrigin -> UserTypeCtxt -> ExpSigmaType -> TcSigmaType -> TcM HsWrapper
- tcSubTypeDS :: HsExpr GhcRn -> TcRhoType -> TcRhoType -> TcM HsWrapper
- tcSubTypeAmbiguity :: UserTypeCtxt -> TcSigmaType -> TcSigmaType -> TcM HsWrapper
- tcSubMult :: CtOrigin -> Mult -> Mult -> TcM ()
- checkConstraints :: SkolemInfoAnon -> [TcTyVar] -> [EvVar] -> TcM result -> TcM (TcEvBinds, result)
- checkTvConstraints :: SkolemInfo -> [TcTyVar] -> TcM result -> TcM result
- buildImplicationFor :: TcLevel -> SkolemInfoAnon -> [TcTyVar] -> [EvVar] -> WantedConstraints -> TcM (Bag Implication, TcEvBinds)
- buildTvImplication :: SkolemInfoAnon -> [TcTyVar] -> TcLevel -> WantedConstraints -> TcM Implication
- emitResidualTvConstraint :: SkolemInfo -> [TcTyVar] -> TcLevel -> WantedConstraints -> TcM ()
- data DeepSubsumptionFlag
- getDeepSubsumptionFlag :: TcM DeepSubsumptionFlag
- isRhoTyDS :: DeepSubsumptionFlag -> TcType -> Bool
- tcSkolemise :: DeepSubsumptionFlag -> UserTypeCtxt -> TcSigmaType -> (TcRhoType -> TcM result) -> TcM (HsWrapper, result)
- tcSkolemiseCompleteSig :: TcCompleteSig -> ([ExpPatType] -> TcRhoType -> TcM result) -> TcM (HsWrapper, result)
- tcSkolemiseExpectedType :: TcSigmaType -> ([ExpPatType] -> TcRhoType -> TcM result) -> TcM (HsWrapper, result)
- unifyType :: Maybe TypedThing -> TcTauType -> TcTauType -> TcM TcCoercionN
- unifyKind :: Maybe TypedThing -> TcKind -> TcKind -> TcM CoercionN
- unifyInvisibleType :: TcTauType -> TcTauType -> TcM TcCoercionN
- unifyExpectedType :: HsExpr GhcRn -> TcRhoType -> ExpRhoType -> TcM TcCoercionN
- unifyExprType :: HsExpr GhcRn -> TcType -> TcType -> TcM TcCoercionN
- unifyTypeAndEmit :: TypeOrKind -> CtOrigin -> TcType -> TcType -> TcM CoercionN
- promoteTcType :: TcLevel -> TcType -> TcM (TcCoercionN, TcType)
- swapOverTyVars :: Bool -> TcTyVar -> TcTyVar -> Bool
- touchabilityAndShapeTest :: TcLevel -> TcTyVar -> TcType -> Bool
- checkTopShape :: MetaInfo -> TcType -> Bool
- lhsPriority :: TcTyVar -> Int
- data UnifyEnv = UE {}
- updUEnvLoc :: UnifyEnv -> (CtLoc -> CtLoc) -> UnifyEnv
- setUEnvRole :: UnifyEnv -> Role -> UnifyEnv
- uType :: UnifyEnv -> TcType -> TcType -> TcM CoercionN
- tcInfer :: (ExpSigmaType -> TcM a) -> TcM (a, TcSigmaType)
- matchExpectedListTy :: TcRhoType -> TcM (TcCoercionN, TcRhoType)
- matchExpectedTyConApp :: TyCon -> TcRhoType -> TcM (TcCoercionN, [TcSigmaType])
- matchExpectedAppTy :: TcRhoType -> TcM (TcCoercion, (TcSigmaType, TcSigmaType))
- matchExpectedFunTys :: ExpectedFunTyOrigin -> UserTypeCtxt -> VisArity -> ExpSigmaType -> ([ExpPatType] -> ExpRhoType -> TcM a) -> TcM (HsWrapper, a)
- matchExpectedFunKind :: TypedThing -> Arity -> TcKind -> TcM Coercion
- matchActualFunTy :: ExpectedFunTyOrigin -> Maybe TypedThing -> (Arity, TcType) -> TcRhoType -> TcM (HsWrapper, Scaled TcSigmaTypeFRR, TcSigmaType)
- matchActualFunTys :: ExpectedFunTyOrigin -> CtOrigin -> Arity -> TcSigmaType -> TcM (HsWrapper, [Scaled TcSigmaTypeFRR], TcRhoType)
- checkTyEqRhs :: TyEqFlags a -> TcType -> TcM (PuResult a Reduction)
- recurseIntoTyConApp :: TyEqFlags a -> TyCon -> [TcType] -> TcM (PuResult a Reduction)
- data PuResult a b
- = PuFail CheckTyEqResult
- | PuOK (Bag a) b
- failCheckWith :: CheckTyEqResult -> TcM (PuResult a b)
- okCheckRefl :: TcType -> TcM (PuResult a Reduction)
- mapCheck :: (x -> TcM (PuResult a Reduction)) -> [x] -> TcM (PuResult a Reductions)
- data TyEqFlags a = TEF {}
- data TyEqFamApp a
- = TEFA_Fail
- | TEFA_Recurse
- | TEFA_Break (FamAppBreaker a)
- data AreUnifying
- data LevelCheck
- type FamAppBreaker a = TcType -> TcM (PuResult a Reduction)
- famAppArgFlags :: TyEqFlags a -> TyEqFlags a
- checkPromoteFreeVars :: CheckTyEqProblem -> TcTyVar -> TcLevel -> TyCoVarSet -> TcM CheckTyEqResult
- simpleUnifyCheck :: UnifyCheckCaller -> TcTyVar -> TcType -> Bool
- data UnifyCheckCaller
- fillInferResult :: TcType -> InferResult -> TcM TcCoercionN
Documentation
tcWrapResult :: HsExpr GhcRn -> HsExpr GhcTc -> TcSigmaType -> ExpRhoType -> TcM (HsExpr GhcTc) Source #
tcWrapResultO :: CtOrigin -> HsExpr GhcRn -> HsExpr GhcTc -> TcSigmaType -> ExpRhoType -> TcM (HsExpr GhcTc) Source #
tcWrapResultMono :: HsExpr GhcRn -> HsExpr GhcTc -> TcRhoType -> ExpRhoType -> TcM (HsExpr GhcTc) Source #
:: CtOrigin | |
-> UserTypeCtxt | |
-> TcSigmaType | Actual |
-> ExpRhoType | Expected |
-> TcM HsWrapper |
tcSubTypeSigma :: CtOrigin -> UserTypeCtxt -> TcSigmaType -> TcSigmaType -> TcM HsWrapper Source #
tcSubTypePat :: CtOrigin -> UserTypeCtxt -> ExpSigmaType -> TcSigmaType -> TcM HsWrapper Source #
tcSubTypeAmbiguity :: UserTypeCtxt -> TcSigmaType -> TcSigmaType -> TcM HsWrapper Source #
checkConstraints :: SkolemInfoAnon -> [TcTyVar] -> [EvVar] -> TcM result -> TcM (TcEvBinds, result) Source #
checkTvConstraints :: SkolemInfo -> [TcTyVar] -> TcM result -> TcM result Source #
buildImplicationFor :: TcLevel -> SkolemInfoAnon -> [TcTyVar] -> [EvVar] -> WantedConstraints -> TcM (Bag Implication, TcEvBinds) Source #
buildTvImplication :: SkolemInfoAnon -> [TcTyVar] -> TcLevel -> WantedConstraints -> TcM Implication Source #
emitResidualTvConstraint :: SkolemInfo -> [TcTyVar] -> TcLevel -> WantedConstraints -> TcM () Source #
data DeepSubsumptionFlag Source #
Instances
Outputable DeepSubsumptionFlag Source # | |
Defined in GHC.Tc.Utils.Unify ppr :: DeepSubsumptionFlag -> SDoc Source # |
tcSkolemise :: DeepSubsumptionFlag -> UserTypeCtxt -> TcSigmaType -> (TcRhoType -> TcM result) -> TcM (HsWrapper, result) Source #
tcSkolemiseCompleteSig :: TcCompleteSig -> ([ExpPatType] -> TcRhoType -> TcM result) -> TcM (HsWrapper, result) Source #
The wrapper has type: spec_ty ~> expected_ty See Note [Skolemisation] for the differences between tcSkolemiseCompleteSig and tcTopSkolemise
tcSkolemiseExpectedType :: TcSigmaType -> ([ExpPatType] -> TcRhoType -> TcM result) -> TcM (HsWrapper, result) Source #
:: Maybe TypedThing | If present, the thing that has type ty1 |
-> TcTauType | |
-> TcTauType | |
-> TcM TcCoercionN |
unifyInvisibleType :: TcTauType -> TcTauType -> TcM TcCoercionN Source #
unifyExpectedType :: HsExpr GhcRn -> TcRhoType -> ExpRhoType -> TcM TcCoercionN Source #
unifyExprType :: HsExpr GhcRn -> TcType -> TcType -> TcM TcCoercionN Source #
unifyTypeAndEmit :: TypeOrKind -> CtOrigin -> TcType -> TcType -> TcM CoercionN Source #
promoteTcType :: TcLevel -> TcType -> TcM (TcCoercionN, TcType) Source #
checkTopShape :: MetaInfo -> TcType -> Bool Source #
checkTopShape checks (TYVAR-TV) Note [Unification preconditions]; returns True if these conditions are satisfied. But see the Note for other preconditions, too.
lhsPriority :: TcTyVar -> Int Source #
tcInfer :: (ExpSigmaType -> TcM a) -> TcM (a, TcSigmaType) Source #
Infer a type using a fresh ExpType See also Note [ExpType] in GHC.Tc.Utils.TcMType
Use tcInferFRR
if you require the type to have a fixed
runtime representation.
matchExpectedListTy :: TcRhoType -> TcM (TcCoercionN, TcRhoType) Source #
matchExpectedTyConApp :: TyCon -> TcRhoType -> TcM (TcCoercionN, [TcSigmaType]) Source #
matchExpectedAppTy :: TcRhoType -> TcM (TcCoercion, (TcSigmaType, TcSigmaType)) Source #
matchExpectedFunTys :: ExpectedFunTyOrigin -> UserTypeCtxt -> VisArity -> ExpSigmaType -> ([ExpPatType] -> ExpRhoType -> TcM a) -> TcM (HsWrapper, a) Source #
Use this function to split off arguments types when you have an "expected" type.
This function skolemises at each polytype.
Invariant: this function only applies the provided function to a list of argument types which all have a syntactically fixed RuntimeRep in the sense of Note [Fixed RuntimeRep] in GHC.Tc.Utils.Concrete. See Note [Return arguments with a fixed RuntimeRep].
:: TypedThing | type, only for errors |
-> Arity | n: number of desired arrows |
-> TcKind | fun_kind |
-> TcM Coercion | co :: fun_kind ~ (arg1 -> ... -> argn -> res) |
Breaks apart a function kind into its pieces.
:: ExpectedFunTyOrigin | See Note [Herald for matchExpectedFunTys] |
-> Maybe TypedThing | The thing with type TcSigmaType |
-> (Arity, TcType) | Total number of value args in the call, and the original function type (Both are used only for error messages) |
-> TcRhoType | Type to analyse: a TcRhoType |
-> TcM (HsWrapper, Scaled TcSigmaTypeFRR, TcSigmaType) |
matchActualFunTy
looks for just one function arrow,
returning an uninstantiated sigma-type.
Invariant: the returned argument type has a syntactically fixed RuntimeRep in the sense of Note [Fixed RuntimeRep] in GHC.Tc.Utils.Concrete.
See Note [Return arguments with a fixed RuntimeRep].
:: ExpectedFunTyOrigin | See Note [Herald for matchExpectedFunTys] |
-> CtOrigin | |
-> Arity | |
-> TcSigmaType | |
-> TcM (HsWrapper, [Scaled TcSigmaTypeFRR], TcRhoType) |
Like matchExpectedFunTys
, but used when you have an "actual" type,
for example in function application.
INVARIANT: the returned argument types all have a syntactically fixed RuntimeRep in the sense of Note [Fixed RuntimeRep] in GHC.Tc.Utils.Concrete. See Note [Return arguments with a fixed RuntimeRep].
PuFail CheckTyEqResult | |
PuOK (Bag a) b |
Instances
Applicative (PuResult a) Source # | |
Defined in GHC.Tc.Utils.Unify | |
Functor (PuResult a) Source # | |
(Outputable a, Outputable b) => Outputable (PuResult a b) Source # | |
failCheckWith :: CheckTyEqResult -> TcM (PuResult a b) Source #
Options describing how to deal with a type equality
in the pure unifier. See checkTyEqRhs
TEF | |
|
Instances
Outputable (TyEqFlags a) Source # | |
data TyEqFamApp a Source #
What to do when encountering a type-family application while processing a type equality in the pure unifier.
See Note [Family applications in canonical constraints]
Instances
Outputable (TyEqFamApp a) Source # | |
Defined in GHC.Tc.Utils.Unify ppr :: TyEqFamApp a -> SDoc Source # |
data AreUnifying Source #
Instances
Outputable AreUnifying Source # | |
Defined in GHC.Tc.Utils.Unify ppr :: AreUnifying -> SDoc Source # |
data LevelCheck Source #
Instances
Outputable LevelCheck Source # | |
Defined in GHC.Tc.Utils.Unify ppr :: LevelCheck -> SDoc Source # |
famAppArgFlags :: TyEqFlags a -> TyEqFlags a Source #
checkPromoteFreeVars :: CheckTyEqProblem -> TcTyVar -> TcLevel -> TyCoVarSet -> TcM CheckTyEqResult Source #
simpleUnifyCheck :: UnifyCheckCaller -> TcTyVar -> TcType -> Bool Source #
fillInferResult :: TcType -> InferResult -> TcM TcCoercionN Source #
Fill an InferResult
with the given type.
If co = fillInferResult t1 infer_res
, then co :: t1 ~# t2
,
where t2
is the type stored in the ir_ref
field of infer_res
.
This function enforces the following invariants: