diff options
Diffstat (limited to 'compiler/GHC/Core/Coercion.hs')
| -rw-r--r-- | compiler/GHC/Core/Coercion.hs | 22 |
1 files changed, 22 insertions, 0 deletions
diff --git a/compiler/GHC/Core/Coercion.hs b/compiler/GHC/Core/Coercion.hs index 647084baff..b8737c43a1 100644 --- a/compiler/GHC/Core/Coercion.hs +++ b/compiler/GHC/Core/Coercion.hs @@ -41,6 +41,7 @@ module GHC.Core.Coercion ( downgradeRole, mkAxiomRuleCo, mkGReflRightCo, mkGReflLeftCo, mkCoherenceLeftCo, mkCoherenceRightCo, mkKindCo, castCoercionKind, castCoercionKindI, + mkFamilyTyConAppCo, mkHeteroCoercionType, mkPrimEqPred, mkReprPrimEqPred, mkPrimEqPredRole, @@ -1528,6 +1529,27 @@ castCoercionKindI g h1 h2 = mkCoherenceRightCo r t2 h2 (mkCoherenceLeftCo r t1 h1 g) where (Pair t1 t2, r) = coercionKindRole g +mkFamilyTyConAppCo :: TyCon -> [CoercionN] -> CoercionN +-- ^ Given a family instance 'TyCon' and its arg 'Coercion's, return the +-- corresponding family 'Coercion'. E.g: +-- +-- > data family T a +-- > data instance T (Maybe b) = MkT b +-- +-- Where the instance 'TyCon' is :RTL, so: +-- +-- > mkFamilyTyConAppCo :RTL (co :: a ~# Int) = T (Maybe a) ~# T (Maybe Int) +-- +-- cf. 'mkFamilyTyConApp' +mkFamilyTyConAppCo tc cos + | Just (fam_tc, fam_tys) <- tyConFamInst_maybe tc + , let tvs = tyConTyVars tc + fam_cos = ASSERT2( tvs `equalLength` cos, ppr tc <+> ppr cos ) + map (liftCoSubstWith Nominal tvs cos) fam_tys + = mkTyConAppCo Nominal fam_tc fam_cos + | otherwise + = mkTyConAppCo Nominal tc cos + -- See note [Newtype coercions] in GHC.Core.TyCon mkPiCos :: Role -> [Var] -> Coercion -> Coercion |