TyThing(..), TcTyThing(..),
getInLocalScope
)
-import TcMType ( newKindVar, tcInstType, newMutTyVar,
+import TcMType ( newKindVar, newOpenTypeKind, tcInstType, newMutTyVar,
zonkTcType, zonkTcKindToKind,
- checkValidType, UserTypeCtxt(..), pprUserTypeCtxt
+ checkValidType, UserTypeCtxt(..), pprHsSigCtxt
)
-import TcUnify ( unifyKind, unifyFunKind, unifyTypeKind )
+import TcUnify ( unifyKind, unifyFunKind )
import TcType ( Type, PredType(..), ThetaType, TyVarDetails(..),
TcTyVar, TcKind, TcThetaType, TcTauType,
- mkTyVarTy, mkTyVarTys, mkFunTy,
+ mkTyVarTy, mkTyVarTys, mkFunTy, isTypeKind,
mkForAllTys, mkFunTys, tcEqType, isPredTy,
mkSigmaTy, mkPredTy, mkGenTyConApp, mkTyConApp, mkAppTys,
liftedTypeKind, unliftedTypeKind, eqKind,
- tcSplitFunTy_maybe, tcSplitForAllTys, tcSplitSigmaTy
- )
-import PprType ( pprKind, pprThetaArrow )
+ tcSplitFunTy_maybe, tcSplitForAllTys, pprKind )
import qualified Type ( splitFunTys )
import Inst ( Inst, InstOrigin(..), newMethod, instToId )
import Id ( mkLocalId, idName, idType )
import Var ( TyVar, mkTyVar, tyVarKind )
-import ErrUtils ( Message )
import TyCon ( TyCon, tyConKind )
import Class ( classTyCon )
import Name ( Name )
tcHsSigType :: UserTypeCtxt -> RenamedHsType -> TcM Type
-- Do kind checking, and hoist for-alls to the top
tcHsSigType ctxt hs_ty
- = addErrCtxt (checkHsTypeCtxt ctxt hs_ty) $
+ = addErrCtxt (pprHsSigCtxt ctxt hs_ty) $
do { kinded_ty <- kcTypeType hs_ty
; ty <- tcHsKindedType kinded_ty
; checkValidType ctxt ty
= do { (kinded_pred,_) <- kc_pred pred -- kc_pred rather than kcHsPred
-- to avoid the partial application check
; dsHsPred kinded_pred }
-
-
-checkHsTypeCtxt ctxt hs_ty
- = vcat [ptext SLIT("In the type signature:") <+> ppr hs_ty,
- ptext SLIT("While checking") <+> pprUserTypeCtxt ctxt ]
\end{code}
These functions are used during knot-tying in
\begin{code}
---------------------------
kcLiftedType :: HsType Name -> TcM (HsType Name)
- -- The type ty must be a *lifted* *type*
+-- The type ty must be a *lifted* *type*
kcLiftedType ty = kcCheckHsType ty liftedTypeKind
---------------------------
kcTypeType :: HsType Name -> TcM (HsType Name)
- -- The type ty must be a *type*, but it can be lifted or unlifted
+-- The type ty must be a *type*, but it can be lifted or unlifted
+-- Be sure to use checkExpectedKind, rather than simply unifying
+-- with (Type bx), because it gives better error messages
kcTypeType ty
= kcHsType ty `thenM` \ (ty', kind) ->
- unifyTypeKind kind `thenM_`
+ if isTypeKind kind then
+ return ty'
+ else
+ newOpenTypeKind `thenM` \ type_kind ->
+ traceTc (text "kcTypeType" $$ nest 2 (ppr ty $$ ppr ty' $$ ppr kind $$ ppr type_kind)) `thenM_`
+ checkExpectedKind (ppr ty) kind type_kind `thenM_`
returnM ty'
---------------------------
= kcHsPred pred `thenM` \ pred' ->
returnM (HsPredTy pred', liftedTypeKind)
-kcHsType (HsForAllTy (Just tv_names) context ty)
+kcHsType (HsForAllTy exp tv_names context ty)
= kcHsTyVars tv_names $ \ tv_names' ->
kcHsContext context `thenM` \ ctxt' ->
kcLiftedType ty `thenM` \ ty' ->
- -- The body of a forall must be of kind *
- -- In principle, I suppose, we could allow unlifted types,
- -- but it seems simpler to stick to lifted types for now.
- returnM (HsForAllTy (Just tv_names') ctxt' ty', liftedTypeKind)
+ -- The body of a forall must be a type, but in principle
+ -- there's no reason to prohibit *unlifted* types.
+ -- In fact, GHC can itself construct a function with an
+ -- unboxed tuple inside a for-all (via CPR analyis; see
+ -- typecheck/should_compile/tc170)
+ --
+ -- Still, that's only for internal interfaces, which aren't
+ -- kind-checked, and it's a bit inconvenient to use kcTypeType
+ -- here (because it doesn't return the result kind), so I'm
+ -- leaving it as lifted types for now.
+ returnM (HsForAllTy exp tv_names' ctxt' ty', liftedTypeKind)
---------------------------
kcApps :: TcKind -- Function kind
= dsHsPred pred `thenM` \ pred' ->
returnM (mkPredTy pred')
-dsHsType full_ty@(HsForAllTy (Just tv_names) ctxt ty)
+dsHsType full_ty@(HsForAllTy exp tv_names ctxt ty)
= tcTyVarBndrs tv_names $ \ tyvars ->
mappM dsHsPred ctxt `thenM` \ theta ->
dsHsType ty `thenM` \ tau ->
-- Zonk the mutable kinds and bring the tyvars into scope
-- Rather like tcTyVarBndrs, except that it brings *mutable*
-- tyvars into scope, not immutable ones
+ --
+ -- Furthermore, the tyvars are PatSigTvs, which means that we get better
+ -- error messages when type variables escape:
+ -- Inferred type is less polymorphic than expected
+ -- Quantified type variable `t' escapes
+ -- It is mentioned in the environment:
+ -- t is bound by the pattern type signature at tcfail103.hs:6
mapM zonk kinded_tvs `thenM` \ tyvars ->
tcExtendTyVarEnv tyvars thing_inside
where
zonk (KindedTyVar name kind) = zonkTcKindToKind kind `thenM` \ kind' ->
- newMutTyVar name kind' VanillaTv
+ newMutTyVar name kind' PatSigTv
zonk (UserTyVar name) = pprTrace "BAD: Un-kinded tyvar" (ppr name) $
returnM (mkTyVar name liftedTypeKind)
\end{code}
projects / ghc-hetmet.git / blobdiff