From f4384ef5b42bb64b55d6c930ed9850a021796f36 Mon Sep 17 00:00:00 2001 From: Ryan Scott Date: Mon, 29 Aug 2016 15:26:53 -0400 Subject: [PATCH] Remove unused DerivInst constructor for DerivStuff Summary: Back when derived `Generic` instances used to generate auxiliary datatypes, they would also generate instances for those datatypes. Nowadays, GHC generics uses a `DataKinds`-based encoding that requires neither auxiliary datatypes (corresponding to the `DerivTyCon` constructor of `DerivStuff`) nor instances for them (the `DerivInst` constructor of `DerivStuff`). It appears that `DerivTyCon` constructor was removed at some point, but `DerivInst` never was. No `DerivInst` values are ever constructed, so we can safely remove it. Test Plan: It builds Reviewers: austin, hvr, bgamari Reviewed By: bgamari Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D2481 --- compiler/typecheck/TcDeriv.hs | 5 ++--- compiler/typecheck/TcGenDeriv.hs | 22 +++++++++------------- 2 files changed, 11 insertions(+), 16 deletions(-) diff --git a/compiler/typecheck/TcDeriv.hs b/compiler/typecheck/TcDeriv.hs index 70eaf5cb21..e38cfdccce 100644 --- a/compiler/typecheck/TcDeriv.hs +++ b/compiler/typecheck/TcDeriv.hs @@ -387,13 +387,12 @@ tcDeriving deriv_infos deriv_decls ; let (inst_infos, deriv_stuff, maybe_fvs) = unzip3 (insts1 ++ insts2) ; loc <- getSrcSpanM - ; let (binds, famInsts, extraInstances) = - genAuxBinds loc (unionManyBags deriv_stuff) + ; let (binds, famInsts) = genAuxBinds loc (unionManyBags deriv_stuff) ; dflags <- getDynFlags ; (inst_info, rn_binds, rn_dus) <- - renameDeriv is_boot (inst_infos ++ (bagToList extraInstances)) binds + renameDeriv is_boot inst_infos binds ; unless (isEmptyBag inst_info) $ liftIO (dumpIfSet_dyn dflags Opt_D_dump_deriv "Derived instances" diff --git a/compiler/typecheck/TcGenDeriv.hs b/compiler/typecheck/TcGenDeriv.hs index 2eb8c07238..dce0b166e5 100644 --- a/compiler/typecheck/TcGenDeriv.hs +++ b/compiler/typecheck/TcGenDeriv.hs @@ -70,7 +70,6 @@ import Lexeme import FastString import Pair import Bag -import TcEnv (InstInfo) import StaticFlags( opt_PprStyle_Debug ) import ListSetOps ( assocMaybe ) @@ -90,12 +89,11 @@ data AuxBindSpec data DerivStuff -- Please add this auxiliary stuff = DerivAuxBind AuxBindSpec - -- Generics + -- Generics and DeriveAnyClass | DerivFamInst FamInst -- New type family instances -- New top-level auxiliary bindings | DerivHsBind (LHsBind RdrName, LSig RdrName) -- Also used for SYB - | DerivInst (InstInfo RdrName) -- New, auxiliary instances {- ************************************************************************ @@ -2346,11 +2344,11 @@ genAuxBindSpec loc (DerivMaxTag tycon) max_tag = case (tyConDataCons tycon) of data_cons -> toInteger ((length data_cons) - fIRST_TAG) -type SeparateBagsDerivStuff = -- AuxBinds and SYB bindings - ( Bag (LHsBind RdrName, LSig RdrName) - -- Extra bindings (used by Generic only) - , Bag (FamInst) -- Extra family instances - , Bag (InstInfo RdrName)) -- Extra instances +type SeparateBagsDerivStuff = + -- AuxBinds and SYB bindings + ( Bag (LHsBind RdrName, LSig RdrName) + -- Extra family instances (used by Generic and DeriveAnyClass) + , Bag (FamInst) ) genAuxBinds :: SrcSpan -> BagDerivStuff -> SeparateBagsDerivStuff genAuxBinds loc b = genAuxBinds' b2 where @@ -2363,16 +2361,14 @@ genAuxBinds loc b = genAuxBinds' b2 where genAuxBinds' :: BagDerivStuff -> SeparateBagsDerivStuff genAuxBinds' = foldrBag f ( mapBag (genAuxBindSpec loc) (rm_dups b1) - , emptyBag, emptyBag) + , emptyBag ) f :: DerivStuff -> SeparateBagsDerivStuff -> SeparateBagsDerivStuff f (DerivAuxBind _) = panic "genAuxBinds'" -- We have removed these before f (DerivHsBind b) = add1 b f (DerivFamInst t) = add2 t - f (DerivInst i) = add3 i - add1 x (a,b,c) = (x `consBag` a,b,c) - add2 x (a,b,c) = (a,x `consBag` b,c) - add3 x (a,b,c) = (a,b,x `consBag` c) + add1 x (a,b) = (x `consBag` a,b) + add2 x (a,b) = (a,x `consBag` b) mkParentType :: TyCon -> Type -- Turn the representation tycon of a family into -- GitLab