From 3bcc65b82524d1b37e81492885a9eab7b48920ca Mon Sep 17 00:00:00 2001 From: "simonpj@microsoft.com" Date: Wed, 22 Nov 2006 13:28:21 +0000 Subject: [PATCH] Improve error messages slightly --- compiler/typecheck/TcPat.lhs | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) diff --git a/compiler/typecheck/TcPat.lhs b/compiler/typecheck/TcPat.lhs index 933adb8..a5d4209 100644 --- a/compiler/typecheck/TcPat.lhs +++ b/compiler/typecheck/TcPat.lhs @@ -132,7 +132,7 @@ tcCheckExistentialPat pats [] pat_tys body_ty = return () -- Short cut for case when there are no existentials tcCheckExistentialPat pats ex_tvs pat_tys body_ty - = addErrCtxtM (sigPatCtxt (collectPatsBinders pats) ex_tvs pat_tys body_ty) $ + = addErrCtxtM (sigPatCtxt pats ex_tvs pat_tys body_ty) $ checkSigTyVarsWrt (tcTyVarsOfTypes (body_ty:pat_tys)) ex_tvs data PatState = PS { @@ -894,7 +894,7 @@ existentialExplode pat text "In the binding group for"]) 4 (ppr pat) -sigPatCtxt bound_ids bound_tvs pat_tys body_ty tidy_env +sigPatCtxt pats 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) @@ -904,9 +904,11 @@ sigPatCtxt bound_ids bound_tvs pat_tys body_ty tidy_env 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 + ptext SLIT("The body has type:") <+> ppr tidy_body_ty, + ppr pats ]) } where + bound_ids = collectPatsBinders pats show_ids = filter is_interesting bound_ids is_interesting id = any (`elemVarSet` idFreeTyVars id) bound_tvs -- 1.7.10.4