diff options
| author | Simon Peyton Jones <simonpj@microsoft.com> | 2020-10-06 23:39:29 +0100 |
|---|---|---|
| committer | Simon Peyton Jones <simonpj@microsoft.com> | 2020-10-08 09:08:36 +0100 |
| commit | f5d0422027d59eb3ae490ff89ff3456c456038c2 (patch) | |
| tree | aab2d0162171f85e2d40bd3ff9ab5bb021a8beea /compiler/GHC/Core/Coercion.hs | |
| parent | 18a3ddf75d25094096a7fe44fd250de973041187 (diff) | |
| download | haskell-wip/T18809.tar.gz | |
Fix desugaring of record updates on data familieswip/T18809
This fixes a long-standing bug in the desugaring of record
updates for data families, when the latter involves a GADT. It's
all explained in Note [Update for GADTs] in GHC.HsToCore.Expr.
Building the correct cast is surprisingly tricky, as that Note
explains.
Fixes #18809. The test case (in indexed-types/should_compile/T18809)
contains several examples that exercise the dark corners.
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 |