diff options
| -rw-r--r-- | compiler/GHC/Core/Coercion.hs-boot | 2 | ||||
| -rw-r--r-- | compiler/GHC/Core/TyCo/Rep.hs-boot | 1 | ||||
| -rw-r--r-- | compiler/GHC/Core/Type.hs | 11 |
3 files changed, 10 insertions, 4 deletions
diff --git a/compiler/GHC/Core/Coercion.hs-boot b/compiler/GHC/Core/Coercion.hs-boot index 3143414feb..276a48cf81 100644 --- a/compiler/GHC/Core/Coercion.hs-boot +++ b/compiler/GHC/Core/Coercion.hs-boot @@ -36,6 +36,8 @@ mkSubCo :: HasDebugCallStack => Coercion -> Coercion mkProofIrrelCo :: Role -> Coercion -> Coercion -> Coercion -> Coercion mkAxiomRuleCo :: CoAxiomRule -> [Coercion] -> Coercion +funRole :: Role -> FunSel -> Role + isGReflCo :: Coercion -> Bool isReflCo :: Coercion -> Bool isReflexiveCo :: Coercion -> Bool diff --git a/compiler/GHC/Core/TyCo/Rep.hs-boot b/compiler/GHC/Core/TyCo/Rep.hs-boot index a560e0d608..9b82d3cfa5 100644 --- a/compiler/GHC/Core/TyCo/Rep.hs-boot +++ b/compiler/GHC/Core/TyCo/Rep.hs-boot @@ -8,6 +8,7 @@ import {-# SOURCE #-} GHC.Core.TyCon ( TyCon ) data Type data Coercion +data FunSel data CoSel data UnivCoProvenance data TyLit diff --git a/compiler/GHC/Core/Type.hs b/compiler/GHC/Core/Type.hs index 5e4be72a34..a5dc5a6865 100644 --- a/compiler/GHC/Core/Type.hs +++ b/compiler/GHC/Core/Type.hs @@ -274,7 +274,7 @@ import {-# SOURCE #-} GHC.Core.Coercion , mkTyConAppCo, mkAppCo , mkForAllCo, mkFunCo2, mkAxiomInstCo, mkUnivCo , mkSymCo, mkTransCo, mkSelCo, mkLRCo, mkInstCo - , mkKindCo, mkSubCo, mkFunCo + , mkKindCo, mkSubCo, mkFunCo, funRole , decomposePiCos, coercionKind , coercionRKind, coercionType , isReflexiveCo, seqCo @@ -1331,9 +1331,12 @@ tyConAppFunCo_maybe :: HasDebugCallStack => Role -> TyCon -> [Coercion] -> Maybe Coercion -- ^ Return Just if this TyConAppCo should be represented as a FunCo tyConAppFunCo_maybe r tc cos - | Just (af, mult, arg, res) <- ty_con_app_fun_maybe (mkReflCo r manyDataConTy) tc cos - = Just (mkFunCo r af mult arg res) - | otherwise = Nothing + | Just (af, mult, arg, res) <- ty_con_app_fun_maybe mult_refl tc cos + = Just (mkFunCo r af mult arg res) + | otherwise + = Nothing + where + mult_refl = mkReflCo (funRole r SelMult) manyDataConTy ty_con_app_fun_maybe :: (HasDebugCallStack, Outputable a) => a -> TyCon -> [a] -> Maybe (FunTyFlag, a, a, a) |