MetaDetails(Flexi, Indirect), MetaInfo(..),
SkolemInfo(..), pprSkolTvBinding, pprSkolInfo,
isImmutableTyVar, isSkolemTyVar, isMetaTyVar, isMetaTyVarTy,
- isSigTyVar, isExistentialTyVar, isTyConableTyVar,
+ isSigTyVar, isOverlappableTyVar, isTyConableTyVar,
metaTvRef,
- isFlexi, isIndirect, isRuntimeUnk, isUnk,
+ isFlexi, isIndirect, isUnkSkol, isRuntimeUnkSkol,
--------------------------------
-- Builders
-- Type substitutions
TvSubst(..), -- Representation visible to a few friends
TvSubstEnv, emptyTvSubst, substEqSpec,
- mkOpenTvSubst, zipOpenTvSubst, zipTopTvSubst, mkTopTvSubst, notElemTvSubst,
+ mkOpenTvSubst, zipOpenTvSubst, zipTopTvSubst,
+ mkTopTvSubst, notElemTvSubst, unionTvSubst,
getTvSubstEnv, setTvSubstEnv, getTvInScope, extendTvInScope, lookupTyVar,
extendTvSubst, extendTvSubstList, isInScope, mkTvSubst, zipTyEnv,
substTy, substTys, substTyWith, substTheta, substTyVar, substTyVars, substTyVarBndr,
-- The Name is the name of the function from whose
-- type signature we got this skolem
+ | TcsTv -- A MetaTv allocated by the constraint solver
+ -- Its particular property is that it is always "touchable"
+ -- Nevertheless, the constraint solver has to try to guess
+ -- what type to instantiate it to
+
----------------------------------
-- SkolemInfo describes a site where
-- a) type variables are skolemised
| RuleSkol RuleName -- The LHS of a RULE
| GenSkol TcType -- Bound when doing a subsumption check for ty
+
| RuntimeUnkSkol -- a type variable used to represent an unknown
-- runtime type (used in the GHCi debugger)
- | NoScSkol -- Used for the "self" superclass when solving
- -- superclasses; don't generate superclasses of me
-
| UnkSkol -- Unhelpful info (until I improve it)
-------------------------------------
pprTcTyVarDetails (SkolemTv _) = ptext (sLit "sk")
pprTcTyVarDetails (FlatSkol {}) = ptext (sLit "fsk")
pprTcTyVarDetails (MetaTv TauTv _) = ptext (sLit "tau")
+pprTcTyVarDetails (MetaTv TcsTv _) = ptext (sLit "tcs")
pprTcTyVarDetails (MetaTv (SigTv _) _) = ptext (sLit "sig")
pprUserTypeCtxt :: UserTypeCtxt -> SDoc
where
ppr_details (SkolemTv info) = ppr_skol info
ppr_details (FlatSkol {}) = ptext (sLit "is a flattening type variable")
- ppr_details (MetaTv TauTv _) = ptext (sLit "is a meta type variable")
- ppr_details (MetaTv (SigTv n) _) = ptext (sLit "is bound by the type signature for") <+> quotes (ppr n)
+ ppr_details (MetaTv (SigTv n) _) = ptext (sLit "is bound by the type signature for")
+ <+> quotes (ppr n)
+ ppr_details (MetaTv _ _) = ptext (sLit "is a meta type variable")
ppr_skol UnkSkol = ptext (sLit "is an unknown type variable") -- Unhelpful
ppr_skol RuntimeUnkSkol = ptext (sLit "is an unknown runtime type")
sep [pprSkolInfo info,
nest 2 (ptext (sLit "at") <+> ppr (getSrcLoc tv))]]
+instance Outputable SkolemInfo where
+ ppr = pprSkolInfo
+
pprSkolInfo :: SkolemInfo -> SDoc
-- Complete the sentence "is a rigid type variable bound by..."
pprSkolInfo (SigSkol ctxt) = pprUserTypeCtxt ctxt
<+> pprWithCommas ppr ips
pprSkolInfo (ClsSkol cls) = ptext (sLit "the class declaration for") <+> quotes (ppr cls)
pprSkolInfo InstSkol = ptext (sLit "the instance declaration")
-pprSkolInfo NoScSkol = ptext (sLit "the instance declaration (self)")
pprSkolInfo FamInstSkol = ptext (sLit "the family instance declaration")
pprSkolInfo (RuleSkol name) = ptext (sLit "the RULE") <+> doubleQuotes (ftext name)
pprSkolInfo ArrowSkol = ptext (sLit "the arrow form")
| isTcTyVar tv = isSkolemTyVar tv
| otherwise = True
-isTyConableTyVar, isSkolemTyVar, isExistentialTyVar,
+isTyConableTyVar, isSkolemTyVar, isOverlappableTyVar,
isMetaTyVar :: TcTyVar -> Bool
isTyConableTyVar tv
-- not a SigTv
= ASSERT( isTcTyVar tv)
case tcTyVarDetails tv of
- MetaTv TauTv _ -> True
- _ -> False
+ MetaTv (SigTv _) _ -> False
+ _ -> True
isSkolemTyVar tv
= ASSERT2( isTcTyVar tv, ppr tv )
FlatSkol {} -> True
MetaTv {} -> False
-isExistentialTyVar tv -- Existential type variable, bound by a pattern
+-- isOverlappableTyVar has a unique purpose.
+-- See Note [Binding when looking up instances] in InstEnv.
+isOverlappableTyVar tv
= ASSERT( isTcTyVar tv )
case tcTyVarDetails tv of
- SkolemTv (PatSkol {}) -> True
- _ -> False
+ SkolemTv (PatSkol {}) -> True
+ SkolemTv (InstSkol {}) -> True
+ _ -> False
isMetaTyVar tv
= ASSERT2( isTcTyVar tv, ppr tv )
isIndirect (Indirect _) = True
isIndirect _ = False
-isRuntimeUnk :: TyVar -> Bool
-isRuntimeUnk x | isTcTyVar x
- , SkolemTv RuntimeUnkSkol <- tcTyVarDetails x = True
- | otherwise = False
-
-isUnk :: TyVar -> Bool
-isUnk x | isTcTyVar x
- , SkolemTv UnkSkol <- tcTyVarDetails x = True
- | otherwise = False
+isRuntimeUnkSkol :: TyVar -> Bool
+-- Called only in TcErrors; see Note [Runtime skolems] there
+isRuntimeUnkSkol x | isTcTyVar x
+ , SkolemTv RuntimeUnkSkol <- tcTyVarDetails x
+ = True
+ | otherwise = False
+
+isUnkSkol :: TyVar -> Bool
+isUnkSkol x | isTcTyVar x
+ , SkolemTv UnkSkol <- tcTyVarDetails x = True
+ | otherwise = False
\end{code}
tcIsTyVarTy ty = maybeToBool (tcGetTyVar_maybe ty)
-----------------------
-tcSplitDFunTy :: Type -> ([TyVar], Class, [Type])
+tcSplitDFunTy :: Type -> ([TyVar], Int, Class, [Type])
-- Split the type of a dictionary function
-- We don't use tcSplitSigmaTy, because a DFun may (with NDP)
-- have non-Pred arguments, such as
-- df :: forall m. (forall b. Eq b => Eq (m b)) -> C m
tcSplitDFunTy ty
- = case tcSplitForAllTys ty of { (tvs, rho) ->
- case tcSplitDFunHead (drop_pred_tys rho) of { (clas, tys) ->
- (tvs, clas, tys) }}
+ = case tcSplitForAllTys ty of { (tvs, rho) ->
+ case split_dfun_args 0 rho of { (n_theta, tau) ->
+ case tcSplitDFunHead tau of { (clas, tys) ->
+ (tvs, n_theta, clas, tys) }}}
where
- -- Discard the context of the dfun. This can be a mix of
+ -- Count the context of the dfun. This can be a mix of
-- coercion and class constraints; or (in the general NDP case)
-- some other function argument
- drop_pred_tys ty | Just ty' <- tcView ty = drop_pred_tys ty'
- drop_pred_tys (ForAllTy tv ty) = ASSERT( isCoVar tv ) drop_pred_tys ty
- drop_pred_tys (FunTy _ ty) = drop_pred_tys ty
- drop_pred_tys ty = ty
+ split_dfun_args n ty | Just ty' <- tcView ty = split_dfun_args n ty'
+ split_dfun_args n (ForAllTy tv ty) = ASSERT( isCoVar tv ) split_dfun_args (n+1) ty
+ split_dfun_args n (FunTy _ ty) = split_dfun_args (n+1) ty
+ split_dfun_args n ty = (n, ty)
tcSplitDFunHead :: Type -> (Class, [Type])
tcSplitDFunHead tau
-- Used in Haskell-98 mode, for the argument types of an instance head
-- These must be a constructor applied to type variable arguments
tcInstHeadTyAppAllTyVars ty
+ | Just ty' <- tcView ty -- Look through synonyms
+ = tcInstHeadTyAppAllTyVars ty'
+ | otherwise
= case ty of
TyConApp _ tys -> ok tys
FunTy arg res -> ok [arg, res]
mkDictTy :: Class -> [Type] -> Type
mkDictTy clas tys = mkPredTy (ClassP clas tys)
-
-
isDictLikeTy :: Type -> Bool
-- Note [Dictionary-like types]
isDictLikeTy ty | Just ty' <- tcView ty = isDictTy ty'