diff options
Diffstat (limited to 'compiler/types/OptCoercion.hs')
| -rw-r--r-- | compiler/types/OptCoercion.hs | 21 |
1 files changed, 12 insertions, 9 deletions
diff --git a/compiler/types/OptCoercion.hs b/compiler/types/OptCoercion.hs index 936663a3d0..55771f6dd0 100644 --- a/compiler/types/OptCoercion.hs +++ b/compiler/types/OptCoercion.hs @@ -795,8 +795,9 @@ opt_trans_rule is co1 co2 role = coercionRole co1 -- should be the same as coercionRole co2! opt_trans_rule _ co1 co2 -- Identity rule - | (Pair ty1 _, r) <- coercionKindRole co1 - , Pair _ ty2 <- coercionKind co2 + | let ty1 = coercionLKind co1 + r = coercionRole co1 + ty2 = coercionRKind co2 , ty1 `eqType` ty2 = fireTransRule "RedTypeDirRefl" co1 co2 $ mkReflCo r ty2 @@ -824,11 +825,13 @@ opt_trans_rule_app is orig_co1 orig_co2 co1a co1bs co2a co2bs | otherwise = ASSERT( co1bs `equalLength` co2bs ) fireTransRule ("EtaApps:" ++ show (length co1bs)) orig_co1 orig_co2 $ - let Pair _ rt1a = coercionKind co1a - (Pair lt2a _, rt2a) = coercionKindRole co2a + let rt1a = coercionRKind co1a - Pair _ rt1bs = traverse coercionKind co1bs - Pair lt2bs _ = traverse coercionKind co2bs + lt2a = coercionLKind co2a + rt2a = coercionRole co2a + + rt1bs = map coercionRKind co1bs + lt2bs = map coercionLKind co2bs rt2bs = map coercionRole co2bs kcoa = mkKindCo $ buildCoercion lt2a rt1a @@ -972,7 +975,7 @@ checkAxInstCo (AxiomInstCo ax ind cos) tvs = coAxBranchTyVars branch cvs = coAxBranchCoVars branch incomps = coAxBranchIncomps branch - (tys, cotys) = splitAtList tvs (map (pFst . coercionKind) cos) + (tys, cotys) = splitAtList tvs (map coercionLKind cos) co_args = map stripCoercionTy cotys subst = zipTvSubst tvs tys `composeTCvSubst` zipCvSubst cvs co_args @@ -1045,8 +1048,8 @@ compatible_co :: Coercion -> Coercion -> Bool compatible_co co1 co2 = x1 `eqType` x2 where - Pair _ x1 = coercionKind co1 - Pair x2 _ = coercionKind co2 + x1 = coercionRKind co1 + x2 = coercionLKind co2 ------------- {- |