Commit 81ca95c5 authored by simonpj's avatar simonpj
Browse files

[project @ 2003-02-06 09:29:14 by simonpj]

Improve error message
parent 24148a7a
......@@ -366,10 +366,16 @@ makeDerivEqns tycl_decls
returnM (Nothing, Just (InstInfo { iDFunId = mk_dfun dfun_name,
iBinds = NewTypeDerived rep_tys }))
else
if standard_instance then
if standard_instance then
mk_eqn_help DataType tycon clas [] -- Go via bale-out route
else
else
-- Non-standard instance
if gla_exts then
-- Too hard
bale_out cant_derive_err
else
-- Just complain about being a non-std instance
bale_out non_std_err
where
-- Here is the plan for newtype derivings. We see
-- newtype T a1...an = T (t ak...an) deriving (.., C s1 .. sm, ...)
......@@ -486,13 +492,17 @@ makeDerivEqns tycl_decls
ppr (isRecursiveTyCon tycon)
])
non_std_err = derivingThingErr clas tys tycon tyvars_to_keep
(vcat [non_std_why clas,
ptext SLIT("Try -fglasgow-exts for GHC's newtype-deriving extension")])
bale_out err = addErrTc err `thenM_` returnM (Nothing, Nothing)
------------------------------------------------------------------
chk_out :: Class -> TyCon -> [TcType] -> Maybe SDoc
chk_out clas tycon tys
| notNull tys = Just ty_args_why
| not (getUnique clas `elem` derivableClassKeys) = Just non_std_why
| not (getUnique clas `elem` derivableClassKeys) = Just (non_std_why clas)
| clas `hasKey` enumClassKey && not is_enumeration = Just nullary_why
| clas `hasKey` boundedClassKey && not is_enumeration_or_single = Just single_nullary_why
| clas `hasKey` ixClassKey && not is_enumeration_or_single = Just single_nullary_why
......@@ -509,11 +519,12 @@ makeDerivEqns tycl_decls
nullary_why = quotes (ppr tycon) <+> ptext SLIT("has non-nullary constructors")
no_cons_why = quotes (ppr tycon) <+> ptext SLIT("has no data constructors")
ty_args_why = quotes (ppr pred) <+> ptext SLIT("is not a class")
non_std_why = quotes (ppr clas) <+> ptext SLIT("is not a derivable class")
existential_why = quotes (ppr tycon) <+> ptext SLIT("has existentially-quantified constructor(s)")
pred = mkClassPred clas tys
non_std_why clas = quotes (ppr clas) <+> ptext SLIT("is not a derivable class")
new_dfun_name clas tycon -- Just a simple wrapper
= newDFunName clas [mkTyConApp tycon []] (getSrcLoc tycon)
-- The type passed to newDFunName is only used to generate
......
Supports Markdown
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