[commit: ghc] master: Further wibbbling to type error message reporting (2a7f4de)
Simon Peyton Jones
simonpj at microsoft.com
Mon Apr 22 13:59:51 CEST 2013
Repository : http://darcs.haskell.org/ghc.git/
On branch : master
https://github.com/ghc/ghc/commit/2a7f4de3d3d5fc515725af941f332d69997185dc
>---------------------------------------------------------------
commit 2a7f4de3d3d5fc515725af941f332d69997185dc
Author: Simon Peyton Jones <simonpj at microsoft.com>
Date: Mon Apr 22 12:53:53 2013 +0100
Further wibbbling to type error message reporting
* We now never report derived-constraint type errors, even
in the "insolubles". See Note [Insoluble derived constraints]
in TcRnTypes.
* The cec_suppress mechanism in TcErrors is refactored a bit so that:
- We suppress *all* errors in unreachable code (they can be jolly
confusing)
- We no longer suppress *all* non-insoluble errors if there are *any
insolubles anywhere. Instead we are a bit more refined.
See Note [Suppressing error messages] in TcErrors
>---------------------------------------------------------------
compiler/typecheck/TcErrors.lhs | 45 +++++++++++++++++++++++++++++-----------
compiler/typecheck/TcRnTypes.lhs | 28 +++++++++++++++++++++----
2 files changed, 57 insertions(+), 16 deletions(-)
diff --git a/compiler/typecheck/TcErrors.lhs b/compiler/typecheck/TcErrors.lhs
index 69df5bf..7c20cdd 100644
--- a/compiler/typecheck/TcErrors.lhs
+++ b/compiler/typecheck/TcErrors.lhs
@@ -92,11 +92,6 @@ in TcErrors. TcErrors.reportTidyWanteds does not print the errors
and does not fail if -fdefer-type-errors is on, so that we can continue
compilation. The errors are turned into warnings in `reportUnsolved`.
-Note [Suppressing error messages]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-If there are any insolubles, like (Int~Bool), then we suppress all less-drastic
-errors (like (Eq a)). Often the latter are a knock-on effect of the former.
-
\begin{code}
reportUnsolved :: WantedConstraints -> TcM (Bag EvBind)
reportUnsolved wanted
@@ -131,8 +126,7 @@ report_unsolved mb_binds_var defer wanted
err_ctxt = CEC { cec_encl = []
, cec_tidy = tidy_env
, cec_defer = defer
- , cec_suppress = insolubleWC wanted
- -- See Note [Suppressing error messages]
+ , cec_suppress = False -- See Note [Suppressing error messages]
, cec_binds = mb_binds_var }
; traceTc "reportUnsolved (after unflattening):" $
@@ -161,8 +155,23 @@ data ReportErrCtxt
, cec_suppress :: Bool -- True <=> More important errors have occurred,
-- so create bindings if need be, but
-- don't issue any more errors/warnings
+ -- See Note [Suppressing error messages]
}
+\end{code}
+Note [Suppressing error messages]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+The cec_suppress flag says "don't report any errors. Instead, just create
+evidence bindings (as usual). It's used when more important errors have occurred.
+Specifically (see reportWanteds)
+ * If there are insoluble Givens, then we are in unreachable code and all bets
+ are off. So don't report any further errors.
+ * If there are any insolubles (eg Int~Bool), here or in a nested implication,
+ then suppress errors from the flat constraints here. Sometimes the
+ flat-constraint errors are a knock-on effect of the insolubles.
+
+
+\begin{code}
reportImplic :: ReportErrCtxt -> Implication -> TcM ()
reportImplic ctxt implic@(Implic { ic_skols = tvs, ic_given = given
, ic_wanted = wanted, ic_binds = evb
@@ -188,17 +197,29 @@ reportImplic ctxt implic@(Implic { ic_skols = tvs, ic_given = given
Just {} -> Just evb }
reportWanteds :: ReportErrCtxt -> WantedConstraints -> TcM ()
-reportWanteds ctxt (WC { wc_flat = flats, wc_insol = insols, wc_impl = implics })
- = do { reportFlats (ctxt { cec_suppress = False }) (mapBag (tidyCt env) insols)
- ; reportFlats ctxt (mapBag (tidyCt env) flats)
+reportWanteds ctxt wanted@(WC { wc_flat = flats, wc_insol = insols, wc_impl = implics })
+ = do { reportFlats ctxt (mapBag (tidyCt env) insol_given)
+ ; reportFlats ctxt1 (mapBag (tidyCt env) insol_wanted)
+ ; reportFlats ctxt2 (mapBag (tidyCt env) flats)
-- All the Derived ones have been filtered out of flats
-- by the constraint solver. This is ok; we don't want
-- to report unsolved Derived goals as errors
-- See Note [Do not report derived but soluble errors]
- ; mapBagM_ (reportImplic ctxt) implics }
- where
+ ; mapBagM_ (reportImplic ctxt1) implics }
+ -- NB ctxt1: don't suppress inner insolubles if there's only a
+ -- wanted insoluble here; but do suppress inner insolubles
+ -- if there's a given insoluble here (= inaccessible code)
+ where
+ (insol_given, insol_wanted) = partitionBag isGivenCt insols
env = cec_tidy ctxt
+ -- See Note [Suppressing error messages]
+ suppress0 = cec_suppress ctxt
+ suppress1 = suppress0 || not (isEmptyBag insol_given)
+ suppress2 = suppress0 || insolubleWC wanted
+ ctxt1 = ctxt { cec_suppress = suppress1 }
+ ctxt2 = ctxt { cec_suppress = suppress2 }
+
reportFlats :: ReportErrCtxt -> Cts -> TcM ()
reportFlats ctxt flats -- Here 'flats' includes insolble goals
= traceTc "reportFlats" (ppr flats) >>
diff --git a/compiler/typecheck/TcRnTypes.lhs b/compiler/typecheck/TcRnTypes.lhs
index b1de4b5..c13d013 100644
--- a/compiler/typecheck/TcRnTypes.lhs
+++ b/compiler/typecheck/TcRnTypes.lhs
@@ -970,13 +970,33 @@ ctPred :: Ct -> PredType
ctPred ct = ctEvPred (cc_ev ct)
dropDerivedWC :: WantedConstraints -> WantedConstraints
-dropDerivedWC wc@(WC { wc_flat = flats })
- = wc { wc_flat = filterBag isWantedCt flats }
- -- Don't filter the insolubles, because derived
- -- insolubles should stay so that we report them.
+-- See Note [Insoluble derived constraints]
+dropDerivedWC wc@(WC { wc_flat = flats, wc_insol = insols })
+ = wc { wc_flat = filterBag isWantedCt flats
+ , wc_insol = filterBag (not . isDerivedCt) insols }
+ -- Keep Givens from insols because they indicate unreachable code
-- The implications are (recursively) already filtered
\end{code}
+Note [Insoluble derived constraints]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+In general we discard derived constraints at the end of constraint solving;
+see dropDerivedWC. For example,
+
+ * If we have an unsolved (Ord a), we don't want to complain about
+ an unsolved (Eq a) as well.
+ * If we have kind-incompatible (a::* ~ Int#::#) equality, we
+ don't want to complain about the kind error twice.
+
+Arguably, for *some* derived contraints we might want to report errors.
+Notably, functional dependencies. If we have
+ class C a b | a -> b
+and we have
+ [W] C a b, [W] C a c
+where a,b,c are all signature variables. Then we could reasonably
+report an error unifying (b ~ c). But it's probably not worth it;
+after all, we also get an error because we can't discharge the constraint.
+
%************************************************************************
%* *
More information about the ghc-commits
mailing list