diff options
| -rw-r--r-- | compiler/typecheck/TcDeriv.lhs | 10 | ||||
| -rw-r--r-- | compiler/typecheck/TcErrors.lhs | 5 | ||||
| -rw-r--r-- | compiler/typecheck/TcRnTypes.lhs | 8 |
3 files changed, 16 insertions, 7 deletions
diff --git a/compiler/typecheck/TcDeriv.lhs b/compiler/typecheck/TcDeriv.lhs index 5931652edf..49111a919d 100644 --- a/compiler/typecheck/TcDeriv.lhs +++ b/compiler/typecheck/TcDeriv.lhs @@ -1049,11 +1049,13 @@ inferConstraints cls inst_tys rep_tc rep_tc_args where -- Constraints arising from the arguments of each constructor con_arg_constraints cls' get_constrained_tys - = [ mkPredOrigin DerivOrigin (mkClassPred cls' [arg_ty]) + = [ mkPredOrigin (DerivOriginDC data_con arg_n) (mkClassPred cls' [arg_ty]) | data_con <- tyConDataCons rep_tc, - arg_ty <- ASSERT( isVanillaDataCon data_con ) - get_constrained_tys $ - dataConInstOrigArgTys data_con all_rep_tc_args, + (arg_n, arg_ty) <- + ASSERT( isVanillaDataCon data_con ) + zip [1..] $ + get_constrained_tys $ + dataConInstOrigArgTys data_con all_rep_tc_args, not (isUnLiftedType arg_ty) ] -- No constraints for unlifted types -- See Note [Deriving and unboxed types] diff --git a/compiler/typecheck/TcErrors.lhs b/compiler/typecheck/TcErrors.lhs index 83d38da704..e0be85f0ef 100644 --- a/compiler/typecheck/TcErrors.lhs +++ b/compiler/typecheck/TcErrors.lhs @@ -1049,8 +1049,9 @@ mk_dict_err ctxt (ct, (matches, unifiers, safe_haskell)) = ptext (sLit "Could not deduce") <+> pprParendType pred drv_fixes = case orig of - DerivOrigin -> [drv_fix] - _ -> [] + DerivOrigin -> [drv_fix] + DerivOriginDC {} -> [drv_fix] + _ -> [] drv_fix = hang (ptext (sLit "use a standalone 'deriving instance' declaration,")) 2 (ptext (sLit "so you can specify the instance context yourself")) diff --git a/compiler/typecheck/TcRnTypes.lhs b/compiler/typecheck/TcRnTypes.lhs index 9fc2cebac9..1b38378d2e 100644 --- a/compiler/typecheck/TcRnTypes.lhs +++ b/compiler/typecheck/TcRnTypes.lhs @@ -90,7 +90,7 @@ import TcEvidence import Type import Class ( Class ) import TyCon ( TyCon ) -import DataCon ( DataCon, dataConUserType ) +import DataCon ( DataCon, dataConUserType, dataConOrigArgTys ) import TcType import Annotations import InstEnv @@ -1779,6 +1779,8 @@ 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 | StandAloneDerivOrigin -- Typechecking stand-alone deriving | DefaultOrigin -- Typechecking a default decl | DoOrigin -- Arising from a do expression @@ -1816,6 +1818,10 @@ pprO TupleOrigin = ptext (sLit "a tuple") pprO NegateOrigin = ptext (sLit "a use of syntactic negation") pprO ScOrigin = ptext (sLit "the superclasses of an instance declaration") pprO DerivOrigin = ptext (sLit "the 'deriving' clause of a data type declaration") +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 StandAloneDerivOrigin = ptext (sLit "a 'deriving' declaration") pprO DefaultOrigin = ptext (sLit "a 'default' declaration") pprO DoOrigin = ptext (sLit "a do statement") |