emptyTvSubst, substTyVar, substTy, mkTopTvSubst, zipTopTvSubst, zipOpenTvSubst,
mkTyVarTys, mkClassPred, mkTyConApp, isOverloadedTy,
mkFunTy, mkFunTys, exactTyVarsOfTypes,
emptyTvSubst, substTyVar, substTy, mkTopTvSubst, zipTopTvSubst, zipOpenTvSubst,
mkTyVarTys, mkClassPred, mkTyConApp, isOverloadedTy,
mkFunTy, mkFunTys, exactTyVarsOfTypes,
import VarSet ( elemVarSet, mkVarSet )
import Kind ( liftedTypeKind, openTypeKind )
import TcUnify ( boxySplitTyConApp, boxySplitListTy,
import VarSet ( elemVarSet, mkVarSet )
import Kind ( liftedTypeKind, openTypeKind )
import TcUnify ( boxySplitTyConApp, boxySplitListTy,
; res <- tcExtendIdEnv1 name bndr_id (thing_inside pstate)
; returnM (NPlusKPat (L nm_loc bndr_id) lit' ge' minus', [], res) }
; res <- tcExtendIdEnv1 name bndr_id (thing_inside pstate)
; returnM (NPlusKPat (L nm_loc bndr_id) lit' ge' minus', [], res) }
-sigPatCtxt bound_ids bound_tvs tys tidy_env
- = -- tys is (body_ty : pat_tys)
- mapM zonkTcType tys `thenM` \ tys' ->
- let
- (env1, tidy_tys) = tidyOpenTypes tidy_env (map idType show_ids)
- (_env2, tidy_body_ty : tidy_pat_tys) = tidyOpenTypes env1 tys'
- in
- returnM (env1,
+sigPatCtxt bound_ids bound_tvs pat_tys body_ty tidy_env
+ = do { pat_tys' <- mapM zonkTcType pat_tys
+ ; body_ty' <- zonkTcType body_ty
+ ; let (env1, tidy_tys) = tidyOpenTypes tidy_env (map idType show_ids)
+ (env2, tidy_pat_tys) = tidyOpenTypes env1 pat_tys'
+ (env3, tidy_body_ty) = tidyOpenType env2 body_ty'
+ ; return (env3,
sep [ptext SLIT("When checking an existential match that binds"),
nest 4 (vcat (zipWith ppr_id show_ids tidy_tys)),
ptext SLIT("The pattern(s) have type(s):") <+> vcat (map ppr tidy_pat_tys),
ptext SLIT("The body has type:") <+> ppr tidy_body_ty
sep [ptext SLIT("When checking an existential match that binds"),
nest 4 (vcat (zipWith ppr_id show_ids tidy_tys)),
ptext SLIT("The pattern(s) have type(s):") <+> vcat (map ppr tidy_pat_tys),
ptext SLIT("The body has type:") <+> ppr tidy_body_ty
where
show_ids = filter is_interesting bound_ids
is_interesting id = any (`elemVarSet` idFreeTyVars id) bound_tvs
where
show_ids = filter is_interesting bound_ids
is_interesting id = any (`elemVarSet` idFreeTyVars id) bound_tvs