diff options
Diffstat (limited to 'compiler/GHC/Core')
| -rw-r--r-- | compiler/GHC/Core/Coercion.hs | 22 | ||||
| -rw-r--r-- | compiler/GHC/Core/DataCon.hs | 9 | ||||
| -rw-r--r-- | compiler/GHC/Core/TyCo/Subst.hs | 4 |
3 files changed, 29 insertions, 6 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 diff --git a/compiler/GHC/Core/DataCon.hs b/compiler/GHC/Core/DataCon.hs index 1e3969953f..542fea4e1e 100644 --- a/compiler/GHC/Core/DataCon.hs +++ b/compiler/GHC/Core/DataCon.hs @@ -581,6 +581,7 @@ variables: purposes of TypeApplications, and as a consequence, they do not come equipped with visibilities (that is, they are TyVars/TyCoVars instead of TyCoVarBinders). + * dcUserTyVarBinders, for the type variables binders in the order in which they originally arose in the user-written type signature. Their order *does* matter for TypeApplications, so they are full TyVarBinders, complete with @@ -601,10 +602,10 @@ dcExTyCoVars. That is, the tyvars in dcUserTyVarBinders are a permutation of ordering, they in fact share the same type variables (with the same Uniques). We sometimes refer to this as "the dcUserTyVarBinders invariant". -dcUserTyVarBinders, as the name suggests, is the one that users will see most of -the time. It's used when computing the type signature of a data constructor (see -dataConWrapperType), and as a result, it's what matters from a TypeApplications -perspective. +dcUserTyVarBinders, as the name suggests, is the one that users will +see most of the time. It's used when computing the type signature of a +data constructor wrapper (see dataConWrapperType), and as a result, +it's what matters from a TypeApplications perspective. Note [The dcEqSpec domain invariant] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ diff --git a/compiler/GHC/Core/TyCo/Subst.hs b/compiler/GHC/Core/TyCo/Subst.hs index d85052700c..64e0c9ccbb 100644 --- a/compiler/GHC/Core/TyCo/Subst.hs +++ b/compiler/GHC/Core/TyCo/Subst.hs @@ -436,8 +436,8 @@ mkTvSubstPrs prs = zipTyEnv :: HasDebugCallStack => [TyVar] -> [Type] -> TvSubstEnv zipTyEnv tyvars tys | debugIsOn - , not (all isTyVar tyvars) - = pprPanic "zipTyEnv" (ppr tyvars <+> ppr tys) + , not (all isTyVar tyvars && (tyvars `equalLength` tys)) + = pprPanic "zipTyEnv" (ppr tyvars $$ ppr tys) | otherwise = ASSERT( all (not . isCoercionTy) tys ) zipToUFM tyvars tys |