[commit: ghc] master: Fix #7710: do not AutoDeriveTypeable for synonyms and type families (84742c0)

[José Pedro Magalhães]

Repository : ssh://darcs.haskell.org//srv/darcs/ghc

On branch  : master

http://hackage.haskell.org/trac/ghc/changeset/84742c08b029978cef8f985bd8c2615cdbab9321

>---------------------------------------------------------------

commit 84742c08b029978cef8f985bd8c2615cdbab9321
Author: Jose Pedro Magalhaes <jpm at cs.ox.ac.uk>
Date:   Thu Feb 21 09:33:31 2013 +0000

    Fix #7710: do not AutoDeriveTypeable for synonyms and type families

>---------------------------------------------------------------

 compiler/hsSyn/HsDecls.lhs     |   17 ++++++++++++++---
 compiler/typecheck/TcDeriv.lhs |    2 +-
 2 files changed, 15 insertions(+), 4 deletions(-)

diff --git a/compiler/hsSyn/HsDecls.lhs b/compiler/hsSyn/HsDecls.lhs
index 32218e5..13638a0 100644
--- a/compiler/hsSyn/HsDecls.lhs
+++ b/compiler/hsSyn/HsDecls.lhs
@@ -15,7 +15,8 @@ module HsDecls (
   HsDecl(..), LHsDecl, HsDataDefn(..),
   -- ** Class or type declarations
   TyClDecl(..), LTyClDecl, TyClGroup,
-  isClassDecl, isDataDecl, isSynDecl, isFamilyDecl, tcdName,
+  isClassDecl, isDataDecl, isSynDecl, tcdName,
+  isFamilyDecl, isTypeFamilyDecl, isDataFamilyDecl,
   tyFamInstDeclName, tyFamInstDeclLName,
   countTyClDecls, pprTyClDeclFlavour,
   tyClDeclLName, tyClDeclTyVars,
@@ -476,7 +477,7 @@ data FamilyDecl name = FamilyDecl
 data FamilyFlavour
   = TypeFamily
   | DataFamily
-  deriving( Data, Typeable )
+  deriving( Data, Typeable, Eq )
 
 \end{code}
 
@@ -500,10 +501,20 @@ isClassDecl :: TyClDecl name -> Bool
 isClassDecl (ClassDecl {}) = True
 isClassDecl _              = False
 
--- | type family declaration
+-- | type/data family declaration
 isFamilyDecl :: TyClDecl name -> Bool
 isFamilyDecl (FamDecl {})  = True
 isFamilyDecl _other        = False
+
+-- | type family declaration
+isTypeFamilyDecl :: TyClDecl name -> Bool
+isTypeFamilyDecl (FamDecl d) = fdFlavour d == TypeFamily
+isTypeFamilyDecl _other      = False
+
+-- | data family declaration
+isDataFamilyDecl :: TyClDecl name -> Bool
+isDataFamilyDecl (FamDecl d) = fdFlavour d == DataFamily
+isDataFamilyDecl _other      = False
 \end{code}
 
 Dealing with names
diff --git a/compiler/typecheck/TcDeriv.lhs b/compiler/typecheck/TcDeriv.lhs
index 7374e62..6a83268 100644
--- a/compiler/typecheck/TcDeriv.lhs
+++ b/compiler/typecheck/TcDeriv.lhs
@@ -379,7 +379,7 @@ tcDeriving tycl_decls inst_decls deriv_decls
     deriveTypeable tys =
       [ L l (DerivDecl (L l (HsAppTy (noLoc (HsTyVar typeableClassName))
                                      (L l (HsTyVar (tcdName t))))))
-      | L l t <- tys ]
+      | L l t <- tys, not (isSynDecl t), not (isTypeFamilyDecl t) ]
 
 -- Prints the representable type family instance
 pprRepTy :: FamInst Unbranched -> SDoc