Commit f4384ef5 authored by Ryan Scott's avatar Ryan Scott

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
parent 822af416
......@@ -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"
......
......@@ -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
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment