summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--compiler/GHC/Core/Coercion.hs-boot2
-rw-r--r--compiler/GHC/Core/TyCo/Rep.hs-boot1
-rw-r--r--compiler/GHC/Core/Type.hs11
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)