X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Ftypecheck%2FTcPat.lhs;h=9f7dbc0ebb0fd3cfddb838b89ab0434f82465890;hb=a170160cc21678c30ca90696d4ae0fc1155f25bf;hp=51a04dda9002fd821b010a71527d2a4993959a7d;hpb=10fcd78ccde892feccda3f5eacd221c1de75feea;p=ghc-hetmet.git

diff --git a/ghc/compiler/typecheck/TcPat.lhs b/ghc/compiler/typecheck/TcPat.lhs
index 51a04dd..9f7dbc0 100644
--- a/ghc/compiler/typecheck/TcPat.lhs
+++ b/ghc/compiler/typecheck/TcPat.lhs
@@ -24,7 +24,7 @@ import Name		( Name )
 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,
@@ -150,8 +150,9 @@ tcPat tc_bndr WildPatIn pat_ty
 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)
@@ -392,7 +393,7 @@ tcConstructor pat con_name
 	     -- 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
@@ -463,7 +464,7 @@ tcSubPat does the work
 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
@@ -472,7 +473,7 @@ tcSubPat sig_ty exp_ty
    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
@@ -487,7 +488,7 @@ tcSubPat sig_ty exp_ty
 %************************************************************************
 
 \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