Repository : http://darcs.haskell.org/ghc.git/
On branch : master https://github.com/ghc/ghc/commit/6806906d41581c42805e2f09cc6fda9035a288ef >--------------------------------------------------------------- commit 6806906d41581c42805e2f09cc6fda9035a288ef Author: Jose Pedro Magalhaes <[email protected]> Date: Tue May 21 14:55:36 2013 +0100 Fix #5863 >--------------------------------------------------------------- compiler/typecheck/TcDeriv.lhs | 32 ++++++++++++++++++++++++-------- docs/users_guide/glasgow_exts.xml | 3 +++ 2 files changed, 27 insertions(+), 8 deletions(-) diff --git a/compiler/typecheck/TcDeriv.lhs b/compiler/typecheck/TcDeriv.lhs index d7cb08d..786d93e 100644 --- a/compiler/typecheck/TcDeriv.lhs +++ b/compiler/typecheck/TcDeriv.lhs @@ -606,9 +606,13 @@ deriveTyData tvs tc tc_args (L loc deriv_pred) -- Typeable is special ; if className cls == typeableClassName - then mkEqnHelp DerivOrigin - tvs cls cls_tys - (mkTyConApp tc (kindVarsOnly tc_args)) Nothing + then do { + ; dflags <- getDynFlags + ; case checkTypeableConditions (dflags, tc, tc_args) of + Just err -> failWithTc (derivingThingErr False cls cls_tys + (mkTyConApp tc tc_args) err) + Nothing -> mkEqnHelp DerivOrigin tvs cls cls_tys + (mkTyConApp tc (kindVarsOnly tc_args)) Nothing } else do { -- Given data T a b c = ... deriving( C d ), @@ -715,10 +719,8 @@ mkEqnHelp orig tvs cls cls_tys tc_app mtheta Nothing -> mkOldTypeableEqn orig tvs cls tycon tc_args mtheta } | className cls == typeableClassName - = do { dflags <- getDynFlags - ; case checkTypeableConditions (dflags, tycon, tc_args) of - Just err -> bale_out err - Nothing -> mkPolyKindedTypeableEqn orig tvs cls cls_tys tycon tc_args mtheta } + -- We checked for errors before, so we don't need to do that again + = mkPolyKindedTypeableEqn orig tvs cls cls_tys tycon tc_args mtheta | isDataFamilyTyCon tycon , length tc_args /= tyConArity tycon @@ -985,7 +987,7 @@ checkSideConditions dflags mtheta cls cls_tys rep_tc rep_tc_args ty_args_why = quotes (ppr (mkClassPred cls cls_tys)) <+> ptext (sLit "is not a class") checkTypeableConditions, checkOldTypeableConditions :: Condition -checkTypeableConditions = checkFlag Opt_DeriveDataTypeable +checkTypeableConditions = checkFlag Opt_DeriveDataTypeable `andCond` cond_TypeableOK checkOldTypeableConditions = checkFlag Opt_DeriveDataTypeable `andCond` cond_oldTypeableOK nonStdErr :: Class -> SDoc @@ -1130,6 +1132,20 @@ cond_oldTypeableOK (_, tc, _) bad_kind = quotes (pprSourceTyCon tc) <+> ptext (sLit "must only have arguments of kind `*'") +cond_TypeableOK :: Condition +-- Only not ok if it's a data instance +cond_TypeableOK (_, tc, tc_args) + | isDataFamilyTyCon tc && not (null tc_args) + = Just no_families + + | otherwise + = Nothing + where + no_families = sep [ ptext (sLit "Deriving Typeable is not allowed for family instances;") + , ptext (sLit "derive Typeable for") + <+> quotes (pprSourceTyCon tc) + <+> ptext (sLit "alone") ] + functorLikeClassKeys :: [Unique] functorLikeClassKeys = [functorClassKey, foldableClassKey, traversableClassKey] diff --git a/docs/users_guide/glasgow_exts.xml b/docs/users_guide/glasgow_exts.xml index 47c8ab0..d9ad6a5 100644 --- a/docs/users_guide/glasgow_exts.xml +++ b/docs/users_guide/glasgow_exts.xml @@ -3377,6 +3377,9 @@ type class. Instances for datatypes can be derived by attaching a <literal>deriving Typeable</literal> clause to the datatype declaration, or by using standalone deriving (see <xref linkend="stand-alone-deriving"/>). Instances for type classes can only be derived using standalone deriving. +For data families, <literal>Typeable</literal> should only be derived for the +uninstantiated family type; each instance will then automatically have a +<literal>Typeable</literal> instance too. See also <xref linkend="auto-derive-typeable"/>. </para> <para> _______________________________________________ ghc-commits mailing list [email protected] http://www.haskell.org/mailman/listinfo/ghc-commits
