[commit: ghc] master: Tidy up fix to Trac #9999 (d3c08ca)

git at git.haskell.org git at git.haskell.org
Mon Jan 19 16:44:26 UTC 2015


Repository : ssh://git@git.haskell.org/ghc

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/d3c08ca0c4f83aaed6bd25785a03c0fb52438ba6/ghc

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

commit d3c08ca0c4f83aaed6bd25785a03c0fb52438ba6
Author: Simon Peyton Jones <simonpj at microsoft.com>
Date:   Mon Jan 19 16:45:31 2015 +0000

    Tidy up fix to Trac #9999
    
    Minor refactoring only


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

d3c08ca0c4f83aaed6bd25785a03c0fb52438ba6
 compiler/typecheck/TcDeriv.hs | 14 ++++++--------
 1 file changed, 6 insertions(+), 8 deletions(-)

diff --git a/compiler/typecheck/TcDeriv.hs b/compiler/typecheck/TcDeriv.hs
index ae95f33..3d980e2 100644
--- a/compiler/typecheck/TcDeriv.hs
+++ b/compiler/typecheck/TcDeriv.hs
@@ -560,17 +560,15 @@ deriveAutoTypeable auto_typeable done_specs tycl_decls
         -- omitted because the user had manually requested an instance
 
     do_one cls (L _ decl)
+      | isClassDecl decl  -- Traverse into class declarations to check if they have ATs (#9999)
+      = concatMapM (do_one cls) (map (fmap FamDecl) (tcdATs decl))
+      | otherwise
       = do { tc <- tcLookupTyCon (tcdName decl)
-           -- Traverse into class declarations to check if they have ATs (#9999)
-           ; ats <- if isClassDecl decl
-                    then concatMapM (do_one cls) (map (fmap FamDecl) (tcdATs decl))
-                    else return []
-           ; rest <- if (isTypeSynonymTyCon tc || isTypeFamilyTyCon tc
+           ; if (isTypeSynonymTyCon tc || isTypeFamilyTyCon tc
                                        || tyConName tc `elemNameSet` done_tcs)
                      -- Do not derive Typeable for type synonyms or type families
-                     then return []
-                     else mkPolyKindedTypeableEqn cls tc
-          ; return (ats ++ rest) }
+             then return []
+             else mkPolyKindedTypeableEqn cls tc }
 
 ------------------------------------------------------------------
 deriveTyDecl :: LTyClDecl Name -> TcM [EarlyDerivSpec]



More information about the ghc-commits mailing list