Commit 95ba5d81 authored by Joachim Breitner's avatar Joachim Breitner
Browse files

More detailed error message when GND fails

we now print the precise class method, with types, where the coercion
failed.
parent d14e5bf3
......@@ -1560,9 +1560,9 @@ mkNewTypeEqn dflags tvs
-- newtype type; precisely the constraints required for the
-- calls to coercible that we are going to generate.
coercible_constraints =
mkThetaOrigin DerivOrigin $
map (\(Pair t1 t2) -> mkCoerciblePred t1 t2) $
mkCoerceClassMethEqn cls (varSetElemsKvsFirst dfun_tvs) inst_tys rep_inst_ty
[ let (Pair t1 t2) = mkCoerceClassMethEqn cls (varSetElemsKvsFirst dfun_tvs) inst_tys rep_inst_ty meth
in mkPredOrigin (DerivOriginCoerce meth t1 t2) (mkCoerciblePred t1 t2)
| meth <- classMethods cls ]
-- If there are no tyvars, there's no need
-- to abstract over the dictionaries we need
......
......@@ -1051,6 +1051,7 @@ mk_dict_err ctxt (ct, (matches, unifiers, safe_haskell))
drv_fixes = case orig of
DerivOrigin -> [drv_fix]
DerivOriginDC {} -> [drv_fix]
DerivOriginCoerce {} -> [drv_fix]
_ -> []
drv_fix = hang (ptext (sLit "use a standalone 'deriving instance' declaration,"))
......
......@@ -1913,20 +1913,16 @@ mkCoerceClassMethEqn :: Class -- the class being derived
-> [TyVar] -- the tvs in the instance head
-> [Type] -- instance head parameters (incl. newtype)
-> Type -- the representation type (already eta-reduced)
-> [Pair Type]
mkCoerceClassMethEqn cls inst_tvs cls_tys rhs_ty
= map mk_tys $ classMethods cls
-> Id -- the method to look at
-> Pair Type
mkCoerceClassMethEqn cls inst_tvs cls_tys rhs_ty id
= Pair (substTy rhs_subst user_meth_ty) (substTy lhs_subst user_meth_ty)
where
cls_tvs = classTyVars cls
in_scope = mkInScopeSet $ mkVarSet inst_tvs
lhs_subst = mkTvSubst in_scope (zipTyEnv cls_tvs cls_tys)
rhs_subst = mkTvSubst in_scope (zipTyEnv cls_tvs (changeLast cls_tys rhs_ty))
mk_tys :: Id -> Pair Type
mk_tys id = Pair (substTy rhs_subst user_meth_ty)
(substTy lhs_subst user_meth_ty)
where
(_class_tvs, _class_constraint, user_meth_ty) = tcSplitSigmaTy (varType id)
(_class_tvs, _class_constraint, user_meth_ty) = tcSplitSigmaTy (varType id)
changeLast :: [a] -> a -> [a]
changeLast [] _ = panic "changeLast"
......@@ -1943,7 +1939,7 @@ gen_Newtype_binds :: SrcSpan
gen_Newtype_binds loc cls inst_tvs cls_tys rhs_ty
= listToBag $ zipWith mk_bind
(classMethods cls)
(mkCoerceClassMethEqn cls inst_tvs cls_tys rhs_ty)
(map (mkCoerceClassMethEqn cls inst_tvs cls_tys rhs_ty) (classMethods cls))
where
coerce_RDR = getRdrName coerceId
mk_bind :: Id -> Pair Type -> LHsBind RdrName
......
......@@ -1780,7 +1780,10 @@ data CtOrigin
| ScOrigin -- Typechecking superclasses of an instance declaration
| DerivOrigin -- Typechecking deriving
| DerivOriginDC DataCon Int
-- Checking constraings arising from this data an and field index
-- Checking constraints arising from this data con and field index
| DerivOriginCoerce Id Type Type
-- DerivOriginCoerce id ty1 ty2: Trying to coerce class method `id` from
-- `ty1` to `ty2`.
| StandAloneDerivOrigin -- Typechecking stand-alone deriving
| DefaultOrigin -- Typechecking a default decl
| DoOrigin -- Arising from a do expression
......@@ -1822,6 +1825,10 @@ pprO (DerivOriginDC dc n) = hsep [ ptext (sLit "the"), speakNth n,
ptext (sLit "field of"), quotes (ppr dc),
parens (ptext (sLit "type") <+> quotes (ppr ty)) ]
where ty = dataConOrigArgTys dc !! (n-1)
pprO (DerivOriginCoerce meth ty1 ty2)
= fsep [ ptext (sLit "the coercion"), ptext (sLit "of the method")
, quotes (ppr meth), ptext (sLit "from type"), quotes (ppr ty1)
, ptext (sLit "to type"), quotes (ppr ty2) ]
pprO StandAloneDerivOrigin = ptext (sLit "a 'deriving' declaration")
pprO DefaultOrigin = ptext (sLit "a 'default' declaration")
pprO DoOrigin = ptext (sLit "a do statement")
......
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