Commit 3fecf81e authored by's avatar
Browse files

Remove dead code orphaned by implementing GND with `coerce`.

parent b859c188
......@@ -844,15 +844,12 @@ ds_tc_coercion subst tc_co
go (TcTransCo co1 co2) = mkTransCo (go co1) (go co2)
go (TcNthCo n co) = mkNthCo n (go co)
go (TcLRCo lr co) = mkLRCo lr (go co)
go (TcInstCo co ty) = mkInstCo (go co) ty
go (TcSubCo co) = mkSubCo (go co)
go (TcLetCo bs co) = ds_tc_coercion (ds_co_binds bs) co
go (TcCastCo co1 co2) = mkCoCast (go co1) (go co2)
go (TcCoVarCo v) = ds_ev_id subst v
go (TcAxiomRuleCo co ts cs) = AxiomRuleCo co (map (Coercion.substTy subst) ts) (map go cs)
ds_co_binds :: TcEvBinds -> CvSubst
ds_co_binds (EvBinds bs) = foldl ds_scc subst (sccEvBinds bs)
ds_co_binds eb@(TcEvBinds {}) = pprPanic "ds_co_binds" (ppr eb)
......@@ -1569,35 +1569,6 @@ minded way of generating the instance decl:
instance Eq [A] => Eq A -- Makes typechecker loop!
But now we require a simple context, so it's ok.
Note [Role checking in GND]
When checking to see if GND (GeneralizedNewtypeDeriving) is possible, we
do *not* look at the roles of the class being derived. Instead, we look
at the uses of the last type variable to that class in all the methods of
the class. (Why? Keep reading.) For example:
class Foo a b where
meth :: a b -> b
instance Foo Maybe Int where
meth = fromJust
newtype Age = MkAge Int
deriving (Foo Maybe)
According to the role rules, the `b` parameter to Foo must be at nominal
role -- after all, `a` could be a GADT. BUT, when deriving (Foo Maybe)
for Age, we in fact know that `a` is *not* a GADT. So, instead of looking
holistically at the roles for the parameters of Foo, we instead perform
the substitution on the type variables that we know (in this case,
[a |-> Maybe]) and then check each method individually.
Why check only methods, and not other things? In GND, superclass constraints
must be satisfied by the *newtype*, not the *base type*. So, we don't coerce
the base type's superclass dictionaries in GND, and we don't need to check
them here. For associated types, GND is impossible anyway, so we don't need
to look. All that is left is methods.
Note [Determining whether newtype-deriving is appropriate]
When we see
......@@ -21,13 +21,12 @@ module TcEvidence (
TcCoercion(..), LeftOrRight(..), pickLR,
mkTcReflCo, mkTcTyConAppCo, mkTcAppCo, mkTcAppCos, mkTcFunCo,
mkTcAxInstCo, mkTcUnbranchedAxInstCo, mkTcForAllCo, mkTcForAllCos,
mkTcSymCo, mkTcTransCo, mkTcNthCo, mkTcLRCo, mkTcInstCos, mkTcSubCo,
mkTcSymCo, mkTcTransCo, mkTcNthCo, mkTcLRCo, mkTcSubCo,
tcCoercionKind, coVarsOfTcCo, isEqVar, mkTcCoVarCo,
isTcReflCo, isTcReflCo_maybe, getTcCoVar_maybe,
tcCoercionRole, eqVarRole,
) where
#include "HsVersions.h"
......@@ -96,7 +95,6 @@ data TcCoercion
| TcTyConAppCo Role TyCon [TcCoercion]
| TcAppCo TcCoercion TcCoercion
| TcForAllCo TyVar TcCoercion
| TcInstCo TcCoercion TcType
| TcCoVarCo EqVar
| TcAxiomInstCo (CoAxiom Branched) Int [TcCoercion] -- Int specifies branch number
-- See [CoAxiom Index] in Coercion.lhs
......@@ -228,10 +226,6 @@ mkTcForAllCos :: [Var] -> TcCoercion -> TcCoercion
mkTcForAllCos tvs (TcRefl r ty) = ASSERT( all isTyVar tvs ) TcRefl r (mkForAllTys tvs ty)
mkTcForAllCos tvs co = ASSERT( all isTyVar tvs ) foldr TcForAllCo co tvs
mkTcInstCos :: TcCoercion -> [TcType] -> TcCoercion
mkTcInstCos (TcRefl r ty) tys = TcRefl r (applyTys ty tys)
mkTcInstCos co tys = foldl TcInstCo co tys
mkTcCoVarCo :: EqVar -> TcCoercion
-- ipv :: s ~ t (the boxed equality type) or Coercible s t (the boxed representational equality type)
mkTcCoVarCo ipv = TcCoVarCo ipv
......@@ -253,7 +247,6 @@ tcCoercionKind co = go co
go (TcTyConAppCo _ tc cos)= mkTyConApp tc <$> (sequenceA $ map go cos)
go (TcAppCo co1 co2) = mkAppTy <$> go co1 <*> go co2
go (TcForAllCo tv co) = mkForAllTy tv <$> go co
go (TcInstCo co ty) = go_inst co [ty]
go (TcCoVarCo cv) = eqVarKind cv
go (TcAxiomInstCo ax ind cos)
= let branch = coAxiomNthBranch ax ind
......@@ -273,10 +266,6 @@ tcCoercionKind co = go co
Just res -> res
Nothing -> panic "tcCoercionKind: malformed TcAxiomRuleCo"
-- c.f. Coercion.coercionKind
go_inst (TcInstCo co ty) tys = go_inst co (ty:tys)
go_inst co tys = (`applyTys` tys) <$> go co
eqVarRole :: EqVar -> Role
eqVarRole cv = getEqPredRole (varType cv)
......@@ -320,7 +309,6 @@ coVarsOfTcCo tc_co
go (TcAppCo co1 co2) = go co1 `unionVarSet` go co2
go (TcCastCo co1 co2) = go co1 `unionVarSet` go co2
go (TcForAllCo _ co) = go co
go (TcInstCo co _) = go co
go (TcCoVarCo v) = unitVarSet v
go (TcAxiomInstCo _ _ cos) = foldr (unionVarSet . go) emptyVarSet cos
go (TcPhantomCo _ _) = emptyVarSet
......@@ -368,8 +356,6 @@ ppr_co p (TcAppCo co1 co2) = maybeParen p TyConPrec $
ppr_co p (TcCastCo co1 co2) = maybeParen p FunPrec $
ppr_co FunPrec co1 <+> ptext (sLit "|>") <+> ppr_co FunPrec co2
ppr_co p co@(TcForAllCo {}) = ppr_forall_co p co
ppr_co p (TcInstCo co ty) = maybeParen p TyConPrec $
pprParendTcCo co <> ptext (sLit "@") <> pprType ty
ppr_co _ (TcCoVarCo cv) = parenSymOcc (getOccName cv) (ppr cv)
......@@ -1412,7 +1412,6 @@ zonkTcCoToCo env co
; return (mkTcTransCo co1' co2') }
go (TcForAllCo tv co) = ASSERT( isImmutableTyVar tv )
do { co' <- go co; return (mkTcForAllCo tv co') }
go (TcInstCo co ty) = do { co' <- go co; ty' <- zonkTcTypeToType env ty; return (TcInstCo co' ty') }
go (TcSubCo co) = do { co' <- go co; return (mkTcSubCo co') }
go (TcAxiomRuleCo co ts cs) = do { ts' <- zonkTcTypeToTypes env ts
; cs' <- mapM go cs
......@@ -38,7 +38,7 @@ module Coercion (
nthRole, tyConRolesX,
tvUsedAtNominalRole, nextRole,
-- ** Coercion variables
mkCoVar, isCoVar, isCoVarType, coVarName, setCoVarName, setCoVarUnique,
......@@ -1103,21 +1103,6 @@ ltRole Representational _ = False
ltRole Nominal Nominal = False
ltRole Nominal _ = True
-- Is the given tyvar used in a nominal position anywhere?
-- This is used in the GeneralizedNewtypeDeriving check.
tvUsedAtNominalRole :: TyVar -> Type -> Bool
tvUsedAtNominalRole tv = go Representational
where go r (TyVarTy tv')
| tv == tv' = (r == Nominal)
| otherwise = False
go r (AppTy t1 t2) = go r t1 || go Nominal t2
go r (TyConApp tc args) = or $ zipWith go (tyConRolesX r tc) args
go r (FunTy t1 t2) = go r t1 || go r t2
go r (ForAllTy qtv ty)
| tv == qtv = False -- shadowed
| otherwise = go r ty
go _ (LitTy _) = False
-- if we wish to apply `co` to some other coercion, what would be its best
-- role?
nextRole :: Coercion -> Role
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