summaryrefslogtreecommitdiff
path: root/compiler/GHC/Tc/Types/Evidence.hs
diff options
context:
space:
mode:
Diffstat (limited to 'compiler/GHC/Tc/Types/Evidence.hs')
-rw-r--r--compiler/GHC/Tc/Types/Evidence.hs28
1 files changed, 21 insertions, 7 deletions
diff --git a/compiler/GHC/Tc/Types/Evidence.hs b/compiler/GHC/Tc/Types/Evidence.hs
index 127723d4f7..602d06608c 100644
--- a/compiler/GHC/Tc/Types/Evidence.hs
+++ b/compiler/GHC/Tc/Types/Evidence.hs
@@ -35,14 +35,15 @@ module GHC.Tc.Types.Evidence (
-- * TcCoercion
TcCoercion, TcCoercionR, TcCoercionN, TcCoercionP, CoercionHole,
- TcMCoercion,
+ TcMCoercion, TcMCoercionN, TcMCoercionR,
Role(..), LeftOrRight(..), pickLR,
mkTcReflCo, mkTcNomReflCo, mkTcRepReflCo,
mkTcTyConAppCo, mkTcAppCo, mkTcFunCo,
mkTcAxInstCo, mkTcUnbranchedAxInstCo, mkTcForAllCo, mkTcForAllCos,
- mkTcSymCo, mkTcTransCo, mkTcNthCo, mkTcLRCo, mkTcSubCo, maybeTcSubCo,
- tcDowngradeRole,
- mkTcAxiomRuleCo, mkTcGReflRightCo, mkTcGReflLeftCo, mkTcPhantomCo,
+ mkTcSymCo, mkTcSymMCo, mkTcTransCo, mkTcNthCo, mkTcLRCo, mkTcSubCo, maybeTcSymCo,
+ maybeTcSubCo, tcDowngradeRole,
+ mkTcAxiomRuleCo, mkTcGReflRightCo, mkTcGReflRightMCo, mkTcGReflLeftCo, mkTcGReflLeftMCo,
+ mkTcPhantomCo,
mkTcCoherenceLeftCo,
mkTcCoherenceRightCo,
mkTcKindCo,
@@ -76,6 +77,7 @@ import GHC.Types.Var.Set
import GHC.Core.Predicate
import GHC.Types.Name
import GHC.Data.Pair
+import GHC.Types.Basic
import GHC.Core
import GHC.Core.Class (Class, classSCSelId )
@@ -111,10 +113,13 @@ type TcCoercion = Coercion
type TcCoercionN = CoercionN -- A Nominal coercion ~N
type TcCoercionR = CoercionR -- A Representational coercion ~R
type TcCoercionP = CoercionP -- a phantom coercion
-type TcMCoercion = MCoercion
+type TcMCoercion = MCoercion
+type TcMCoercionN = MCoercionN -- nominal
+type TcMCoercionR = MCoercionR -- representational
mkTcReflCo :: Role -> TcType -> TcCoercion
mkTcSymCo :: TcCoercion -> TcCoercion
+mkTcSymMCo :: TcMCoercion -> TcMCoercion
mkTcTransCo :: TcCoercion -> TcCoercion -> TcCoercion
mkTcNomReflCo :: TcType -> TcCoercionN
mkTcRepReflCo :: TcType -> TcCoercionR
@@ -129,11 +134,13 @@ mkTcForAllCo :: TyVar -> TcCoercionN -> TcCoercion -> TcCoercion
mkTcForAllCos :: [(TyVar, TcCoercionN)] -> TcCoercion -> TcCoercion
mkTcNthCo :: Role -> Int -> TcCoercion -> TcCoercion
mkTcLRCo :: LeftOrRight -> TcCoercion -> TcCoercion
-mkTcSubCo :: TcCoercionN -> TcCoercionR
+mkTcSubCo :: HasDebugCallStack => TcCoercionN -> TcCoercionR
tcDowngradeRole :: Role -> Role -> TcCoercion -> TcCoercion
mkTcAxiomRuleCo :: CoAxiomRule -> [TcCoercion] -> TcCoercionR
mkTcGReflRightCo :: Role -> TcType -> TcCoercionN -> TcCoercion
+mkTcGReflRightMCo :: Role -> TcType -> TcMCoercionN -> TcCoercion
mkTcGReflLeftCo :: Role -> TcType -> TcCoercionN -> TcCoercion
+mkTcGReflLeftMCo :: Role -> TcType -> TcMCoercionN -> TcCoercion
mkTcCoherenceLeftCo :: Role -> TcType -> TcCoercionN
-> TcCoercion -> TcCoercion
mkTcCoherenceRightCo :: Role -> TcType -> TcCoercionN
@@ -153,6 +160,7 @@ isTcReflexiveCo :: TcCoercion -> Bool
mkTcReflCo = mkReflCo
mkTcSymCo = mkSymCo
+mkTcSymMCo = mkSymMCo
mkTcTransCo = mkTransCo
mkTcNomReflCo = mkNomReflCo
mkTcRepReflCo = mkRepReflCo
@@ -169,7 +177,9 @@ mkTcSubCo = mkSubCo
tcDowngradeRole = downgradeRole
mkTcAxiomRuleCo = mkAxiomRuleCo
mkTcGReflRightCo = mkGReflRightCo
+mkTcGReflRightMCo = mkGReflRightMCo
mkTcGReflLeftCo = mkGReflLeftCo
+mkTcGReflLeftMCo = mkGReflLeftMCo
mkTcCoherenceLeftCo = mkCoherenceLeftCo
mkTcCoherenceRightCo = mkCoherenceRightCo
mkTcPhantomCo = mkPhantomCo
@@ -184,10 +194,14 @@ isTcReflexiveCo = isReflexiveCo
-- | If the EqRel is ReprEq, makes a SubCo; otherwise, does nothing.
-- Note that the input coercion should always be nominal.
-maybeTcSubCo :: EqRel -> TcCoercion -> TcCoercion
+maybeTcSubCo :: HasDebugCallStack => EqRel -> TcCoercionN -> TcCoercion
maybeTcSubCo NomEq = id
maybeTcSubCo ReprEq = mkTcSubCo
+-- | If a 'SwapFlag' is 'IsSwapped', flip the orientation of a coercion
+maybeTcSymCo :: SwapFlag -> TcCoercion -> TcCoercion
+maybeTcSymCo IsSwapped co = mkTcSymCo co
+maybeTcSymCo NotSwapped co = co
{-
%************************************************************************