import FieldLabel ( fieldLabelName )
import TcEnv ( tcLookupClass, tcLookupDataCon, tcLookupGlobalId, tcLookupId )
import TcMType ( tcInstTyVars, newTyVarTy, getTcTyVar, putTcTyVar )
-import TcType ( TcType, TcTyVar, TcSigmaType,
+import TcType ( TcType, TcTyVar, TcSigmaType, TyVarDetails(VanillaTv),
mkTyConApp, mkClassPred, liftedTypeKind, tcGetTyVar_maybe,
isHoleTyVar, openTypeKind )
import TcUnify ( tcSub, unifyTauTy, unifyListTy, unifyPArrTy,
tcPat tc_bndr (ParPatIn parend_pat) pat_ty
= tcPat tc_bndr parend_pat pat_ty
-tcPat tc_bndr (SigPatIn pat sig) pat_ty
- = tcHsSigType PatSigCtxt sig `thenTc` \ sig_ty ->
+tcPat tc_bndr pat_in@(SigPatIn pat sig) pat_ty
+ = tcAddErrCtxt (patCtxt pat_in) $
+ tcHsSigType PatSigCtxt sig `thenTc` \ sig_ty ->
tcSubPat sig_ty pat_ty `thenTc` \ (co_fn, lie_sig) ->
tcPat tc_bndr pat sig_ty `thenTc` \ (pat', lie_req, tvs, ids, lie_avail) ->
returnTc (co_fn <$> pat', lie_req `plusLIE` lie_sig, tvs, ids, lie_avail)
-- behave differently when called, not when used for
-- matching.
in
- tcInstTyVars (ex_tvs ++ tvs) `thenNF_Tc` \ (all_tvs', ty_args', tenv) ->
+ tcInstTyVars VanillaTv (ex_tvs ++ tvs) `thenNF_Tc` \ (all_tvs', ty_args', tenv) ->
let
ex_theta' = substTheta tenv ex_theta
arg_tys' = map (substTy tenv) arg_tys
tcSubPat :: TcSigmaType -> TcSigmaType -> TcM (PatCoFn, LIE)
tcSubPat sig_ty exp_ty
- = tcSub exp_ty sig_ty `thenTc` \ (co_fn, lie) ->
+ = tcSub sig_ty exp_ty `thenTc` \ (co_fn, lie) ->
-- co_fn is a coercion on *expressions*, and we
-- need to make a coercion on *patterns*
if isIdCoercion co_fn then
else
tcGetUnique `thenNF_Tc` \ uniq ->
let
- arg_id = mkSysLocal SLIT("sub") uniq exp_ty
+ arg_id = mkSysLocal FSLIT("sub") uniq exp_ty
the_fn = DictLam [arg_id] (co_fn <$> HsVar arg_id)
pat_co_fn p = SigPat p exp_ty the_fn
in
%************************************************************************
\begin{code}
-patCtxt pat = hang (ptext SLIT("In the pattern:"))
+patCtxt pat = hang (ptext SLIT("When checking the pattern:"))
4 (ppr pat)
badFieldCon :: Name -> Name -> SDoc