[commit: ghc] master: Remove unused DerivInst constructor for DerivStuff (f4384ef)

git at git.haskell.org git at git.haskell.org
Mon Aug 29 19:28:42 UTC 2016


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

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

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

commit f4384ef5b42bb64b55d6c930ed9850a021796f36
Author: Ryan Scott <ryan.gl.scott at gmail.com>
Date:   Mon Aug 29 15:26:53 2016 -0400

    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


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

f4384ef5b42bb64b55d6c930ed9850a021796f36
 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 70eaf5c..e38cfdc 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 2eb8c07..dce0b16 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



More information about the ghc-commits mailing list