X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Ftypecheck%2FTcExpr.lhs;h=77161009275fbe4c12765a42a417002d9dfa5ec6;hb=8ddfc3c10a9d08e11812b5564da291d7024d5fc8;hp=f622d1cb266eabeef6e458b7420a7e259dcc99ff;hpb=36908417be25c8de3bff3a7726984bc8f363a127;p=ghc-hetmet.git

diff --git a/ghc/compiler/typecheck/TcExpr.lhs b/ghc/compiler/typecheck/TcExpr.lhs
index f622d1c..7716100 100644
--- a/ghc/compiler/typecheck/TcExpr.lhs
+++ b/ghc/compiler/typecheck/TcExpr.lhs
@@ -131,6 +131,7 @@ tcPolyExpr arg expected_arg_ty
     tcInstTcType expected_arg_ty 	`thenNF_Tc` \ (sig_tyvars, sig_rho) ->
     let
 	(sig_theta, sig_tau) = splitRhoTy sig_rho
+	free_tyvars	     = tyVarsOfType expected_arg_ty
     in
 	-- Type-check the arg and unify with expected type
     tcMonoExpr arg sig_tau				`thenTc` \ (arg', lie_arg) ->
@@ -146,10 +147,10 @@ tcPolyExpr arg expected_arg_ty
 	-- Conclusion: include the free vars of the expected arg type in the
 	-- list of "free vars" for the signature check.
 
-    tcExtendGlobalTyVars (tyVarsOfType expected_arg_ty)		$
-    tcAddErrCtxtM (sigCtxt sig_msg expected_arg_ty)		$
+    tcExtendGlobalTyVars free_tyvars				  $
+    tcAddErrCtxtM (sigCtxt sig_msg sig_tyvars sig_theta sig_tau)  $
 
-    checkSigTyVars sig_tyvars			`thenTc` \ zonked_sig_tyvars ->
+    checkSigTyVars sig_tyvars free_tyvars	`thenTc` \ zonked_sig_tyvars ->
 
     newDicts SignatureOrigin sig_theta		`thenNF_Tc` \ (sig_dicts, dict_ids) ->
 	-- ToDo: better origin
@@ -170,8 +171,7 @@ tcPolyExpr arg expected_arg_ty
     returnTc ( generalised_arg, free_insts,
 	       arg', sig_tau, lie_arg )
   where
-    sig_msg ty = sep [ptext SLIT("In an expression with expected type:"),
-		      nest 4 (ppr ty)]
+    sig_msg = ptext SLIT("When checking an expression type signature")
 \end{code}
 
 %************************************************************************