Split up coercionKindwip/T17515

This patch implements the idea in #17515, splitting `coercionKind` into:

 * `coercion{Left,Right}Kind`, which computes the left/right side of the
    pair
 * `coercionKind`, which computes the pair of coercible types

This is reduces allocation since we frequently only need only one side
of the pair. Specifically, we see the following improvements on x86-64
Debian 9:

| test     | new        | old           | relative chg. |
| :------- | ---------: | ------------: | ------------: |
| T5030	   | 695537752  | 747641152.0   | -6.97%        |
| T5321Fun | 449315744  | 474009040.0   | -5.21%        |
| T9872a   | 2611071400 | 2645040952.0  | -1.28%        |
| T9872c   | 2957097904 | 2994260264.0  | -1.24%        |
| T12227   | 773435072  | 812367768.0   | -4.79%        |
| T12545   | 3142687224 | 3215714752.0  | -2.27%        |
| T14683   | 9392407664 | 9824775000.0  | -4.40%        |

Metric Decrease:
    T12545
    T9872a
    T14683
    T5030
    T12227
    T9872c
    T5321Fun
    T9872b

14 files changed, 54 insertions, 53 deletions

diff --git a/compiler/basicTypes/MkId.hs b/compiler/basicTypes/MkId.hs
index 593f9ac3a9..63a6dc1030 100644
--- a/compiler/basicTypes/MkId.hs
+++ b/compiler/basicTypes/MkId.hs
@@ -67,7 +67,6 @@ import UniqSupply
 import PrelNames
 import BasicTypes       hiding ( SuccessFlag(..) )
 import Util
-import Pair
 import DynFlags
 import Outputable
 import FastString
@@ -962,7 +961,7 @@ dataConArgRep arg_ty (HsUnpack Nothing)
   = (rep_tys, wrappers)
 
 dataConArgRep _ (HsUnpack (Just co))
-  | let co_rep_ty = pSnd (coercionKind co)
+  | let co_rep_ty = coercionRKind co
   , (rep_tys, wrappers) <- dataConArgUnpack co_rep_ty
   = (rep_tys, wrapCo co co_rep_ty wrappers)
 
diff --git a/compiler/coreSyn/CoreArity.hs b/compiler/coreSyn/CoreArity.hs
index 04c8557882..2e33724a11 100644
--- a/compiler/coreSyn/CoreArity.hs
+++ b/compiler/coreSyn/CoreArity.hs
@@ -37,7 +37,6 @@ import Unique
 import DynFlags ( DynFlags, GeneralFlag(..), gopt )
 import Outputable
 import FastString
-import Pair
 import Util     ( debugIsOn )
 
 {-
@@ -98,7 +97,7 @@ exprArity e = go e
     go (Lam x e) | isId x          = go e + 1
                  | otherwise       = go e
     go (Tick t e) | not (tickishIsCode t) = go e
-    go (Cast e co)                 = trim_arity (go e) (pSnd (coercionKind co))
+    go (Cast e co)                 = trim_arity (go e) (coercionRKind co)
                                         -- Note [exprArity invariant]
     go (App e (Type _))            = go e
     go (App f a) | exprIsTrivial a = (go f - 1) `max` 0
@@ -744,7 +743,7 @@ arityType env (Cast e co)
       ABot n | co_arity < n -> ATop (replicate co_arity noOneShotInfo)
              | otherwise    -> ABot n
   where
-    co_arity = length (typeArity (pSnd (coercionKind co)))
+    co_arity = length (typeArity (coercionRKind co))
     -- See Note [exprArity invariant] (2); must be true of
     -- arityType too, since that is how we compute the arity
     -- of variables, and they in turn affect result of exprArity
@@ -1038,7 +1037,7 @@ etaInfoAppTy :: Type -> [EtaInfo] -> Type
 -- then   etaInfoApp e eis :: etaInfoApp ty eis
 etaInfoAppTy ty []               = ty
 etaInfoAppTy ty (EtaVar v : eis) = etaInfoAppTy (applyTypeToArg ty (varToCoreExpr v)) eis
-etaInfoAppTy _  (EtaCo co : eis) = etaInfoAppTy (pSnd (coercionKind co)) eis
+etaInfoAppTy _  (EtaCo co : eis) = etaInfoAppTy (coercionRKind co) eis
 
 --------------
 mkEtaWW :: Arity -> CoreExpr -> InScopeSet -> Type
diff --git a/compiler/coreSyn/CoreOpt.hs b/compiler/coreSyn/CoreOpt.hs
index 41a017e8ea..de3c96ba45 100644
--- a/compiler/coreSyn/CoreOpt.hs
+++ b/compiler/coreSyn/CoreOpt.hs
@@ -1278,7 +1278,8 @@ pushCoTyArg co ty
   | otherwise
   = Nothing
   where
-    Pair tyL tyR = coercionKind co
+    tyL = coercionLKind co
+    tyR = coercionRKind co
        -- co :: tyL ~ tyR
        -- tyL = forall (a1 :: k1). ty1
        -- tyR = forall (a2 :: k2). ty2
diff --git a/compiler/coreSyn/CorePrep.hs b/compiler/coreSyn/CorePrep.hs
index 4a5891a013..3ce2afc6b8 100644
--- a/compiler/coreSyn/CorePrep.hs
+++ b/compiler/coreSyn/CorePrep.hs
@@ -51,7 +51,6 @@ import OrdList
 import ErrUtils
 import DynFlags
 import Util
-import Pair
 import Outputable
 import GHC.Platform
 import FastString
@@ -932,7 +931,7 @@ cpeApp top_env expr
         (fs, arg') <- cpeArg top_env ss1 arg arg_ty
         rebuild_app as (App fun' arg') res_ty (fs `appendFloats` floats) ss_rest
       CpeCast co ->
-        let Pair _ty1 ty2 = coercionKind co
+        let ty2 = coercionRKind co
         in rebuild_app as (Cast fun' co) ty2 floats ss
       CpeTick tickish ->
         -- See [Floating Ticks in CorePrep]
diff --git a/compiler/coreSyn/CoreUtils.hs b/compiler/coreSyn/CoreUtils.hs
index 16f4a00341..50fdcd9c7b 100644
--- a/compiler/coreSyn/CoreUtils.hs
+++ b/compiler/coreSyn/CoreUtils.hs
@@ -177,7 +177,7 @@ isExprLevPoly = go
    go_app (Lam _ e)       = go_app e
    go_app (Let _ e)       = go_app e
    go_app (Case _ _ ty _) = resultIsLevPoly ty
-   go_app (Cast _ co)     = resultIsLevPoly (pSnd $ coercionKind co)
+   go_app (Cast _ co)     = resultIsLevPoly (coercionRKind co)
    go_app (Tick _ e)      = go_app e
    go_app e@(Type {})     = pprPanic "isExprLevPoly app ty" (ppr e)
    go_app e@(Coercion {}) = pprPanic "isExprLevPoly app co" (ppr e)
@@ -267,15 +267,15 @@ mkCast e co
   = e
 
 mkCast (Coercion e_co) co
-  | isCoVarType (pSnd (coercionKind co))
+  | isCoVarType (coercionRKind co)
        -- The guard here checks that g has a (~#) on both sides,
        -- otherwise decomposeCo fails.  Can in principle happen
        -- with unsafeCoerce
   = Coercion (mkCoCast e_co co)
 
 mkCast (Cast expr co2) co
-  = WARN(let { Pair  from_ty  _to_ty  = coercionKind co;
-               Pair _from_ty2  to_ty2 = coercionKind co2} in
+  = WARN(let { from_ty = coercionLKind co;
+               to_ty2  = coercionRKind co2 } in
             not (from_ty `eqType` to_ty2),
              vcat ([ text "expr:" <+> ppr expr
                    , text "co2:" <+> ppr co2
@@ -286,7 +286,7 @@ mkCast (Tick t expr) co
    = Tick t (mkCast expr co)
 
 mkCast expr co
-  = let Pair from_ty _to_ty = coercionKind co in
+  = let from_ty = coercionLKind co in
     WARN( not (from_ty `eqType` exprType expr),
           text "Trying to coerce" <+> text "(" <> ppr expr
           $$ text "::" <+> ppr (exprType expr) <> text ")"
diff --git a/compiler/deSugar/DsForeign.hs b/compiler/deSugar/DsForeign.hs
index 43ef2327c5..fcf3936e5a 100644
--- a/compiler/deSugar/DsForeign.hs
+++ b/compiler/deSugar/DsForeign.hs
@@ -51,7 +51,6 @@ import FastString
 import DynFlags
 import GHC.Platform
 import OrdList
-import Pair
 import Util
 import Hooks
 import Encoding
@@ -156,7 +155,7 @@ dsCImport :: Id
           -> DsM ([Binding], SDoc, SDoc)
 dsCImport id co (CLabel cid) cconv _ _ = do
    dflags <- getDynFlags
-   let ty  = pFst $ coercionKind co
+   let ty  = coercionLKind co
        fod = case tyConAppTyCon_maybe (dropForAlls ty) of
              Just tycon
               | tyConUnique tycon == funPtrTyConKey ->
@@ -204,7 +203,7 @@ dsFCall :: Id -> Coercion -> ForeignCall -> Maybe Header
         -> DsM ([(Id, Expr TyVar)], SDoc, SDoc)
 dsFCall fn_id co fcall mDeclHeader = do
     let
-        ty                   = pFst $ coercionKind co
+        ty                   = coercionLKind co
         (tv_bndrs, rho)      = tcSplitForAllVarBndrs ty
         (arg_tys, io_res_ty) = tcSplitFunTys rho
 
@@ -305,7 +304,7 @@ dsPrimCall :: Id -> Coercion -> ForeignCall
            -> DsM ([(Id, Expr TyVar)], SDoc, SDoc)
 dsPrimCall fn_id co fcall = do
     let
-        ty                   = pFst $ coercionKind co
+        ty                   = coercionLKind co
         (tvs, fun_ty)        = tcSplitForAllTys ty
         (arg_tys, io_res_ty) = tcSplitFunTys fun_ty
 
@@ -355,7 +354,7 @@ dsFExport :: Id                 -- Either the exported Id,
 
 dsFExport fn_id co ext_name cconv isDyn = do
     let
-       ty                     = pSnd $ coercionKind co
+       ty                     = coercionRKind co
        (bndrs, orig_res_ty)   = tcSplitPiTys ty
        fe_arg_tys'            = mapMaybe binderRelevantType_maybe bndrs
        -- We must use tcSplits here, because we want to see
@@ -477,7 +476,7 @@ dsFExportDynamic id co0 cconv = do
     return ([fed], h_code, c_code)
 
  where
-  ty                       = pFst (coercionKind co0)
+  ty                       = coercionLKind co0
   (tvs,sans_foralls)       = tcSplitForAllTys ty
   ([arg_ty], fn_res_ty)    = tcSplitFunTys sans_foralls
   Just (io_tc, res_ty)     = tcSplitIOType_maybe fn_res_ty
diff --git a/compiler/simplCore/SimplUtils.hs b/compiler/simplCore/SimplUtils.hs
index 6074d00aa9..5a6a9afa40 100644
--- a/compiler/simplCore/SimplUtils.hs
+++ b/compiler/simplCore/SimplUtils.hs
@@ -66,7 +66,6 @@ import Util
 import OrdList          ( isNilOL )
 import MonadUtils
 import Outputable
-import Pair
 import PrelRules
 import FastString       ( fsLit )
 
@@ -297,7 +296,7 @@ addTyArgTo ai arg_ty = ai { ai_args = arg_spec : ai_args ai
 
 addCastTo :: ArgInfo -> OutCoercion -> ArgInfo
 addCastTo ai co = ai { ai_args = CastBy co : ai_args ai
-                     , ai_type = pSnd (coercionKind co) }
+                     , ai_type = coercionRKind co }
 
 argInfoAppArgs :: [ArgSpec] -> [OutExpr]
 argInfoAppArgs []                              = []
@@ -407,7 +406,7 @@ contResultType (TickIt _ k)                 = contResultType k
 contHoleType :: SimplCont -> OutType
 contHoleType (Stop ty _)                      = ty
 contHoleType (TickIt _ k)                     = contHoleType k
-contHoleType (CastIt co _)                    = pFst (coercionKind co)
+contHoleType (CastIt co _)                    = coercionLKind co
 contHoleType (StrictBind { sc_bndr = b, sc_dup = dup, sc_env = se })
   = perhapsSubstTy dup se (idType b)
 contHoleType (StrictArg { sc_fun = ai })      = funArgTy (ai_type ai)
diff --git a/compiler/simplCore/Simplify.hs b/compiler/simplCore/Simplify.hs
index c4f179ba55..0e4a3d3393 100644
--- a/compiler/simplCore/Simplify.hs
+++ b/compiler/simplCore/Simplify.hs
@@ -50,7 +50,6 @@ import Maybes           (  orElse )
 import Control.Monad
 import Outputable
 import FastString
-import Pair
 import Util
 import ErrUtils
 import Module          ( moduleName, pprModuleName )
@@ -440,7 +439,7 @@ prepareRhs :: SimplMode -> TopLevelFlag
 --            x = Just a
 -- See Note [prepareRhs]
 prepareRhs mode top_lvl occ info (Cast rhs co)  -- Note [Float coercions]
-  | Pair ty1 _ty2 <- coercionKind co         -- Do *not* do this if rhs has an unlifted type
+  | let ty1 = coercionLKind co         -- Do *not* do this if rhs has an unlifted type
   , not (isUnliftedType ty1)                 -- see Note [Float coercions (unlifted)]
   = do  { (floats, rhs') <- makeTrivialWithInfo mode top_lvl occ sanitised_info rhs
         ; return (floats, Cast rhs' co) }
@@ -1308,7 +1307,7 @@ simplCast env body co0 cont0
             -- only needed by `sc_hole_ty` which is often not forced.
             -- Consequently it is worthwhile using a lazy pattern match here to
             -- avoid unnecessary coercionKind evaluations.
-          , ~(Pair hole_ty _) <- coercionKind co
+          , let hole_ty = coercionLKind co
           = {-#SCC "addCoerce-pushCoTyArg" #-}
             do { tail' <- addCoerceM m_co' tail
                ; return (cont { sc_arg_ty  = arg_ty'
@@ -1319,7 +1318,7 @@ simplCast env body co0 cont0
         addCoerce co cont@(ApplyToVal { sc_arg = arg, sc_env = arg_se
                                       , sc_dup = dup, sc_cont = tail })
           | Just (co1, m_co2) <- pushCoValArg co
-          , Pair _ new_ty <- coercionKind co1
+          , let new_ty = coercionRKind co1
           , not (isTypeLevPoly new_ty)  -- Without this check, we get a lev-poly arg
                                         -- See Note [Levity polymorphism invariants] in CoreSyn
                                         -- test: typecheck/should_run/EtaExpandLevPoly
diff --git a/compiler/types/Coercion.hs b/compiler/types/Coercion.hs
index ff17f1c33f..b338bfbf9e 100644
--- a/compiler/types/Coercion.hs
+++ b/compiler/types/Coercion.hs
@@ -19,8 +19,8 @@ module Coercion (
 
         -- ** Functions over coercions
         coVarTypes, coVarKind, coVarKindsTypesRole, coVarRole,
-        coercionType, coercionKind, coercionKinds,
-        mkCoercionType,
+        coercionType, mkCoercionType,
+        coercionKind, coercionLKind, coercionRKind,coercionKinds,
         coercionRole, coercionKindRole,
 
         -- ** Constructing coercions
@@ -1109,7 +1109,8 @@ nthCoRole n co
   = pprPanic "nthCoRole" (ppr co)
 
   where
-    (Pair lty _, r) = coercionKindRole co
+    lty = coercionLKind co
+    r   = coercionRole co
 
 mkLRCo :: LeftOrRight -> Coercion -> Coercion
 mkLRCo lr co
@@ -1532,7 +1533,7 @@ mkCoCast c g
     -- g  :: (s1 ~# t1) ~# (s2 ~# t2)
     -- g1 :: s1 ~# s2
     -- g2 :: t1 ~# t2
-    (tc, _) = splitTyConApp (pFst $ coercionKind g)
+    (tc, _) = splitTyConApp (coercionLKind g)
     co_list = decomposeCo (tyConArity tc) g (tyConRolesRepresentational tc)
 
 {-
@@ -2005,7 +2006,7 @@ liftCoSubstTyVarBndrUsing fun lc@(LC subst cenv) old_var
   where
     old_kind     = tyVarKind old_var
     (eta, stuff) = fun lc old_kind
-    Pair k1 _    = coercionKind eta
+    k1           = coercionLKind eta
     new_var      = uniqAway (getTCvInScope subst) (setVarType old_var k1)
 
     lifted   = mkGReflRightCo Nominal (TyVarTy new_var) eta
@@ -2023,7 +2024,7 @@ liftCoSubstCoVarBndrUsing fun lc@(LC subst cenv) old_var
   where
     old_kind     = coVarKind old_var
     (eta, stuff) = fun lc old_kind
-    Pair k1 _    = coercionKind eta
+    k1           = coercionLKind eta
     new_var      = uniqAway (getTCvInScope subst) (setVarType old_var k1)
 
     -- old_var :: s1  ~r s2
@@ -2876,7 +2877,7 @@ simplifyArgsWorker orig_ki_binders orig_inner_ki orig_fvs
     go acc_xis acc_cos lc [] inner_ki roles args
       = let co1 = liftCoSubst Nominal lc inner_ki
             co1_kind              = coercionKind co1
-            unflattened_tys       = map (pSnd . coercionKind . snd) args
+            unflattened_tys       = map (coercionRKind . snd) args
             (arg_cos, res_co)     = decomposePiCos co1 co1_kind unflattened_tys
             casted_args           = ASSERT2( equalLength args arg_cos
                                            , ppr args $$ ppr arg_cos )
diff --git a/compiler/types/Coercion.hs-boot b/compiler/types/Coercion.hs-boot
index 322b127568..eb5e81b819 100644
--- a/compiler/types/Coercion.hs-boot
+++ b/compiler/types/Coercion.hs-boot
@@ -49,4 +49,6 @@ liftCoSubst :: HasDebugCallStack => Role -> LiftingContext -> Type -> Coercion
 seqCo :: Coercion -> ()
 
 coercionKind :: Coercion -> Pair Type
+coercionLKind :: Coercion -> Type
+coercionRKind :: Coercion -> Type
 coercionType :: Coercion -> Type
diff --git a/compiler/types/FamInstEnv.hs b/compiler/types/FamInstEnv.hs
index b491948cd9..be63e3cfd2 100644
--- a/compiler/types/FamInstEnv.hs
+++ b/compiler/types/FamInstEnv.hs
@@ -58,7 +58,6 @@ import CoreMap
 import Unique
 import Util
 import Var
-import Pair
 import SrcLoc
 import FastString
 import Control.Monad
@@ -1119,13 +1118,13 @@ reduceTyFamApp_maybe envs role tc tys
       -- NB: Allow multiple matches because of compatible overlap
 
   = let co = mkUnbranchedAxInstCo role ax inst_tys inst_cos
-        ty = pSnd (coercionKind co)
+        ty = coercionRKind co
     in Just (co, ty)
 
   | Just ax <- isClosedSynFamilyTyConWithAxiom_maybe tc
   , Just (ind, inst_tys, inst_cos) <- chooseBranch ax tys
   = let co = mkAxInstCo role ax ind inst_tys inst_cos
-        ty = pSnd (coercionKind co)
+        ty = coercionRKind co
     in Just (co, ty)
 
   | Just ax           <- isBuiltInSynFamTyCon_maybe tc
@@ -1494,7 +1493,7 @@ normalise_tyvar tv
     do { lc <- getLC
        ; r  <- getRole
        ; return $ case liftCoSubstTyVar lc r tv of
-           Just co -> (co, pSnd $ coercionKind co)
+           Just co -> (co, coercionRKind co)
            Nothing -> (mkReflCo r ty, ty) }
   where ty = mkTyVarTy tv
 
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
 
 -------------
 {-
diff --git a/compiler/types/TyCoSubst.hs b/compiler/types/TyCoSubst.hs
index 5c557f595d..db7563914f 100644
--- a/compiler/types/TyCoSubst.hs
+++ b/compiler/types/TyCoSubst.hs
@@ -61,7 +61,7 @@ import {-# SOURCE #-} Coercion ( mkCoVarCo, mkKindCo, mkNthCo, mkTransCo
                                , mkAxiomInstCo, mkAppCo, mkGReflCo
                                , mkInstCo, mkLRCo, mkTyConAppCo
                                , mkCoercionType
-                               , coercionKind, coVarKindsTypesRole )
+                               , coercionKind, coercionLKind, coVarKindsTypesRole )
 
 import TyCoRep
 import TyCoFVs
@@ -869,7 +869,7 @@ substForAllCoTyVarBndrUsing sym sco (TCvSubst in_scope tenv cenv) old_var old_ki
     new_kind_co | no_kind_change = old_kind_co
                 | otherwise      = sco old_kind_co
 
-    Pair new_ki1 _ = coercionKind new_kind_co
+    new_ki1 = coercionLKind new_kind_co
     -- We could do substitution to (tyVarKind old_var). We don't do so because
     -- we already substituted new_kind_co, which contains the kind information
     -- we want. We don't want to do substitution once more. Also, in most cases,
diff --git a/compiler/types/Type.hs b/compiler/types/Type.hs
index f91b7caf88..749578d78f 100644
--- a/compiler/types/Type.hs
+++ b/compiler/types/Type.hs
@@ -246,7 +246,8 @@ import {-# SOURCE #-} Coercion( mkNomReflCo, mkGReflCo, mkReflCo
                               , mkForAllCo, mkFunCo, mkAxiomInstCo, mkUnivCo
                               , mkSymCo, mkTransCo, mkNthCo, mkLRCo, mkInstCo
                               , mkKindCo, mkSubCo, mkFunCo, mkAxiomInstCo
-                              , decomposePiCos, coercionKind, coercionType
+                              , decomposePiCos, coercionKind, coercionLKind
+                              , coercionRKind, coercionType
                               , isReflexiveCo, seqCo )
 
 -- others
@@ -2433,7 +2434,7 @@ typeKind (TyConApp tc tys) = piResultTys (tyConKind tc) tys
 typeKind (LitTy l)         = typeLiteralKind l
 typeKind (FunTy {})        = liftedTypeKind
 typeKind (TyVarTy tyvar)   = tyVarKind tyvar
-typeKind (CastTy _ty co)   = pSnd $ coercionKind co
+typeKind (CastTy _ty co)   = coercionRKind co
 typeKind (CoercionTy co)   = coercionType co
 
 typeKind (AppTy fun arg)
@@ -2466,7 +2467,7 @@ tcTypeKind :: HasDebugCallStack => Type -> Kind
 tcTypeKind (TyConApp tc tys) = piResultTys (tyConKind tc) tys
 tcTypeKind (LitTy l)         = typeLiteralKind l
 tcTypeKind (TyVarTy tyvar)   = tyVarKind tyvar
-tcTypeKind (CastTy _ty co)   = pSnd $ coercionKind co
+tcTypeKind (CastTy _ty co)   = coercionRKind co
 tcTypeKind (CoercionTy co)   = coercionType co
 
 tcTypeKind (FunTy { ft_af = af, ft_res = res })
@@ -2694,7 +2695,7 @@ occCheckExpand vs_to_avoid ty
     go_co cxt@(as, env) (ForAllCo tv kind_co body_co)
       = do { kind_co' <- go_co cxt kind_co
            ; let tv' = setVarType tv $
-                       pFst (coercionKind kind_co')
+                       coercionLKind kind_co'
                  env' = extendVarEnv env tv tv'
                  as'  = as `delVarSet` tv
            ; body' <- go_co (as', env') body_co