diff options
Diffstat (limited to 'compiler')
| -rw-r--r-- | compiler/deSugar/DsBinds.lhs | 3 | ||||
| -rw-r--r-- | compiler/typecheck/TcDeriv.lhs | 29 | ||||
| -rw-r--r-- | compiler/typecheck/TcEvidence.lhs | 16 | ||||
| -rw-r--r-- | compiler/typecheck/TcHsSyn.lhs | 1 | ||||
| -rw-r--r-- | compiler/types/Coercion.lhs | 17 |
5 files changed, 2 insertions, 64 deletions
diff --git a/compiler/deSugar/DsBinds.lhs b/compiler/deSugar/DsBinds.lhs index 5764d1101d..f507f19fc9 100644 --- a/compiler/deSugar/DsBinds.lhs +++ b/compiler/deSugar/DsBinds.lhs @@ -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) diff --git a/compiler/typecheck/TcDeriv.lhs b/compiler/typecheck/TcDeriv.lhs index 9ce4f92ce0..6789f44958 100644 --- a/compiler/typecheck/TcDeriv.lhs +++ b/compiler/typecheck/TcDeriv.lhs @@ -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 diff --git a/compiler/typecheck/TcEvidence.lhs b/compiler/typecheck/TcEvidence.lhs index c233d71459..9b8e767145 100644 --- a/compiler/typecheck/TcEvidence.lhs +++ b/compiler/typecheck/TcEvidence.lhs @@ -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, mkTcAxiomRuleCo, tcCoercionKind, coVarsOfTcCo, isEqVar, mkTcCoVarCo, isTcReflCo, isTcReflCo_maybe, getTcCoVar_maybe, tcCoercionRole, eqVarRole, coercionToTcCoercion - ) 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) diff --git a/compiler/typecheck/TcHsSyn.lhs b/compiler/typecheck/TcHsSyn.lhs index 7d973a44bb..2af4d8efce 100644 --- a/compiler/typecheck/TcHsSyn.lhs +++ b/compiler/typecheck/TcHsSyn.lhs @@ -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 diff --git a/compiler/types/Coercion.lhs b/compiler/types/Coercion.lhs index 27bad5c7d4..9dc0313b2e 100644 --- a/compiler/types/Coercion.lhs +++ b/compiler/types/Coercion.lhs @@ -38,7 +38,7 @@ module Coercion ( splitAppCo_maybe, splitForAllCo_maybe, nthRole, tyConRolesX, - tvUsedAtNominalRole, nextRole, + 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 |