Commit ffdbaf3a authored by simonpj@microsoft.com's avatar simonpj@microsoft.com
Browse files

Improve error reporting for type-improvement errors

parent 2817782f
......@@ -42,9 +42,9 @@ import Inst ( lookupInst, LookupInstResult(..),
import TcEnv ( tcGetGlobalTyVars, tcLookupId, findGlobals, pprBinders,
lclEnvElts, tcMetaTy )
import InstEnv ( lookupInstEnv, classInstances, pprInstances )
import TcMType ( zonkTcTyVarsAndFV, tcInstTyVars,
import TcMType ( zonkTcTyVarsAndFV, tcInstTyVars, zonkTcPredType,
checkAmbiguity, checkInstTermination )
import TcType ( TcTyVar, TcTyVarSet, ThetaType, TcPredType,
import TcType ( TcTyVar, TcTyVarSet, ThetaType, TcPredType, tidyPred,
mkClassPred, isOverloadedTy, mkTyConApp, isSkolemTyVar,
mkTyVarTy, tcGetTyVar, isTyVarClassPred, mkTyVarTys,
tyVarsOfPred, tcEqType, pprPred, mkPredTy, tcIsTyVarTy )
......@@ -55,7 +55,7 @@ import TyCon ( TyCon )
import Name ( Name, getOccName, getSrcLoc )
import NameSet ( NameSet, mkNameSet, elemNameSet )
import Class ( classBigSig, classKey )
import FunDeps ( oclose, grow, improve, pprEquationDoc )
import FunDeps ( oclose, grow, improve, pprEquation )
import PrelInfo ( isNumericClass, isStandardClass )
import PrelNames ( splitName, fstName, sndName, integerTyConName,
showClassKey, eqClassKey, ordClassKey )
......@@ -1660,11 +1660,21 @@ tcImprove avails
mappM_ unify eqns `thenM_`
returnM False
where
unify ((qtvs, pairs), doc)
= addErrCtxt doc $
unify ((qtvs, pairs), what1, what2)
= addErrCtxtM (mkEqnMsg what1 what2) $
tcInstTyVars (varSetElems qtvs) `thenM` \ (_, _, tenv) ->
mapM_ (unif_pr tenv) pairs
unif_pr tenv (ty1,ty2) = unifyType (substTy tenv ty1) (substTy tenv ty2)
pprEquationDoc (eqn, (p1,w1), (p2,w2)) = vcat [pprEquation eqn, nest 2 (ppr p1), nest 2 (ppr p2)]
mkEqnMsg (pred1,from1) (pred2,from2) tidy_env
= do { pred1' <- zonkTcPredType pred1; pred2' <- zonkTcPredType pred2
; let { pred1'' = tidyPred tidy_env pred1'; pred2'' = tidyPred tidy_env pred2' }
; let msg = vcat [ptext SLIT("When using functional dependencies to combine"),
nest 2 (sep [ppr pred1'' <> comma, nest 2 from1]),
nest 2 (sep [ppr pred2'' <> comma, nest 2 from2])]
; return (tidy_env, msg) }
\end{code}
The main context-reduction function is @reduce@. Here's its game plan.
......
......@@ -7,7 +7,7 @@ It's better to read it as: "if we know these, then we're going to know these"
\begin{code}
module FunDeps (
Equation, pprEquation, pprEquationDoc,
Equation, pprEquation,
oclose, grow, improve,
checkInstCoverage, checkFunDeps,
pprFundeps
......@@ -172,18 +172,19 @@ type Equation = (TyVarSet, [(Type, Type)])
-- We usually act on an equation by instantiating the quantified type varaibles
-- to fresh type variables, and then calling the standard unifier.
pprEquationDoc (eqn, doc) = vcat [pprEquation eqn, nest 2 doc]
pprEquation (qtvs, pairs)
= vcat [ptext SLIT("forall") <+> braces (pprWithCommas ppr (varSetElems qtvs)),
nest 2 (vcat [ ppr t1 <+> ptext SLIT(":=:") <+> ppr t2 | (t1,t2) <- pairs])]
----------
improve :: (Class -> [Instance]) -- Gives instances for given class
-> [(PredType,SDoc)] -- Current constraints; doc says where they come from
-> [(Equation,SDoc)] -- Derived equalities that must also hold
-- (NB the above INVARIANT for type Equation)
-- The SDoc explains why the equation holds (for error messages)
type Pred_Loc = (PredType, SDoc) -- SDoc says where the Pred comes from
improve :: (Class -> [Instance]) -- Gives instances for given class
-> [Pred_Loc] -- Current constraints;
-> [(Equation,Pred_Loc,Pred_Loc)] -- Derived equalities that must also hold
-- (NB the above INVARIANT for type Equation)
-- The Pred_Locs explain which two predicates were
-- combined (for error messages)
\end{code}
Given a bunch of predicates that must hold, such as
......@@ -222,13 +223,13 @@ improve inst_env preds
----------
checkGroup :: (Class -> [Instance])
-> [(PredType,SDoc)]
-> [(Equation, SDoc)]
-> [Pred_Loc]
-> [(Equation, Pred_Loc, Pred_Loc)]
-- The preds are all for the same class or implicit param
checkGroup inst_env (p1@(IParam _ ty, _) : ips)
= -- For implicit parameters, all the types must match
[ ((emptyVarSet, [(ty,ty')]), mkEqnMsg p1 p2)
[ ((emptyVarSet, [(ty,ty')]), p1, p2)
| p2@(IParam _ ty', _) <- ips, not (ty `tcEqType` ty')]
checkGroup inst_env clss@((ClassP cls _, _) : _)
......@@ -261,18 +262,18 @@ checkGroup inst_env clss@((ClassP cls _, _) : _)
-- NOTE that we iterate over the fds first; they are typically
-- empty, which aborts the rest of the loop.
pairwise_eqns :: [(Equation,SDoc)]
pairwise_eqns :: [(Equation,Pred_Loc,Pred_Loc)]
pairwise_eqns -- This group comes from pairwise comparison
= [ (eqn, mkEqnMsg p1 p2)
= [ (eqn, p1, p2)
| fd <- cls_fds,
p1@(ClassP _ tys1, _) : rest <- tails clss,
p2@(ClassP _ tys2, _) <- rest,
eqn <- checkClsFD emptyVarSet fd cls_tvs tys1 tys2
]
instance_eqns :: [(Equation,SDoc)]
instance_eqns :: [(Equation,Pred_Loc,Pred_Loc)]
instance_eqns -- This group comes from comparing with instance decls
= [ (eqn, mkEqnMsg p1 p2)
= [ (eqn, p1, p2)
| fd <- cls_fds, -- Iterate through the fundeps first,
-- because there often are none!
p2@(ClassP _ tys2, _) <- clss,
......@@ -285,12 +286,6 @@ checkGroup inst_env clss@((ClassP cls _, _) : _)
ptext SLIT("arising from the instance declaration at") <+>
ppr (getSrcLoc ispec))
]
mkEqnMsg (pred1,from1) (pred2,from2)
= vcat [ptext SLIT("When using functional dependencies to combine"),
nest 2 (sep [ppr pred1 <> comma, nest 2 from1]),
nest 2 (sep [ppr pred2 <> comma, nest 2 from2])]
----------
checkClsFD :: TyVarSet -- Quantified type variables; see note below
-> FunDep TyVar -> [TyVar] -- One functional dependency from the class
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment