    -- (c) The University of Glasgow 2006

    {-# LANGUAGE CPP #-}

    module GHC.Core.Coercion.Opt
       ( optCoercion
       , OptCoercionOpts (..)
       )
    where

    import GHC.Prelude

    import GHC.Tc.Utils.TcType   ( exactTyCoVarsOfType )

    import GHC.Core.TyCo.Rep
    import GHC.Core.TyCo.Subst
    import GHC.Core.TyCo.Compare( eqType, eqForAllVis )
    import GHC.Core.Coercion
    import GHC.Core.Type as Type hiding( substTyVarBndr, substTy )
    import GHC.Core.TyCon
    import GHC.Core.Coercion.Axiom
    import GHC.Core.Unify

    import GHC.Types.Var
    import GHC.Types.Var.Set
    import GHC.Types.Var.Env
    import GHC.Types.Unique.Set

    import GHC.Data.Pair
    import GHC.Data.List.SetOps ( getNth )

    import GHC.Utils.Outputable
    import GHC.Utils.Constants (debugIsOn)
    import GHC.Utils.Misc
    import GHC.Utils.Panic

    import Control.Monad   ( zipWithM )

    {-
    %************************************************************************
    %*                                                                      *
                     Optimising coercions
    %*                                                                      *
    %************************************************************************

    This module does coercion optimisation.  See the paper

       Evidence normalization in Systtem FV (RTA'13)
       https://simon.peytonjones.org/evidence-normalization/

    The paper is also in the GHC repo, in docs/opt-coercion.

    Note [Optimising coercion optimisation]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    Looking up a coercion's role or kind is linear in the size of the
    coercion. Thus, doing this repeatedly during the recursive descent
    of coercion optimisation is disastrous. We must be careful to avoid
    doing this if at all possible.

    Because it is generally easy to know a coercion's components' roles
    from the role of the outer coercion, we pass down the known role of
    the input in the algorithm below. We also keep functions opt_co2
    and opt_co3 separate from opt_co4, so that the former two do Phantom
    checks that opt_co4 can avoid. This is a big win because Phantom coercions
    rarely appear within non-phantom coercions -- only in some TyConAppCos
    and some AxiomInstCos. We handle these cases specially by calling
    opt_co2.

    Note [Optimising InstCo]
    ~~~~~~~~~~~~~~~~~~~~~~~~
    (1) tv is a type variable
    When we have (InstCo (ForAllCo tv h g) g2), we want to optimise.

    Let's look at the typing rules.

    h : k1 ~ k2
    tv:k1 |- g : t1 ~ t2
    -----------------------------
    ForAllCo tv h g : (all tv:k1.t1) ~ (all tv:k2.t2[tv |-> tv |> sym h])

    g1 : (all tv:k1.t1') ~ (all tv:k2.t2')
    g2 : s1 ~ s2
    --------------------
    InstCo g1 g2 : t1'[tv |-> s1] ~ t2'[tv |-> s2]

    We thus want some coercion proving this:

      (t1[tv |-> s1]) ~ (t2[tv |-> s2 |> sym h])

    If we substitute the *type* tv for the *coercion*
    (g2 ; t2 ~ t2 |> sym h) in g, we'll get this result exactly.
    This is bizarre,
    though, because we're substituting a type variable with a coercion. However,
    this operation already exists: it's called *lifting*, and defined in GHC.Core.Coercion.
    We just need to enhance the lifting operation to be able to deal with
    an ambient substitution, which is why a LiftingContext stores a TCvSubst.

    (2) cv is a coercion variable
    Now consider we have (InstCo (ForAllCo cv h g) g2), we want to optimise.

    h : (t1 ~r t2) ~N (t3 ~r t4)
    cv : t1 ~r t2 |- g : t1' ~r2 t2'
    n1 = nth r 2 (downgradeRole r N h) :: t1 ~r t3
    n2 = nth r 3 (downgradeRole r N h) :: t2 ~r t4
    ------------------------------------------------
    ForAllCo cv h g : (all cv:t1 ~r t2. t1') ~r2
                      (all cv:t3 ~r t4. t2'[cv |-> n1 ; cv ; sym n2])

    g1 : (all cv:t1 ~r t2. t1') ~ (all cv: t3 ~r t4. t2')
    g2 : h1 ~N h2
    h1 : t1 ~r t2
    h2 : t3 ~r t4
    ------------------------------------------------
    InstCo g1 g2 : t1'[cv |-> h1] ~ t2'[cv |-> h2]

    We thus want some coercion proving this:

      t1'[cv |-> h1] ~ t2'[cv |-> n1 ; h2; sym n2]

    So we substitute the coercion variable c for the coercion
    (h1 ~N (n1; h2; sym n2)) in g.
    -}

    -- | Coercion optimisation options
    newtype OptCoercionOpts = OptCoercionOpts
       { OptCoercionOpts -> Bool
    optCoercionEnabled :: Bool  -- ^ Enable coercion optimisation (reduce its size)
       }

    optCoercion :: OptCoercionOpts -> Subst -> Coercion -> NormalCo
    -- ^ optCoercion applies a substitution to a coercion,
    --   *and* optimises it to reduce its size
    optCoercion :: OptCoercionOpts -> Subst -> Coercion -> Coercion
    optCoercion OptCoercionOpts
    opts Subst
    env Coercion
    co
      | OptCoercionOpts -> Bool
    optCoercionEnabled OptCoercionOpts
    opts
      = Subst -> Coercion -> Coercion
    optCoercion' Subst
    env Coercion
    co
    {-
      = pprTrace "optCoercion {" (text "Co:" <+> ppr co) $
        let result = optCoercion' env co in
        pprTrace "optCoercion }" (vcat [ text "Co:" <+> ppr co
                                       , text "Optco:" <+> ppr result ]) $
        result
    -}

      | Bool
    otherwise
      = HasDebugCallStack => Subst -> Coercion -> Coercion
    Subst -> Coercion -> Coercion
    substCo Subst
    env Coercion
    co

    optCoercion' :: Subst -> Coercion -> NormalCo
    optCoercion' :: Subst -> Coercion -> Coercion
    optCoercion' Subst
    env Coercion
    co
      | Bool
    debugIsOn
      = let out_co :: Coercion
    out_co = LiftingContext -> Bool -> Coercion -> Coercion
    opt_co1 LiftingContext
    lc Bool
    False Coercion
    co
            (Pair Type
    in_ty1  Type
    in_ty2,  Role
    in_role)  = Coercion -> (Pair Type, Role)
    coercionKindRole Coercion
    co
            (Pair Type
    out_ty1 Type
    out_ty2, Role
    out_role) = Coercion -> (Pair Type, Role)
    coercionKindRole Coercion
    out_co
        in
        Bool -> SDoc -> Coercion -> Coercion
    forall a. HasCallStack => Bool -> SDoc -> a -> a
    assertPpr (Subst -> Type -> Type
    substTyUnchecked Subst
    env Type
    in_ty1 Type -> Type -> Bool
    `eqType` Type
    out_ty1 Bool -> Bool -> Bool
    &&
                   Subst -> Type -> Type
    substTyUnchecked Subst
    env Type
    in_ty2 Type -> Type -> Bool
    `eqType` Type
    out_ty2 Bool -> Bool -> Bool
    &&
                   Role
    in_role Role -> Role -> Bool
    forall a. Eq a => a -> a -> Bool
    == Role
    out_role)
                  (SDoc -> Int -> SDoc -> SDoc
    hang (String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "optCoercion changed types!")
                      Int
    2 ([SDoc] -> SDoc
    forall doc. IsDoc doc => [doc] -> doc
    vcat [ String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "in_co:" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> Coercion -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Coercion
    co
                              , String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "in_ty1:" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> Type -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Type
    in_ty1
                              , String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "in_ty2:" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> Type -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Type
    in_ty2
                              , String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "out_co:" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> Coercion -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Coercion
    out_co
                              , String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "out_ty1:" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> Type -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Type
    out_ty1
                              , String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "out_ty2:" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> Type -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Type
    out_ty2
                              , String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "in_role:" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> Role -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Role
    in_role
                              , String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "out_role:" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> Role -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Role
    out_role
                              , [SDoc] -> SDoc
    forall doc. IsDoc doc => [doc] -> doc
    vcat ([SDoc] -> SDoc) -> [SDoc] -> SDoc
    forall a b. (a -> b) -> a -> b
    $ (CoVar -> SDoc) -> [CoVar] -> [SDoc]
    forall a b. (a -> b) -> [a] -> [b]
    map CoVar -> SDoc
    ppr_one ([CoVar] -> [SDoc]) -> [CoVar] -> [SDoc]
    forall a b. (a -> b) -> a -> b
    $ UniqSet CoVar -> [CoVar]
    forall elt. UniqSet elt -> [elt]
    nonDetEltsUniqSet (UniqSet CoVar -> [CoVar]) -> UniqSet CoVar -> [CoVar]
    forall a b. (a -> b) -> a -> b
    $ Coercion -> UniqSet CoVar
    coVarsOfCo Coercion
    co
                              , String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "subst:" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> Subst -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Subst
    env ]))
                   Coercion
    out_co

      | Bool
    otherwise         = LiftingContext -> Bool -> Coercion -> Coercion
    opt_co1 LiftingContext
    lc Bool
    False Coercion
    co
      where
        lc :: LiftingContext
    lc = Subst -> LiftingContext
    mkSubstLiftingContext Subst
    env
        ppr_one :: CoVar -> SDoc
    ppr_one CoVar
    cv = CoVar -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr CoVar
    cv SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> SDoc
    dcolon SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> Type -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr (CoVar -> Type
    coVarKind CoVar
    cv)

    type NormalCo    = Coercion
      -- Invariants:
      --  * The substitution has been fully applied
      --  * For trans coercions (co1 `trans` co2)
      --       co1 is not a trans, and neither co1 nor co2 is identity

    type NormalNonIdCo = NormalCo  -- Extra invariant: not the identity

    -- | Do we apply a @sym@ to the result?
    type SymFlag = Bool

    -- | Do we force the result to be representational?
    type ReprFlag = Bool

    -- | Optimize a coercion, making no assumptions. All coercions in
    -- the lifting context are already optimized (and sym'd if nec'y)
    opt_co1 :: LiftingContext
            -> SymFlag
            -> Coercion -> NormalCo
    opt_co1 :: LiftingContext -> Bool -> Coercion -> Coercion
    opt_co1 LiftingContext
    env Bool
    sym Coercion
    co = LiftingContext -> Bool -> Role -> Coercion -> Coercion
    opt_co2 LiftingContext
    env Bool
    sym (Coercion -> Role
    coercionRole Coercion
    co) Coercion
    co

    -- See Note [Optimising coercion optimisation]
    -- | Optimize a coercion, knowing the coercion's role. No other assumptions.
    opt_co2 :: LiftingContext
            -> SymFlag
            -> Role   -- ^ The role of the input coercion
            -> Coercion -> NormalCo
    opt_co2 :: LiftingContext -> Bool -> Role -> Coercion -> Coercion
    opt_co2 LiftingContext
    env Bool
    sym Role
    Phantom Coercion
    co = LiftingContext -> Bool -> Coercion -> Coercion
    opt_phantom LiftingContext
    env Bool
    sym Coercion
    co
    opt_co2 LiftingContext
    env Bool
    sym Role
    r       Coercion
    co = LiftingContext
    -> Bool -> Maybe Role -> Role -> Coercion -> Coercion
    opt_co3 LiftingContext
    env Bool
    sym Maybe Role
    forall a. Maybe a
    Nothing Role
    r Coercion
    co

    -- See Note [Optimising coercion optimisation]
    -- | Optimize a coercion, knowing the coercion's non-Phantom role.
    opt_co3 :: LiftingContext -> SymFlag -> Maybe Role -> Role -> Coercion -> NormalCo
    opt_co3 :: LiftingContext
    -> Bool -> Maybe Role -> Role -> Coercion -> Coercion
    opt_co3 LiftingContext
    env Bool
    sym (Just Role
    Phantom)          Role
    _ Coercion
    co = LiftingContext -> Bool -> Coercion -> Coercion
    opt_phantom LiftingContext
    env Bool
    sym Coercion
    co
    opt_co3 LiftingContext
    env Bool
    sym (Just Role
    Representational) Role
    r Coercion
    co = LiftingContext -> Bool -> Bool -> Role -> Coercion -> Coercion
    opt_co4_wrap LiftingContext
    env Bool
    sym Bool
    True  Role
    r Coercion
    co
      -- if mrole is Just Nominal, that can't be a downgrade, so we can ignore
    opt_co3 LiftingContext
    env Bool
    sym Maybe Role
    _                       Role
    r Coercion
    co = LiftingContext -> Bool -> Bool -> Role -> Coercion -> Coercion
    opt_co4_wrap LiftingContext
    env Bool
    sym Bool
    False Role
    r Coercion
    co

    -- See Note [Optimising coercion optimisation]
    -- | Optimize a non-phantom coercion.
    opt_co4, opt_co4_wrap :: LiftingContext -> SymFlag -> ReprFlag
                          -> Role -> Coercion -> NormalCo
    -- Precondition: In every call (opt_co4 lc sym rep role co)
    --               we should have role = coercionRole co
    opt_co4_wrap :: LiftingContext -> Bool -> Bool -> Role -> Coercion -> Coercion
    opt_co4_wrap = LiftingContext -> Bool -> Bool -> Role -> Coercion -> Coercion
    opt_co4

    {-
    opt_co4_wrap env sym rep r co
      = pprTrace "opt_co4_wrap {"
        ( vcat [ text "Sym:" <+> ppr sym
               , text "Rep:" <+> ppr rep
               , text "Role:" <+> ppr r
               , text "Co:" <+> ppr co ]) $
        assert (r == coercionRole co )    $
        let result = opt_co4 env sym rep r co in
        pprTrace "opt_co4_wrap }" (ppr co $$ text "---" $$ ppr result) $
        result
    -}

    opt_co4 :: LiftingContext -> Bool -> Bool -> Role -> Coercion -> Coercion
    opt_co4 LiftingContext
    env Bool
    _   Bool
    rep Role
    r (Refl Type
    ty)
      = Bool -> SDoc -> Coercion -> Coercion
    forall a. HasCallStack => Bool -> SDoc -> a -> a
    assertPpr (Role
    r Role -> Role -> Bool
    forall a. Eq a => a -> a -> Bool
    == Role
    Nominal)
                  (String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "Expected role:" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> Role -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Role
    r    SDoc -> SDoc -> SDoc
    forall doc. IsDoc doc => doc -> doc -> doc
    $$
                   String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "Found role:" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> Role -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Role
    Nominal SDoc -> SDoc -> SDoc
    forall doc. IsDoc doc => doc -> doc -> doc
    $$
                   String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "Type:" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> Type -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Type
    ty) (Coercion -> Coercion) -> Coercion -> Coercion
    forall a b. (a -> b) -> a -> b
    $
        HasDebugCallStack => Role -> LiftingContext -> Type -> Coercion
    Role -> LiftingContext -> Type -> Coercion
    liftCoSubst (Bool -> Role -> Role
    chooseRole Bool
    rep Role
    r) LiftingContext
    env Type
    ty

    opt_co4 LiftingContext
    env Bool
    _   Bool
    rep Role
    r (GRefl Role
    _r Type
    ty MCoercion
    MRefl)
      = Bool -> SDoc -> Coercion -> Coercion
    forall a. HasCallStack => Bool -> SDoc -> a -> a
    assertPpr (Role
    r Role -> Role -> Bool
    forall a. Eq a => a -> a -> Bool
    == Role
    _r)
                  (String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "Expected role:" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> Role -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Role
    r SDoc -> SDoc -> SDoc
    forall doc. IsDoc doc => doc -> doc -> doc
    $$
                   String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "Found role:" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> Role -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Role
    _r   SDoc -> SDoc -> SDoc
    forall doc. IsDoc doc => doc -> doc -> doc
    $$
                   String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "Type:" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> Type -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Type
    ty) (Coercion -> Coercion) -> Coercion -> Coercion
    forall a b. (a -> b) -> a -> b
    $
        HasDebugCallStack => Role -> LiftingContext -> Type -> Coercion
    Role -> LiftingContext -> Type -> Coercion
    liftCoSubst (Bool -> Role -> Role
    chooseRole Bool
    rep Role
    r) LiftingContext
    env Type
    ty

    opt_co4 LiftingContext
    env Bool
    sym  Bool
    rep Role
    r (GRefl Role
    _r Type
    ty (MCo Coercion
    co))
      = Bool -> SDoc -> Coercion -> Coercion
    forall a. HasCallStack => Bool -> SDoc -> a -> a
    assertPpr (Role
    r Role -> Role -> Bool
    forall a. Eq a => a -> a -> Bool
    == Role
    _r)
                  (String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "Expected role:" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> Role -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Role
    r SDoc -> SDoc -> SDoc
    forall doc. IsDoc doc => doc -> doc -> doc
    $$
                   String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "Found role:" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> Role -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Role
    _r   SDoc -> SDoc -> SDoc
    forall doc. IsDoc doc => doc -> doc -> doc
    $$
                   String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "Type:" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> Type -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Type
    ty) (Coercion -> Coercion) -> Coercion -> Coercion
    forall a b. (a -> b) -> a -> b
    $
        if Coercion -> Bool
    isGReflCo Coercion
    co Bool -> Bool -> Bool
    || Coercion -> Bool
    isGReflCo Coercion
    co'
        then HasDebugCallStack => Role -> LiftingContext -> Type -> Coercion
    Role -> LiftingContext -> Type -> Coercion
    liftCoSubst Role
    r' LiftingContext
    env Type
    ty
        else Bool -> Coercion -> Coercion
    wrapSym Bool
    sym (Coercion -> Coercion) -> Coercion -> Coercion
    forall a b. (a -> b) -> a -> b
    $ Role -> Type -> Coercion -> Coercion -> Coercion
    mkCoherenceRightCo Role
    r' Type
    ty' Coercion
    co' (HasDebugCallStack => Role -> LiftingContext -> Type -> Coercion
    Role -> LiftingContext -> Type -> Coercion
    liftCoSubst Role
    r' LiftingContext
    env Type
    ty)
      where
        r' :: Role
    r'  = Bool -> Role -> Role
    chooseRole Bool
    rep Role
    r
        ty' :: Type
    ty' = HasDebugCallStack => Subst -> Type -> Type
    Subst -> Type -> Type
    substTy (LiftingContext -> Subst
    lcSubstLeft LiftingContext
    env) Type
    ty
        co' :: Coercion
    co' = LiftingContext -> Bool -> Bool -> Role -> Coercion -> Coercion
    opt_co4 LiftingContext
    env Bool
    False Bool
    False Role
    Nominal Coercion
    co

    opt_co4 LiftingContext
    env Bool
    sym Bool
    rep Role
    r (SymCo Coercion
    co)  = LiftingContext -> Bool -> Bool -> Role -> Coercion -> Coercion
    opt_co4_wrap LiftingContext
    env (Bool -> Bool
    not Bool
    sym) Bool
    rep Role
    r Coercion
    co
      -- surprisingly, we don't have to do anything to the env here. This is
      -- because any "lifting" substitutions in the env are tied to ForAllCos,
      -- which treat their left and right sides differently. We don't want to
      -- exchange them.

    opt_co4 LiftingContext
    env Bool
    sym Bool
    rep Role
    r g :: Coercion
    g@(TyConAppCo Role
    _r TyCon
    tc [Coercion]
    cos)
      = Bool -> Coercion -> Coercion
    forall a. HasCallStack => Bool -> a -> a
    assert (Role
    r Role -> Role -> Bool
    forall a. Eq a => a -> a -> Bool
    == Role
    _r) (Coercion -> Coercion) -> Coercion -> Coercion
    forall a b. (a -> b) -> a -> b
    $
        case (Bool
    rep, Role
    r) of
          (Bool
    True, Role
    Nominal) ->
            HasDebugCallStack => Role -> TyCon -> [Coercion] -> Coercion
    Role -> TyCon -> [Coercion] -> Coercion
    mkTyConAppCo Role
    Representational TyCon
    tc
                         ((Maybe Role -> Role -> Coercion -> Coercion)
    -> [Maybe Role] -> [Role] -> [Coercion] -> [Coercion]
    forall a b c d. (a -> b -> c -> d) -> [a] -> [b] -> [c] -> [d]
    zipWith3 (LiftingContext
    -> Bool -> Maybe Role -> Role -> Coercion -> Coercion
    opt_co3 LiftingContext
    env Bool
    sym)
                                   ((Role -> Maybe Role) -> [Role] -> [Maybe Role]
    forall a b. (a -> b) -> [a] -> [b]
    map Role -> Maybe Role
    forall a. a -> Maybe a
    Just (TyCon -> [Role]
    tyConRoleListRepresentational TyCon
    tc))
                                   (Role -> [Role]
    forall a. a -> [a]
    repeat Role
    Nominal)
                                   [Coercion]
    cos)
          (Bool
    False, Role
    Nominal) ->
            HasDebugCallStack => Role -> TyCon -> [Coercion] -> Coercion
    Role -> TyCon -> [Coercion] -> Coercion
    mkTyConAppCo Role
    Nominal TyCon
    tc ((Coercion -> Coercion) -> [Coercion] -> [Coercion]
    forall a b. (a -> b) -> [a] -> [b]
    map (LiftingContext -> Bool -> Bool -> Role -> Coercion -> Coercion
    opt_co4_wrap LiftingContext
    env Bool
    sym Bool
    False Role
    Nominal) [Coercion]
    cos)
          (Bool
    _, Role
    Representational) ->
                          -- must use opt_co2 here, because some roles may be P
                          -- See Note [Optimising coercion optimisation]
            HasDebugCallStack => Role -> TyCon -> [Coercion] -> Coercion
    Role -> TyCon -> [Coercion] -> Coercion
    mkTyConAppCo Role
    r TyCon
    tc ((Role -> Coercion -> Coercion)
    -> [Role] -> [Coercion] -> [Coercion]
    forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
    zipWith (LiftingContext -> Bool -> Role -> Coercion -> Coercion
    opt_co2 LiftingContext
    env Bool
    sym)
                                       (TyCon -> [Role]
    tyConRoleListRepresentational TyCon
    tc)  -- the current roles
                                       [Coercion]
    cos)
          (Bool
    _, Role
    Phantom) -> String -> SDoc -> Coercion
    forall a. HasCallStack => String -> SDoc -> a
    pprPanic String
    "opt_co4 sees a phantom!" (Coercion -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Coercion
    g)

    opt_co4 LiftingContext
    env Bool
    sym Bool
    rep Role
    r (AppCo Coercion
    co1 Coercion
    co2)
      = Coercion -> Coercion -> Coercion
    mkAppCo (LiftingContext -> Bool -> Bool -> Role -> Coercion -> Coercion
    opt_co4_wrap LiftingContext
    env Bool
    sym Bool
    rep Role
    r Coercion
    co1)
                (LiftingContext -> Bool -> Bool -> Role -> Coercion -> Coercion
    opt_co4_wrap LiftingContext
    env Bool
    sym Bool
    False Role
    Nominal Coercion
    co2)

    opt_co4 LiftingContext
    env Bool
    sym Bool
    rep Role
    r (ForAllCo { fco_tcv :: Coercion -> CoVar
    fco_tcv = CoVar
    tv, fco_visL :: Coercion -> ForAllTyFlag
    fco_visL = ForAllTyFlag
    visL, fco_visR :: Coercion -> ForAllTyFlag
    fco_visR = ForAllTyFlag
    visR
                                    , fco_kind :: Coercion -> Coercion
    fco_kind = Coercion
    k_co, fco_body :: Coercion -> Coercion
    fco_body = Coercion
    co })
      = case LiftingContext
    -> Bool -> CoVar -> Coercion -> (LiftingContext, CoVar, Coercion)
    optForAllCoBndr LiftingContext
    env Bool
    sym CoVar
    tv Coercion
    k_co of
          (LiftingContext
    env', CoVar
    tv', Coercion
    k_co') -> HasDebugCallStack =>
    CoVar
    -> ForAllTyFlag -> ForAllTyFlag -> Coercion -> Coercion -> Coercion
    CoVar
    -> ForAllTyFlag -> ForAllTyFlag -> Coercion -> Coercion -> Coercion
    mkForAllCo CoVar
    tv' ForAllTyFlag
    visL' ForAllTyFlag
    visR' Coercion
    k_co' (Coercion -> Coercion) -> Coercion -> Coercion
    forall a b. (a -> b) -> a -> b
    $
                                LiftingContext -> Bool -> Bool -> Role -> Coercion -> Coercion
    opt_co4_wrap LiftingContext
    env' Bool
    sym Bool
    rep Role
    r Coercion
    co
         -- Use the "mk" functions to check for nested Refls
      where
        !(ForAllTyFlag
    visL', ForAllTyFlag
    visR') = Bool
    -> (ForAllTyFlag, ForAllTyFlag) -> (ForAllTyFlag, ForAllTyFlag)
    forall a. Bool -> (a, a) -> (a, a)
    swapSym Bool
    sym (ForAllTyFlag
    visL, ForAllTyFlag
    visR)

    opt_co4 LiftingContext
    env Bool
    sym Bool
    rep Role
    r (FunCo Role
    _r FunTyFlag
    afl FunTyFlag
    afr Coercion
    cow Coercion
    co1 Coercion
    co2)
      = Bool -> Coercion -> Coercion
    forall a. HasCallStack => Bool -> a -> a
    assert (Role
    r Role -> Role -> Bool
    forall a. Eq a => a -> a -> Bool
    == Role
    _r) (Coercion -> Coercion) -> Coercion -> Coercion
    forall a b. (a -> b) -> a -> b
    $
        Role
    -> FunTyFlag
    -> FunTyFlag
    -> Coercion
    -> Coercion
    -> Coercion
    -> Coercion
    mkFunCo2 Role
    r' FunTyFlag
    afl' FunTyFlag
    afr' Coercion
    cow' Coercion
    co1' Coercion
    co2'
      where
        co1' :: Coercion
    co1' = LiftingContext -> Bool -> Bool -> Role -> Coercion -> Coercion
    opt_co4_wrap LiftingContext
    env Bool
    sym Bool
    rep Role
    r Coercion
    co1
        co2' :: Coercion
    co2' = LiftingContext -> Bool -> Bool -> Role -> Coercion -> Coercion
    opt_co4_wrap LiftingContext
    env Bool
    sym Bool
    rep Role
    r Coercion
    co2
        cow' :: Coercion
    cow' = LiftingContext -> Bool -> Coercion -> Coercion
    opt_co1 LiftingContext
    env Bool
    sym Coercion
    cow
        !r' :: Role
    r' | Bool
    rep       = Role
    Representational
            | Bool
    otherwise = Role
    r
        !(FunTyFlag
    afl', FunTyFlag
    afr') = Bool -> (FunTyFlag, FunTyFlag) -> (FunTyFlag, FunTyFlag)
    forall a. Bool -> (a, a) -> (a, a)
    swapSym Bool
    sym (FunTyFlag
    afl, FunTyFlag
    afr)

    opt_co4 LiftingContext
    env Bool
    sym Bool
    rep Role
    r (CoVarCo CoVar
    cv)
      | Just Coercion
    co <- LiftingContext -> CoVar -> Maybe Coercion
    lcLookupCoVar LiftingContext
    env CoVar
    cv   -- see Note [Forall over coercion] for why
                                          -- this is the right thing here
      = LiftingContext -> Bool -> Bool -> Role -> Coercion -> Coercion
    opt_co4_wrap (LiftingContext -> LiftingContext
    zapLiftingContext LiftingContext
    env) Bool
    sym Bool
    rep Role
    r Coercion
    co

      | Type
    ty1 Type -> Type -> Bool
    `eqType` Type
    ty2   -- See Note [Optimise CoVarCo to Refl]
      = Role -> Type -> Coercion
    mkReflCo (Bool -> Role -> Role
    chooseRole Bool
    rep Role
    r) Type
    ty1

      | Bool
    otherwise
      = Bool -> Coercion -> Coercion
    forall a. HasCallStack => Bool -> a -> a
    assert (CoVar -> Bool
    isCoVar CoVar
    cv1) (Coercion -> Coercion) -> Coercion -> Coercion
    forall a b. (a -> b) -> a -> b
    $
        Bool -> Role -> Coercion -> Coercion
    wrapRole Bool
    rep Role
    r (Coercion -> Coercion) -> Coercion -> Coercion
    forall a b. (a -> b) -> a -> b
    $ Bool -> Coercion -> Coercion
    wrapSym Bool
    sym (Coercion -> Coercion) -> Coercion -> Coercion
    forall a b. (a -> b) -> a -> b
    $
        CoVar -> Coercion
    CoVarCo CoVar
    cv1

      where
        Pair Type
    ty1 Type
    ty2 = HasDebugCallStack => CoVar -> Pair Type
    CoVar -> Pair Type
    coVarTypes CoVar
    cv1

        cv1 :: CoVar
    cv1 = case InScopeSet -> CoVar -> Maybe CoVar
    lookupInScope (LiftingContext -> InScopeSet
    lcInScopeSet LiftingContext
    env) CoVar
    cv of
                 Just CoVar
    cv1 -> CoVar
    cv1
                 Maybe CoVar
    Nothing  -> Bool -> String -> SDoc -> CoVar -> CoVar
    forall a. HasCallStack => Bool -> String -> SDoc -> a -> a
    warnPprTrace Bool
    True
                              String
    "opt_co: not in scope"
                              (CoVar -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr CoVar
    cv SDoc -> SDoc -> SDoc
    forall doc. IsDoc doc => doc -> doc -> doc
    $$ LiftingContext -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr LiftingContext
    env)
                              CoVar
    cv
              -- cv1 might have a substituted kind!

    opt_co4 LiftingContext
    _ Bool
    _ Bool
    _ Role
    _ (HoleCo CoercionHole
    h)
      = String -> SDoc -> Coercion
    forall a. HasCallStack => String -> SDoc -> a
    pprPanic String
    "opt_univ fell into a hole" (CoercionHole -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr CoercionHole
    h)

    opt_co4 LiftingContext
    env Bool
    sym Bool
    rep Role
    r (AxiomInstCo CoAxiom Branched
    con Int
    ind [Coercion]
    cos)
        -- Do *not* push sym inside top-level axioms
        -- e.g. if g is a top-level axiom
        --   g a : f a ~ a
        -- then (sym (g ty)) /= g (sym ty) !!
      = Bool
    -> (Bool -> Role -> Coercion -> Coercion)
    -> Bool
    -> Role
    -> Coercion
    -> Coercion
    forall a. HasCallStack => Bool -> a -> a
    assert (Role
    r Role -> Role -> Bool
    forall a. Eq a => a -> a -> Bool
    == CoAxiom Branched -> Role
    forall (br :: BranchFlag). CoAxiom br -> Role
    coAxiomRole CoAxiom Branched
    con )
        Bool -> Role -> Coercion -> Coercion
    wrapRole Bool
    rep (CoAxiom Branched -> Role
    forall (br :: BranchFlag). CoAxiom br -> Role
    coAxiomRole CoAxiom Branched
    con) (Coercion -> Coercion) -> Coercion -> Coercion
    forall a b. (a -> b) -> a -> b
    $
        Bool -> Coercion -> Coercion
    wrapSym Bool
    sym (Coercion -> Coercion) -> Coercion -> Coercion
    forall a b. (a -> b) -> a -> b
    $
                           -- some sub-cos might be P: use opt_co2
                           -- See Note [Optimising coercion optimisation]
        CoAxiom Branched -> Int -> [Coercion] -> Coercion
    AxiomInstCo CoAxiom Branched
    con Int
    ind ((Role -> Coercion -> Coercion)
    -> [Role] -> [Coercion] -> [Coercion]
    forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
    zipWith (LiftingContext -> Bool -> Role -> Coercion -> Coercion
    opt_co2 LiftingContext
    env Bool
    False)
                                     (CoAxBranch -> [Role]
    coAxBranchRoles (CoAxiom Branched -> Int -> CoAxBranch
    forall (br :: BranchFlag). CoAxiom br -> Int -> CoAxBranch
    coAxiomNthBranch CoAxiom Branched
    con Int
    ind))
                                     [Coercion]
    cos)
          -- Note that the_co does *not* have sym pushed into it

    opt_co4 LiftingContext
    env Bool
    sym Bool
    rep Role
    r (UnivCo UnivCoProvenance
    prov Role
    _r Type
    t1 Type
    t2)
      = Bool
    -> (LiftingContext
        -> Bool -> UnivCoProvenance -> Role -> Type -> Type -> Coercion)
    -> LiftingContext
    -> Bool
    -> UnivCoProvenance
    -> Role
    -> Type
    -> Type
    -> Coercion
    forall a. HasCallStack => Bool -> a -> a
    assert (Role
    r Role -> Role -> Bool
    forall a. Eq a => a -> a -> Bool
    == Role
    _r )
        LiftingContext
    -> Bool -> UnivCoProvenance -> Role -> Type -> Type -> Coercion
    opt_univ LiftingContext
    env Bool
    sym UnivCoProvenance
    prov (Bool -> Role -> Role
    chooseRole Bool
    rep Role
    r) Type
    t1 Type
    t2

    opt_co4 LiftingContext
    env Bool
    sym Bool
    rep Role
    r (TransCo Coercion
    co1 Coercion
    co2)
                          -- sym (g `o` h) = sym h `o` sym g
      | Bool
    sym       = InScopeSet -> Coercion -> Coercion -> Coercion
    opt_trans InScopeSet
    in_scope Coercion
    co2' Coercion
    co1'
      | Bool
    otherwise = InScopeSet -> Coercion -> Coercion -> Coercion
    opt_trans InScopeSet
    in_scope Coercion
    co1' Coercion
    co2'
      where
        co1' :: Coercion
    co1' = LiftingContext -> Bool -> Bool -> Role -> Coercion -> Coercion
    opt_co4_wrap LiftingContext
    env Bool
    sym Bool
    rep Role
    r Coercion
    co1
        co2' :: Coercion
    co2' = LiftingContext -> Bool -> Bool -> Role -> Coercion -> Coercion
    opt_co4_wrap LiftingContext
    env Bool
    sym Bool
    rep Role
    r Coercion
    co2
        in_scope :: InScopeSet
    in_scope = LiftingContext -> InScopeSet
    lcInScopeSet LiftingContext
    env

    opt_co4 LiftingContext
    env Bool
    _sym Bool
    rep Role
    r (SelCo CoSel
    n Coercion
    co)
      | Just (Type
    ty, Role
    _co_role) <- Coercion -> Maybe (Type, Role)
    isReflCo_maybe Coercion
    co
      = HasDebugCallStack => Role -> LiftingContext -> Type -> Coercion
    Role -> LiftingContext -> Type -> Coercion
    liftCoSubst (Bool -> Role -> Role
    chooseRole Bool
    rep Role
    r) LiftingContext
    env (HasDebugCallStack => CoSel -> Type -> Type
    CoSel -> Type -> Type
    getNthFromType CoSel
    n Type
    ty)
        -- NB: it is /not/ true that r = _co_role
        --     Rather, r = coercionRole (SelCo n co)

    opt_co4 LiftingContext
    env Bool
    sym Bool
    rep Role
    r (SelCo (SelTyCon Int
    n Role
    r1) (TyConAppCo Role
    _ TyCon
    _ [Coercion]
    cos))
      = Bool
    -> (LiftingContext -> Bool -> Bool -> Role -> Coercion -> Coercion)
    -> LiftingContext
    -> Bool
    -> Bool
    -> Role
    -> Coercion
    -> Coercion
    forall a. HasCallStack => Bool -> a -> a
    assert (Role
    r Role -> Role -> Bool
    forall a. Eq a => a -> a -> Bool
    == Role
    r1 )
        LiftingContext -> Bool -> Bool -> Role -> Coercion -> Coercion
    opt_co4_wrap LiftingContext
    env Bool
    sym Bool
    rep Role
    r ([Coercion]
    cos [Coercion] -> Int -> Coercion
    forall a. Outputable a => [a] -> Int -> a
    `getNth` Int
    n)

    -- see the definition of GHC.Builtin.Types.Prim.funTyCon
    opt_co4 LiftingContext
    env Bool
    sym Bool
    rep Role
    r (SelCo (SelFun FunSel
    fs) (FunCo Role
    _r2 FunTyFlag
    _afl FunTyFlag
    _afr Coercion
    w Coercion
    co1 Coercion
    co2))
      = LiftingContext -> Bool -> Bool -> Role -> Coercion -> Coercion
    opt_co4_wrap LiftingContext
    env Bool
    sym Bool
    rep Role
    r (FunSel -> Coercion -> Coercion -> Coercion -> Coercion
    forall a. FunSel -> a -> a -> a -> a
    getNthFun FunSel
    fs Coercion
    w Coercion
    co1 Coercion
    co2)

    opt_co4 LiftingContext
    env Bool
    sym Bool
    rep Role
    _ (SelCo CoSel
    SelForAll (ForAllCo { fco_kind :: Coercion -> Coercion
    fco_kind = Coercion
    eta }))
          -- works for both tyvar and covar
      = LiftingContext -> Bool -> Bool -> Role -> Coercion -> Coercion
    opt_co4_wrap LiftingContext
    env Bool
    sym Bool
    rep Role
    Nominal Coercion
    eta

    opt_co4 LiftingContext
    env Bool
    sym Bool
    rep Role
    r (SelCo CoSel
    n Coercion
    co)
      | Just Coercion
    nth_co <- case (Coercion
    co', CoSel
    n) of
          (TyConAppCo Role
    _ TyCon
    _ [Coercion]
    cos, SelTyCon Int
    n Role
    _) -> Coercion -> Maybe Coercion
    forall a. a -> Maybe a
    Just ([Coercion]
    cos [Coercion] -> Int -> Coercion
    forall a. Outputable a => [a] -> Int -> a
    `getNth` Int
    n)
          (FunCo Role
    _ FunTyFlag
    _ FunTyFlag
    _ Coercion
    w Coercion
    co1 Coercion
    co2, SelFun FunSel
    fs) -> Coercion -> Maybe Coercion
    forall a. a -> Maybe a
    Just (FunSel -> Coercion -> Coercion -> Coercion -> Coercion
    forall a. FunSel -> a -> a -> a -> a
    getNthFun FunSel
    fs Coercion
    w Coercion
    co1 Coercion
    co2)
          (ForAllCo { fco_kind :: Coercion -> Coercion
    fco_kind = Coercion
    eta }, CoSel
    SelForAll) -> Coercion -> Maybe Coercion
    forall a. a -> Maybe a
    Just Coercion
    eta
          (Coercion, CoSel)
    _                  -> Maybe Coercion
    forall a. Maybe a
    Nothing
      = if Bool
    rep Bool -> Bool -> Bool
    && (Role
    r Role -> Role -> Bool
    forall a. Eq a => a -> a -> Bool
    == Role
    Nominal)
          -- keep propagating the SubCo
        then LiftingContext -> Bool -> Bool -> Role -> Coercion -> Coercion
    opt_co4_wrap (LiftingContext -> LiftingContext
    zapLiftingContext LiftingContext
    env) Bool
    False Bool
    True Role
    Nominal Coercion
    nth_co
        else Coercion
    nth_co

      | Bool
    otherwise
      = Bool -> Role -> Coercion -> Coercion
    wrapRole Bool
    rep Role
    r (Coercion -> Coercion) -> Coercion -> Coercion
    forall a b. (a -> b) -> a -> b
    $ CoSel -> Coercion -> Coercion
    SelCo CoSel
    n Coercion
    co'
      where
        co' :: Coercion
    co' = LiftingContext -> Bool -> Coercion -> Coercion
    opt_co1 LiftingContext
    env Bool
    sym Coercion
    co

    opt_co4 LiftingContext
    env Bool
    sym Bool
    rep Role
    r (LRCo LeftOrRight
    lr Coercion
    co)
      | Just (Coercion, Coercion)
    pr_co <- Coercion -> Maybe (Coercion, Coercion)
    splitAppCo_maybe Coercion
    co
      = Bool
    -> (LiftingContext -> Bool -> Bool -> Role -> Coercion -> Coercion)
    -> LiftingContext
    -> Bool
    -> Bool
    -> Role
    -> Coercion
    -> Coercion
    forall a. HasCallStack => Bool -> a -> a
    assert (Role
    r Role -> Role -> Bool
    forall a. Eq a => a -> a -> Bool
    == Role
    Nominal )
        LiftingContext -> Bool -> Bool -> Role -> Coercion -> Coercion
    opt_co4_wrap LiftingContext
    env Bool
    sym Bool
    rep Role
    Nominal (LeftOrRight -> (Coercion, Coercion) -> Coercion
    forall {a}. LeftOrRight -> (a, a) -> a
    pick_lr LeftOrRight
    lr (Coercion, Coercion)
    pr_co)
      | Just (Coercion, Coercion)
    pr_co <- Coercion -> Maybe (Coercion, Coercion)
    splitAppCo_maybe Coercion
    co'
      = Bool -> Coercion -> Coercion
    forall a. HasCallStack => Bool -> a -> a
    assert (Role
    r Role -> Role -> Bool
    forall a. Eq a => a -> a -> Bool
    == Role
    Nominal) (Coercion -> Coercion) -> Coercion -> Coercion
    forall a b. (a -> b) -> a -> b
    $
        if Bool
    rep
        then LiftingContext -> Bool -> Bool -> Role -> Coercion -> Coercion
    opt_co4_wrap (LiftingContext -> LiftingContext
    zapLiftingContext LiftingContext
    env) Bool
    False Bool
    True Role
    Nominal (LeftOrRight -> (Coercion, Coercion) -> Coercion
    forall {a}. LeftOrRight -> (a, a) -> a
    pick_lr LeftOrRight
    lr (Coercion, Coercion)
    pr_co)
        else LeftOrRight -> (Coercion, Coercion) -> Coercion
    forall {a}. LeftOrRight -> (a, a) -> a
    pick_lr LeftOrRight
    lr (Coercion, Coercion)
    pr_co
      | Bool
    otherwise
      = Bool -> Role -> Coercion -> Coercion
    wrapRole Bool
    rep Role
    Nominal (Coercion -> Coercion) -> Coercion -> Coercion
    forall a b. (a -> b) -> a -> b
    $ LeftOrRight -> Coercion -> Coercion
    LRCo LeftOrRight
    lr Coercion
    co'
      where
        co' :: Coercion
    co' = LiftingContext -> Bool -> Bool -> Role -> Coercion -> Coercion
    opt_co4_wrap LiftingContext
    env Bool
    sym Bool
    False Role
    Nominal Coercion
    co

        pick_lr :: LeftOrRight -> (a, a) -> a
    pick_lr LeftOrRight
    CLeft  (a
    l, a
    _) = a
    l
        pick_lr LeftOrRight
    CRight (a
    _, a
    r) = a
    r

    {-
    Note [Forall over coercion]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~
    Example:
      type (:~:) :: forall k. k -> k -> Type
      Refl :: forall k (a :: k) (b :: k). forall (cv :: (~#) k k a b). (:~:) k a b
      k1,k2,k3,k4 :: Type
      eta :: (k1 ~# k2) ~# (k3 ~# k4)    ==    ((~#) Type Type k1 k2) ~# ((~#) Type Type k3 k4)
      co1_3 :: k1 ~# k3
      co2_4 :: k2 ~# k4
      nth 2 eta :: k1 ~# k3
      nth 3 eta :: k2 ~# k4
      co11_31 :: <k1> ~# (sym co1_3)
      co22_24 :: <k2> ~# co2_4
      (forall (cv :: eta). Refl <Type> co1_3 co2_4 (co11_31 ;; cv ;; co22_24)) ::
        (forall (cv :: k1 ~# k2). Refl Type k1 k2 (<k1> ;; cv ;; <k2>) ~#
        (forall (cv :: k3 ~# k4). Refl Type k3 k4
           (sym co1_3 ;; nth 2 eta ;; cv ;; sym (nth 3 eta) ;; co2_4))
      co1_2 :: k1 ~# k2
      co3_4 :: k3 ~# k4
      co5 :: co1_2 ~# co3_4
      InstCo (forall (cv :: eta). Refl <Type> co1_3 co2_4 (co11_31 ;; cv ;; co22_24)) co5 ::
       (Refl Type k1 k2 (<k1> ;; cv ;; <k2>))[cv |-> co1_2] ~#
       (Refl Type k3 k4 (sym co1_3 ;; nth 2 eta ;; cv ;; sym (nth 3 eta) ;; co2_4))[cv |-> co3_4]
          ==
       (Refl Type k1 k2 (<k1> ;; co1_2 ;; <k2>)) ~#
        (Refl Type k3 k4 (sym co1_3 ;; nth 2 eta ;; co3_4 ;; sym (nth 3 eta) ;; co2_4))
          ==>
       Refl <Type> co1_3 co2_4 (co11_31 ;; co1_2 ;; co22_24)
    Conclusion: Because of the way this all works, we want to put in the *left-hand*
    coercion in co5's type. (In the code, co5 is called `arg`.)
    So we extend the environment binding cv to arg's left-hand type.
    -}

    -- See Note [Optimising InstCo]
    opt_co4 LiftingContext
    env Bool
    sym Bool
    rep Role
    r (InstCo Coercion
    co1 Coercion
    arg)
        -- forall over type...
      | Just (CoVar
    tv, ForAllTyFlag
    _visL, ForAllTyFlag
    _visR, Coercion
    kind_co, Coercion
    co_body) <- Coercion
    -> Maybe (CoVar, ForAllTyFlag, ForAllTyFlag, Coercion, Coercion)
    splitForAllCo_ty_maybe Coercion
    co1
      = LiftingContext -> Bool -> Bool -> Role -> Coercion -> Coercion
    opt_co4_wrap (LiftingContext -> CoVar -> Coercion -> LiftingContext
    extendLiftingContext LiftingContext
    env CoVar
    tv
                        (Role -> Type -> Coercion -> Coercion -> Coercion
    mkCoherenceRightCo Role
    Nominal Type
    t2 (Coercion -> Coercion
    mkSymCo Coercion
    kind_co) Coercion
    sym_arg))
                       -- mkSymCo kind_co :: k1 ~ k2
                       -- sym_arg :: (t1 :: k1) ~ (t2 :: k2)
                       -- tv |-> (t1 :: k1) ~ (((t2 :: k2) |> (sym kind_co)) :: k1)
                     Bool
    sym Bool
    rep Role
    r Coercion
    co_body

        -- See Note [Forall over coercion]
      | Just (CoVar
    cv, ForAllTyFlag
    _visL, ForAllTyFlag
    _visR, Coercion
    _kind_co, Coercion
    co_body) <- Coercion
    -> Maybe (CoVar, ForAllTyFlag, ForAllTyFlag, Coercion, Coercion)
    splitForAllCo_co_maybe Coercion
    co1
      , CoercionTy Coercion
    h1 <- Type
    t1
      = LiftingContext -> Bool -> Bool -> Role -> Coercion -> Coercion
    opt_co4_wrap (LiftingContext -> CoVar -> Coercion -> LiftingContext
    extendLiftingContextCvSubst LiftingContext
    env CoVar
    cv Coercion
    h1) Bool
    sym Bool
    rep Role
    r Coercion
    co_body

        -- See if it is a forall after optimization
        -- If so, do an inefficient one-variable substitution, then re-optimize

        -- forall over type...
      | Just (CoVar
    tv', ForAllTyFlag
    _visL, ForAllTyFlag
    _visR, Coercion
    kind_co', Coercion
    co_body') <- Coercion
    -> Maybe (CoVar, ForAllTyFlag, ForAllTyFlag, Coercion, Coercion)
    splitForAllCo_ty_maybe Coercion
    co1'
      = LiftingContext -> Bool -> Bool -> Role -> Coercion -> Coercion
    opt_co4_wrap (LiftingContext -> CoVar -> Coercion -> LiftingContext
    extendLiftingContext (LiftingContext -> LiftingContext
    zapLiftingContext LiftingContext
    env) CoVar
    tv'
                        (Role -> Type -> Coercion -> Coercion -> Coercion
    mkCoherenceRightCo Role
    Nominal Type
    t2' (Coercion -> Coercion
    mkSymCo Coercion
    kind_co') Coercion
    arg'))
                Bool
    False Bool
    False Role
    r' Coercion
    co_body'

        -- See Note [Forall over coercion]
      | Just (CoVar
    cv', ForAllTyFlag
    _visL, ForAllTyFlag
    _visR, Coercion
    _kind_co', Coercion
    co_body') <- Coercion
    -> Maybe (CoVar, ForAllTyFlag, ForAllTyFlag, Coercion, Coercion)
    splitForAllCo_co_maybe Coercion
    co1'
      , CoercionTy Coercion
    h1' <- Type
    t1'
      = LiftingContext -> Bool -> Bool -> Role -> Coercion -> Coercion
    opt_co4_wrap (LiftingContext -> CoVar -> Coercion -> LiftingContext
    extendLiftingContextCvSubst (LiftingContext -> LiftingContext
    zapLiftingContext LiftingContext
    env) CoVar
    cv' Coercion
    h1')
                        Bool
    False Bool
    False Role
    r' Coercion
    co_body'

      | Bool
    otherwise = Coercion -> Coercion -> Coercion
    InstCo Coercion
    co1' Coercion
    arg'
      where
        co1' :: Coercion
    co1'    = LiftingContext -> Bool -> Bool -> Role -> Coercion -> Coercion
    opt_co4_wrap LiftingContext
    env Bool
    sym Bool
    rep Role
    r Coercion
    co1
        r' :: Role
    r'      = Bool -> Role -> Role
    chooseRole Bool
    rep Role
    r
        arg' :: Coercion
    arg'    = LiftingContext -> Bool -> Bool -> Role -> Coercion -> Coercion
    opt_co4_wrap LiftingContext
    env Bool
    sym Bool
    False Role
    Nominal Coercion
    arg
        sym_arg :: Coercion
    sym_arg = Bool -> Coercion -> Coercion
    wrapSym Bool
    sym Coercion
    arg'

        -- Performance note: don't be alarmed by the two calls to coercionKind
        -- here, as only one call to coercionKind is actually demanded per guard.
        -- t1/t2 are used when checking if co1 is a forall, and t1'/t2' are used
        -- when checking if co1' (i.e., co1 post-optimization) is a forall.
        --
        -- t1/t2 must come from sym_arg, not arg', since it's possible that arg'
        -- might have an extra Sym at the front (after being optimized) that co1
        -- lacks, so we need to use sym_arg to balance the number of Syms. (#15725)
        Pair Type
    t1  Type
    t2  = Coercion -> Pair Type
    coercionKind Coercion
    sym_arg
        Pair Type
    t1' Type
    t2' = Coercion -> Pair Type
    coercionKind Coercion
    arg'

    opt_co4 LiftingContext
    env Bool
    sym Bool
    _rep Role
    r (KindCo Coercion
    co)
      = Bool -> Coercion -> Coercion
    forall a. HasCallStack => Bool -> a -> a
    assert (Role
    r Role -> Role -> Bool
    forall a. Eq a => a -> a -> Bool
    == Role
    Nominal) (Coercion -> Coercion) -> Coercion -> Coercion
    forall a b. (a -> b) -> a -> b
    $
        let kco' :: Coercion
    kco' = HasDebugCallStack => Coercion -> Coercion
    Coercion -> Coercion
    promoteCoercion Coercion
    co in
        case Coercion
    kco' of
          KindCo Coercion
    co' -> HasDebugCallStack => Coercion -> Coercion
    Coercion -> Coercion
    promoteCoercion (LiftingContext -> Bool -> Coercion -> Coercion
    opt_co1 LiftingContext
    env Bool
    sym Coercion
    co')
          Coercion
    _          -> LiftingContext -> Bool -> Bool -> Role -> Coercion -> Coercion
    opt_co4_wrap LiftingContext
    env Bool
    sym Bool
    False Role
    Nominal Coercion
    kco'
      -- This might be able to be optimized more to do the promotion
      -- and substitution/optimization at the same time

    opt_co4 LiftingContext
    env Bool
    sym Bool
    _ Role
    r (SubCo Coercion
    co)
      = Bool -> Coercion -> Coercion
    forall a. HasCallStack => Bool -> a -> a
    assert (Role
    r Role -> Role -> Bool
    forall a. Eq a => a -> a -> Bool
    == Role
    Representational) (Coercion -> Coercion) -> Coercion -> Coercion
    forall a b. (a -> b) -> a -> b
    $
        LiftingContext -> Bool -> Bool -> Role -> Coercion -> Coercion
    opt_co4_wrap LiftingContext
    env Bool
    sym Bool
    True Role
    Nominal Coercion
    co

    -- This could perhaps be optimized more.
    opt_co4 LiftingContext
    env Bool
    sym Bool
    rep Role
    r (AxiomRuleCo CoAxiomRule
    co [Coercion]
    cs)
      = Bool -> Coercion -> Coercion
    forall a. HasCallStack => Bool -> a -> a
    assert (Role
    r Role -> Role -> Bool
    forall a. Eq a => a -> a -> Bool
    == CoAxiomRule -> Role
    coaxrRole CoAxiomRule
    co) (Coercion -> Coercion) -> Coercion -> Coercion
    forall a b. (a -> b) -> a -> b
    $
        Bool -> Role -> Coercion -> Coercion
    wrapRole Bool
    rep Role
    r (Coercion -> Coercion) -> Coercion -> Coercion
    forall a b. (a -> b) -> a -> b
    $
        Bool -> Coercion -> Coercion
    wrapSym Bool
    sym (Coercion -> Coercion) -> Coercion -> Coercion
    forall a b. (a -> b) -> a -> b
    $
        CoAxiomRule -> [Coercion] -> Coercion
    AxiomRuleCo CoAxiomRule
    co ((Role -> Coercion -> Coercion)
    -> [Role] -> [Coercion] -> [Coercion]
    forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
    zipWith (LiftingContext -> Bool -> Role -> Coercion -> Coercion
    opt_co2 LiftingContext
    env Bool
    False) (CoAxiomRule -> [Role]
    coaxrAsmpRoles CoAxiomRule
    co) [Coercion]
    cs)

    {- Note [Optimise CoVarCo to Refl]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    If we have (c :: t~t) we can optimise it to Refl. That increases the
    chances of floating the Refl upwards; e.g. Maybe c --> Refl (Maybe t)

    We do so here in optCoercion, not in mkCoVarCo; see Note [mkCoVarCo]
    in GHC.Core.Coercion.
    -}

    -------------
    -- | Optimize a phantom coercion. The input coercion may not necessarily
    -- be a phantom, but the output sure will be.
    opt_phantom :: LiftingContext -> SymFlag -> Coercion -> NormalCo
    opt_phantom :: LiftingContext -> Bool -> Coercion -> Coercion
    opt_phantom LiftingContext
    env Bool
    sym Coercion
    co
      = LiftingContext
    -> Bool -> UnivCoProvenance -> Role -> Type -> Type -> Coercion
    opt_univ LiftingContext
    env Bool
    sym (Coercion -> UnivCoProvenance
    PhantomProv (Coercion -> Coercion
    mkKindCo Coercion
    co)) Role
    Phantom Type
    ty1 Type
    ty2
      where
        Pair Type
    ty1 Type
    ty2 = Coercion -> Pair Type
    coercionKind Coercion
    co

    {- Note [Differing kinds]
       ~~~~~~~~~~~~~~~~~~~~~~
    The two types may not have the same kind (although that would be very unusual).
    But even if they have the same kind, and the same type constructor, the number
    of arguments in a `CoTyConApp` can differ. Consider

      Any :: forall k. k

      Any @Type Int                :: Type
      Any @(Type->Type) Maybe Int  :: Type

    Hence the need to compare argument lengths; see #13658

    Note [opt_univ needs injectivity]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    If opt_univ sees a coercion between `T a1 a2` and `T b1 b2` it will optimize it
    by producing a TyConAppCo for T, and pushing the UnivCo into the arguments.  But
    this works only if T is injective. Otherwise we can have something like

      type family F x where
        F Int  = Int
        F Bool = Int

    where `UnivCo :: F Int ~ F Bool` is reasonable (it is effectively just an
    alternative representation for a couple of uses of AxiomInstCos) but we do not
    want to produce `F (UnivCo :: Int ~ Bool)` where the inner coercion is clearly
    inconsistent.  Hence the opt_univ case for TyConApps checks isInjectiveTyCon.
    See #19509.

     -}

    opt_univ :: LiftingContext -> SymFlag -> UnivCoProvenance -> Role
             -> Type -> Type -> Coercion
    opt_univ :: LiftingContext
    -> Bool -> UnivCoProvenance -> Role -> Type -> Type -> Coercion
    opt_univ LiftingContext
    env Bool
    sym (PhantomProv Coercion
    h) Role
    _r Type
    ty1 Type
    ty2
      | Bool
    sym       = Coercion -> Type -> Type -> Coercion
    mkPhantomCo Coercion
    h' Type
    ty2' Type
    ty1'
      | Bool
    otherwise = Coercion -> Type -> Type -> Coercion
    mkPhantomCo Coercion
    h' Type
    ty1' Type
    ty2'
      where
        h' :: Coercion
    h' = LiftingContext -> Bool -> Bool -> Role -> Coercion -> Coercion
    opt_co4 LiftingContext
    env Bool
    sym Bool
    False Role
    Nominal Coercion
    h
        ty1' :: Type
    ty1' = HasDebugCallStack => Subst -> Type -> Type
    Subst -> Type -> Type
    substTy (LiftingContext -> Subst
    lcSubstLeft  LiftingContext
    env) Type
    ty1
        ty2' :: Type
    ty2' = HasDebugCallStack => Subst -> Type -> Type
    Subst -> Type -> Type
    substTy (LiftingContext -> Subst
    lcSubstRight LiftingContext
    env) Type
    ty2

    opt_univ LiftingContext
    env Bool
    sym UnivCoProvenance
    prov Role
    role Type
    oty1 Type
    oty2
      | Just (TyCon
    tc1, [Type]
    tys1) <- HasDebugCallStack => Type -> Maybe (TyCon, [Type])
    Type -> Maybe (TyCon, [Type])
    splitTyConApp_maybe Type
    oty1
      , Just (TyCon
    tc2, [Type]
    tys2) <- HasDebugCallStack => Type -> Maybe (TyCon, [Type])
    Type -> Maybe (TyCon, [Type])
    splitTyConApp_maybe Type
    oty2
      , TyCon
    tc1 TyCon -> TyCon -> Bool
    forall a. Eq a => a -> a -> Bool
    == TyCon
    tc2
      , TyCon -> Role -> Bool
    isInjectiveTyCon TyCon
    tc1 Role
    role  -- see Note [opt_univ needs injectivity]
      , [Type] -> [Type] -> Bool
    forall a b. [a] -> [b] -> Bool
    equalLength [Type]
    tys1 [Type]
    tys2 -- see Note [Differing kinds]
          -- NB: prov must not be the two interesting ones (ProofIrrel & Phantom);
          -- Phantom is already taken care of, and ProofIrrel doesn't relate tyconapps
      = let roles :: [Role]
    roles    = Role -> TyCon -> [Role]
    tyConRoleListX Role
    role TyCon
    tc1
            arg_cos :: [Coercion]
    arg_cos  = (Role -> Type -> Type -> Coercion)
    -> [Role] -> [Type] -> [Type] -> [Coercion]
    forall a b c d. (a -> b -> c -> d) -> [a] -> [b] -> [c] -> [d]
    zipWith3 (UnivCoProvenance -> Role -> Type -> Type -> Coercion
    mkUnivCo UnivCoProvenance
    prov') [Role]
    roles [Type]
    tys1 [Type]
    tys2
            arg_cos' :: [Coercion]
    arg_cos' = (Role -> Coercion -> Coercion)
    -> [Role] -> [Coercion] -> [Coercion]
    forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
    zipWith (LiftingContext -> Bool -> Bool -> Role -> Coercion -> Coercion
    opt_co4 LiftingContext
    env Bool
    sym Bool
    False) [Role]
    roles [Coercion]
    arg_cos
        in
        HasDebugCallStack => Role -> TyCon -> [Coercion] -> Coercion
    Role -> TyCon -> [Coercion] -> Coercion
    mkTyConAppCo Role
    role TyCon
    tc1 [Coercion]
    arg_cos'

      -- can't optimize the AppTy case because we can't build the kind coercions.

      | Just (Bndr CoVar
    tv1 ForAllTyFlag
    vis1, Type
    ty1) <- Type -> Maybe (ForAllTyBinder, Type)
    splitForAllForAllTyBinder_maybe Type
    oty1
      , CoVar -> Bool
    isTyVar CoVar
    tv1
      , Just (Bndr CoVar
    tv2 ForAllTyFlag
    vis2, Type
    ty2) <- Type -> Maybe (ForAllTyBinder, Type)
    splitForAllForAllTyBinder_maybe Type
    oty2
      , CoVar -> Bool
    isTyVar CoVar
    tv2
          -- NB: prov isn't interesting here either
      = let k1 :: Type
    k1   = CoVar -> Type
    tyVarKind CoVar
    tv1
            k2 :: Type
    k2   = CoVar -> Type
    tyVarKind CoVar
    tv2
            eta :: Coercion
    eta  = UnivCoProvenance -> Role -> Type -> Type -> Coercion
    mkUnivCo UnivCoProvenance
    prov' Role
    Nominal Type
    k1 Type
    k2
              -- eta gets opt'ed soon, but not yet.
            ty2' :: Type
    ty2' = [CoVar] -> [Type] -> Type -> Type
    HasDebugCallStack => [CoVar] -> [Type] -> Type -> Type
    substTyWith [CoVar
    tv2] [CoVar -> Type
    TyVarTy CoVar
    tv1 Type -> Coercion -> Type
    `mkCastTy` Coercion
    eta] Type
    ty2

            (LiftingContext
    env', CoVar
    tv1', Coercion
    eta') = LiftingContext
    -> Bool -> CoVar -> Coercion -> (LiftingContext, CoVar, Coercion)
    optForAllCoBndr LiftingContext
    env Bool
    sym CoVar
    tv1 Coercion
    eta
            !(ForAllTyFlag
    vis1', ForAllTyFlag
    vis2') = Bool
    -> (ForAllTyFlag, ForAllTyFlag) -> (ForAllTyFlag, ForAllTyFlag)
    forall a. Bool -> (a, a) -> (a, a)
    swapSym Bool
    sym (ForAllTyFlag
    vis1, ForAllTyFlag
    vis2)
        in
        HasDebugCallStack =>
    CoVar
    -> ForAllTyFlag -> ForAllTyFlag -> Coercion -> Coercion -> Coercion
    CoVar
    -> ForAllTyFlag -> ForAllTyFlag -> Coercion -> Coercion -> Coercion
    mkForAllCo CoVar
    tv1' ForAllTyFlag
    vis1' ForAllTyFlag
    vis2' Coercion
    eta' (LiftingContext
    -> Bool -> UnivCoProvenance -> Role -> Type -> Type -> Coercion
    opt_univ LiftingContext
    env' Bool
    sym UnivCoProvenance
    prov' Role
    role Type
    ty1 Type
    ty2')

      | Just (Bndr CoVar
    cv1 ForAllTyFlag
    vis1, Type
    ty1) <- Type -> Maybe (ForAllTyBinder, Type)
    splitForAllForAllTyBinder_maybe Type
    oty1
      , CoVar -> Bool
    isCoVar CoVar
    cv1
      , Just (Bndr CoVar
    cv2 ForAllTyFlag
    vis2, Type
    ty2) <- Type -> Maybe (ForAllTyBinder, Type)
    splitForAllForAllTyBinder_maybe Type
    oty2
      , CoVar -> Bool
    isCoVar CoVar
    cv2
          -- NB: prov isn't interesting here either
      = let k1 :: Type
    k1    = CoVar -> Type
    varType CoVar
    cv1
            k2 :: Type
    k2    = CoVar -> Type
    varType CoVar
    cv2
            r' :: Role
    r'    = CoVar -> Role
    coVarRole CoVar
    cv1
            eta :: Coercion
    eta   = UnivCoProvenance -> Role -> Type -> Type -> Coercion
    mkUnivCo UnivCoProvenance
    prov' Role
    Nominal Type
    k1 Type
    k2
            eta_d :: Coercion
    eta_d = Role -> Role -> Coercion -> Coercion
    downgradeRole Role
    r' Role
    Nominal Coercion
    eta
              -- eta gets opt'ed soon, but not yet.
            n_co :: Coercion
    n_co  = (Coercion -> Coercion
    mkSymCo (Coercion -> Coercion) -> Coercion -> Coercion
    forall a b. (a -> b) -> a -> b
    $ HasDebugCallStack => CoSel -> Coercion -> Coercion
    CoSel -> Coercion -> Coercion
    mkSelCo (Int -> Role -> CoSel
    SelTyCon Int
    2 Role
    r') Coercion
    eta_d) Coercion -> Coercion -> Coercion
    `mkTransCo`
                    (CoVar -> Coercion
    mkCoVarCo CoVar
    cv1) Coercion -> Coercion -> Coercion
    `mkTransCo`
                    (HasDebugCallStack => CoSel -> Coercion -> Coercion
    CoSel -> Coercion -> Coercion
    mkSelCo (Int -> Role -> CoSel
    SelTyCon Int
    3 Role
    r') Coercion
    eta_d)
            ty2' :: Type
    ty2'  = [CoVar] -> [Coercion] -> Type -> Type
    substTyWithCoVars [CoVar
    cv2] [Coercion
    n_co] Type
    ty2

            (LiftingContext
    env', CoVar
    cv1', Coercion
    eta') = LiftingContext
    -> Bool -> CoVar -> Coercion -> (LiftingContext, CoVar, Coercion)
    optForAllCoBndr LiftingContext
    env Bool
    sym CoVar
    cv1 Coercion
    eta
            !(ForAllTyFlag
    vis1', ForAllTyFlag
    vis2') = Bool
    -> (ForAllTyFlag, ForAllTyFlag) -> (ForAllTyFlag, ForAllTyFlag)
    forall a. Bool -> (a, a) -> (a, a)
    swapSym Bool
    sym (ForAllTyFlag
    vis1, ForAllTyFlag
    vis2)
        in
        HasDebugCallStack =>
    CoVar
    -> ForAllTyFlag -> ForAllTyFlag -> Coercion -> Coercion -> Coercion
    CoVar
    -> ForAllTyFlag -> ForAllTyFlag -> Coercion -> Coercion -> Coercion
    mkForAllCo CoVar
    cv1' ForAllTyFlag
    vis1' ForAllTyFlag
    vis2' Coercion
    eta' (LiftingContext
    -> Bool -> UnivCoProvenance -> Role -> Type -> Type -> Coercion
    opt_univ LiftingContext
    env' Bool
    sym UnivCoProvenance
    prov' Role
    role Type
    ty1 Type
    ty2')

      | Bool
    otherwise
      = let ty1 :: Type
    ty1 = Subst -> Type -> Type
    substTyUnchecked (LiftingContext -> Subst
    lcSubstLeft  LiftingContext
    env) Type
    oty1
            ty2 :: Type
    ty2 = Subst -> Type -> Type
    substTyUnchecked (LiftingContext -> Subst
    lcSubstRight LiftingContext
    env) Type
    oty2
            (Type
    a, Type
    b) | Bool
    sym       = (Type
    ty2, Type
    ty1)
                   | Bool
    otherwise = (Type
    ty1, Type
    ty2)
        in
        UnivCoProvenance -> Role -> Type -> Type -> Coercion
    mkUnivCo UnivCoProvenance
    prov' Role
    role Type
    a Type
    b

      where
        prov' :: UnivCoProvenance
    prov' = case UnivCoProvenance
    prov of
          ProofIrrelProv Coercion
    kco -> Coercion -> UnivCoProvenance
    ProofIrrelProv (Coercion -> UnivCoProvenance) -> Coercion -> UnivCoProvenance
    forall a b. (a -> b) -> a -> b
    $ LiftingContext -> Bool -> Bool -> Role -> Coercion -> Coercion
    opt_co4_wrap LiftingContext
    env Bool
    sym Bool
    False Role
    Nominal Coercion
    kco
          PluginProv String
    _       -> UnivCoProvenance
    prov

    -------------
    opt_transList :: HasDebugCallStack => InScopeSet -> [NormalCo] -> [NormalCo] -> [NormalCo]
    opt_transList :: HasDebugCallStack =>
    InScopeSet -> [Coercion] -> [Coercion] -> [Coercion]
    opt_transList InScopeSet
    is = String
    -> (Coercion -> Coercion -> Coercion)
    -> [Coercion]
    -> [Coercion]
    -> [Coercion]
    forall a b c.
    HasDebugCallStack =>
    String -> (a -> b -> c) -> [a] -> [b] -> [c]
    zipWithEqual String
    "opt_transList" (InScopeSet -> Coercion -> Coercion -> Coercion
    opt_trans InScopeSet
    is)
      -- The input lists must have identical length.

    opt_trans :: InScopeSet -> NormalCo -> NormalCo -> NormalCo
    opt_trans :: InScopeSet -> Coercion -> Coercion -> Coercion
    opt_trans InScopeSet
    is Coercion
    co1 Coercion
    co2
      | Coercion -> Bool
    isReflCo Coercion
    co1 = Coercion
    co2
        -- optimize when co1 is a Refl Co
      | Bool
    otherwise    = InScopeSet -> Coercion -> Coercion -> Coercion
    opt_trans1 InScopeSet
    is Coercion
    co1 Coercion
    co2

    opt_trans1 :: InScopeSet -> NormalNonIdCo -> NormalCo -> NormalCo
    -- First arg is not the identity
    opt_trans1 :: InScopeSet -> Coercion -> Coercion -> Coercion
    opt_trans1 InScopeSet
    is Coercion
    co1 Coercion
    co2
      | Coercion -> Bool
    isReflCo Coercion
    co2 = Coercion
    co1
        -- optimize when co2 is a Refl Co
      | Bool
    otherwise    = InScopeSet -> Coercion -> Coercion -> Coercion
    opt_trans2 InScopeSet
    is Coercion
    co1 Coercion
    co2

    opt_trans2 :: InScopeSet -> NormalNonIdCo -> NormalNonIdCo -> NormalCo
    -- Neither arg is the identity
    opt_trans2 :: InScopeSet -> Coercion -> Coercion -> Coercion
    opt_trans2 InScopeSet
    is (TransCo Coercion
    co1a Coercion
    co1b) Coercion
    co2
        -- Don't know whether the sub-coercions are the identity
      = InScopeSet -> Coercion -> Coercion -> Coercion
    opt_trans InScopeSet
    is Coercion
    co1a (InScopeSet -> Coercion -> Coercion -> Coercion
    opt_trans InScopeSet
    is Coercion
    co1b Coercion
    co2)

    opt_trans2 InScopeSet
    is Coercion
    co1 Coercion
    co2
      | Just Coercion
    co <- InScopeSet -> Coercion -> Coercion -> Maybe Coercion
    opt_trans_rule InScopeSet
    is Coercion
    co1 Coercion
    co2
      = Coercion
    co

    opt_trans2 InScopeSet
    is Coercion
    co1 (TransCo Coercion
    co2a Coercion
    co2b)
      | Just Coercion
    co1_2a <- InScopeSet -> Coercion -> Coercion -> Maybe Coercion
    opt_trans_rule InScopeSet
    is Coercion
    co1 Coercion
    co2a
      = if Coercion -> Bool
    isReflCo Coercion
    co1_2a
        then Coercion
    co2b
        else InScopeSet -> Coercion -> Coercion -> Coercion
    opt_trans1 InScopeSet
    is Coercion
    co1_2a Coercion
    co2b

    opt_trans2 InScopeSet
    _ Coercion
    co1 Coercion
    co2
      = Coercion -> Coercion -> Coercion
    mkTransCo Coercion
    co1 Coercion
    co2

    ------
    -- Optimize coercions with a top-level use of transitivity.
    opt_trans_rule :: InScopeSet -> NormalNonIdCo -> NormalNonIdCo -> Maybe NormalCo

    opt_trans_rule :: InScopeSet -> Coercion -> Coercion -> Maybe Coercion
    opt_trans_rule InScopeSet
    is in_co1 :: Coercion
    in_co1@(GRefl Role
    r1 Type
    t1 (MCo Coercion
    co1)) in_co2 :: Coercion
    in_co2@(GRefl Role
    r2 Type
    _ (MCo Coercion
    co2))
      = Bool -> Maybe Coercion -> Maybe Coercion
    forall a. HasCallStack => Bool -> a -> a
    assert (Role
    r1 Role -> Role -> Bool
    forall a. Eq a => a -> a -> Bool
    == Role
    r2) (Maybe Coercion -> Maybe Coercion)
    -> Maybe Coercion -> Maybe Coercion
    forall a b. (a -> b) -> a -> b
    $
        String -> Coercion -> Coercion -> Coercion -> Maybe Coercion
    fireTransRule String
    "GRefl" Coercion
    in_co1 Coercion
    in_co2 (Coercion -> Maybe Coercion) -> Coercion -> Maybe Coercion
    forall a b. (a -> b) -> a -> b
    $
        Role -> Type -> Coercion -> Coercion
    mkGReflRightCo Role
    r1 Type
    t1 (InScopeSet -> Coercion -> Coercion -> Coercion
    opt_trans InScopeSet
    is Coercion
    co1 Coercion
    co2)

    -- Push transitivity through matching destructors
    opt_trans_rule InScopeSet
    is in_co1 :: Coercion
    in_co1@(SelCo CoSel
    d1 Coercion
    co1) in_co2 :: Coercion
    in_co2@(SelCo CoSel
    d2 Coercion
    co2)
      | CoSel
    d1 CoSel -> CoSel -> Bool
    forall a. Eq a => a -> a -> Bool
    == CoSel
    d2
      , Coercion -> Role
    coercionRole Coercion
    co1 Role -> Role -> Bool
    forall a. Eq a => a -> a -> Bool
    == Coercion -> Role
    coercionRole Coercion
    co2
      , Coercion
    co1 Coercion -> Coercion -> Bool
    `compatible_co` Coercion
    co2
      = String -> Coercion -> Coercion -> Coercion -> Maybe Coercion
    fireTransRule String
    "PushNth" Coercion
    in_co1 Coercion
    in_co2 (Coercion -> Maybe Coercion) -> Coercion -> Maybe Coercion
    forall a b. (a -> b) -> a -> b
    $
        HasDebugCallStack => CoSel -> Coercion -> Coercion
    CoSel -> Coercion -> Coercion
    mkSelCo CoSel
    d1 (InScopeSet -> Coercion -> Coercion -> Coercion
    opt_trans InScopeSet
    is Coercion
    co1 Coercion
    co2)

    opt_trans_rule InScopeSet
    is in_co1 :: Coercion
    in_co1@(LRCo LeftOrRight
    d1 Coercion
    co1) in_co2 :: Coercion
    in_co2@(LRCo LeftOrRight
    d2 Coercion
    co2)
      | LeftOrRight
    d1 LeftOrRight -> LeftOrRight -> Bool
    forall a. Eq a => a -> a -> Bool
    == LeftOrRight
    d2
      , Coercion
    co1 Coercion -> Coercion -> Bool
    `compatible_co` Coercion
    co2
      = String -> Coercion -> Coercion -> Coercion -> Maybe Coercion
    fireTransRule String
    "PushLR" Coercion
    in_co1 Coercion
    in_co2 (Coercion -> Maybe Coercion) -> Coercion -> Maybe Coercion
    forall a b. (a -> b) -> a -> b
    $
        LeftOrRight -> Coercion -> Coercion
    mkLRCo LeftOrRight
    d1 (InScopeSet -> Coercion -> Coercion -> Coercion
    opt_trans InScopeSet
    is Coercion
    co1 Coercion
    co2)

    -- Push transitivity inside instantiation
    opt_trans_rule InScopeSet
    is in_co1 :: Coercion
    in_co1@(InstCo Coercion
    co1 Coercion
    ty1) in_co2 :: Coercion
    in_co2@(InstCo Coercion
    co2 Coercion
    ty2)
      | Coercion
    ty1 Coercion -> Coercion -> Bool
    `eqCoercion` Coercion
    ty2
      , Coercion
    co1 Coercion -> Coercion -> Bool
    `compatible_co` Coercion
    co2
      = String -> Coercion -> Coercion -> Coercion -> Maybe Coercion
    fireTransRule String
    "TrPushInst" Coercion
    in_co1 Coercion
    in_co2 (Coercion -> Maybe Coercion) -> Coercion -> Maybe Coercion
    forall a b. (a -> b) -> a -> b
    $
        Coercion -> Coercion -> Coercion
    mkInstCo (InScopeSet -> Coercion -> Coercion -> Coercion
    opt_trans InScopeSet
    is Coercion
    co1 Coercion
    co2) Coercion
    ty1

    opt_trans_rule InScopeSet
    is in_co1 :: Coercion
    in_co1@(UnivCo UnivCoProvenance
    p1 Role
    r1 Type
    tyl1 Type
    _tyr1)
                      in_co2 :: Coercion
    in_co2@(UnivCo UnivCoProvenance
    p2 Role
    r2 Type
    _tyl2 Type
    tyr2)
      | Just UnivCoProvenance
    prov' <- UnivCoProvenance -> UnivCoProvenance -> Maybe UnivCoProvenance
    opt_trans_prov UnivCoProvenance
    p1 UnivCoProvenance
    p2
      = Bool -> Maybe Coercion -> Maybe Coercion
    forall a. HasCallStack => Bool -> a -> a
    assert (Role
    r1 Role -> Role -> Bool
    forall a. Eq a => a -> a -> Bool
    == Role
    r2) (Maybe Coercion -> Maybe Coercion)
    -> Maybe Coercion -> Maybe Coercion
    forall a b. (a -> b) -> a -> b
    $
        String -> Coercion -> Coercion -> Coercion -> Maybe Coercion
    fireTransRule String
    "UnivCo" Coercion
    in_co1 Coercion
    in_co2 (Coercion -> Maybe Coercion) -> Coercion -> Maybe Coercion
    forall a b. (a -> b) -> a -> b
    $
        UnivCoProvenance -> Role -> Type -> Type -> Coercion
    mkUnivCo UnivCoProvenance
    prov' Role
    r1 Type
    tyl1 Type
    tyr2
      where
        -- if the provenances are different, opt'ing will be very confusing
        opt_trans_prov :: UnivCoProvenance -> UnivCoProvenance -> Maybe UnivCoProvenance
    opt_trans_prov (PhantomProv Coercion
    kco1)    (PhantomProv Coercion
    kco2)
          = UnivCoProvenance -> Maybe UnivCoProvenance
    forall a. a -> Maybe a
    Just (UnivCoProvenance -> Maybe UnivCoProvenance)
    -> UnivCoProvenance -> Maybe UnivCoProvenance
    forall a b. (a -> b) -> a -> b
    $ Coercion -> UnivCoProvenance
    PhantomProv (Coercion -> UnivCoProvenance) -> Coercion -> UnivCoProvenance
    forall a b. (a -> b) -> a -> b
    $ InScopeSet -> Coercion -> Coercion -> Coercion
    opt_trans InScopeSet
    is Coercion
    kco1 Coercion
    kco2
        opt_trans_prov (ProofIrrelProv Coercion
    kco1) (ProofIrrelProv Coercion
    kco2)
          = UnivCoProvenance -> Maybe UnivCoProvenance
    forall a. a -> Maybe a
    Just (UnivCoProvenance -> Maybe UnivCoProvenance)
    -> UnivCoProvenance -> Maybe UnivCoProvenance
    forall a b. (a -> b) -> a -> b
    $ Coercion -> UnivCoProvenance
    ProofIrrelProv (Coercion -> UnivCoProvenance) -> Coercion -> UnivCoProvenance
    forall a b. (a -> b) -> a -> b
    $ InScopeSet -> Coercion -> Coercion -> Coercion
    opt_trans InScopeSet
    is Coercion
    kco1 Coercion
    kco2
        opt_trans_prov (PluginProv String
    str1)     (PluginProv String
    str2)     | String
    str1 String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    == String
    str2 = UnivCoProvenance -> Maybe UnivCoProvenance
    forall a. a -> Maybe a
    Just UnivCoProvenance
    p1
        opt_trans_prov UnivCoProvenance
    _ UnivCoProvenance
    _ = Maybe UnivCoProvenance
    forall a. Maybe a
    Nothing

    -- Push transitivity down through matching top-level constructors.
    opt_trans_rule InScopeSet
    is in_co1 :: Coercion
    in_co1@(TyConAppCo Role
    r1 TyCon
    tc1 [Coercion]
    cos1) in_co2 :: Coercion
    in_co2@(TyConAppCo Role
    r2 TyCon
    tc2 [Coercion]
    cos2)
      | TyCon
    tc1 TyCon -> TyCon -> Bool
    forall a. Eq a => a -> a -> Bool
    == TyCon
    tc2
      = Bool -> Maybe Coercion -> Maybe Coercion
    forall a. HasCallStack => Bool -> a -> a
    assert (Role
    r1 Role -> Role -> Bool
    forall a. Eq a => a -> a -> Bool
    == Role
    r2) (Maybe Coercion -> Maybe Coercion)
    -> Maybe Coercion -> Maybe Coercion
    forall a b. (a -> b) -> a -> b
    $
        String -> Coercion -> Coercion -> Coercion -> Maybe Coercion
    fireTransRule String
    "PushTyConApp" Coercion
    in_co1 Coercion
    in_co2 (Coercion -> Maybe Coercion) -> Coercion -> Maybe Coercion
    forall a b. (a -> b) -> a -> b
    $
        HasDebugCallStack => Role -> TyCon -> [Coercion] -> Coercion
    Role -> TyCon -> [Coercion] -> Coercion
    mkTyConAppCo Role
    r1 TyCon
    tc1 (HasDebugCallStack =>
    InScopeSet -> [Coercion] -> [Coercion] -> [Coercion]
    InScopeSet -> [Coercion] -> [Coercion] -> [Coercion]
    opt_transList InScopeSet
    is [Coercion]
    cos1 [Coercion]
    cos2)

    opt_trans_rule InScopeSet
    is in_co1 :: Coercion
    in_co1@(FunCo Role
    r1 FunTyFlag
    afl1 FunTyFlag
    afr1 Coercion
    w1 Coercion
    co1a Coercion
    co1b)
                      in_co2 :: Coercion
    in_co2@(FunCo Role
    r2 FunTyFlag
    afl2 FunTyFlag
    afr2 Coercion
    w2 Coercion
    co2a Coercion
    co2b)
      = Bool -> Maybe Coercion -> Maybe Coercion
    forall a. HasCallStack => Bool -> a -> a
    assert (Role
    r1 Role -> Role -> Bool
    forall a. Eq a => a -> a -> Bool
    == Role
    r2)     (Maybe Coercion -> Maybe Coercion)
    -> Maybe Coercion -> Maybe Coercion
    forall a b. (a -> b) -> a -> b
    $     -- Just like the TyConAppCo/TyConAppCo case
        Bool -> Maybe Coercion -> Maybe Coercion
    forall a. HasCallStack => Bool -> a -> a
    assert (FunTyFlag
    afr1 FunTyFlag -> FunTyFlag -> Bool
    forall a. Eq a => a -> a -> Bool
    == FunTyFlag
    afl2) (Maybe Coercion -> Maybe Coercion)
    -> Maybe Coercion -> Maybe Coercion
    forall a b. (a -> b) -> a -> b
    $
        String -> Coercion -> Coercion -> Coercion -> Maybe Coercion
    fireTransRule String
    "PushFun" Coercion
    in_co1 Coercion
    in_co2 (Coercion -> Maybe Coercion) -> Coercion -> Maybe Coercion
    forall a b. (a -> b) -> a -> b
    $
        Role
    -> FunTyFlag
    -> FunTyFlag
    -> Coercion
    -> Coercion
    -> Coercion
    -> Coercion
    mkFunCo2 Role
    r1 FunTyFlag
    afl1 FunTyFlag
    afr2 (InScopeSet -> Coercion -> Coercion -> Coercion
    opt_trans InScopeSet
    is Coercion
    w1 Coercion
    w2)
                              (InScopeSet -> Coercion -> Coercion -> Coercion
    opt_trans InScopeSet
    is Coercion
    co1a Coercion
    co2a)
                              (InScopeSet -> Coercion -> Coercion -> Coercion
    opt_trans InScopeSet
    is Coercion
    co1b Coercion
    co2b)

    opt_trans_rule InScopeSet
    is in_co1 :: Coercion
    in_co1@(AppCo Coercion
    co1a Coercion
    co1b) in_co2 :: Coercion
    in_co2@(AppCo Coercion
    co2a Coercion
    co2b)
      -- Must call opt_trans_rule_app; see Note [EtaAppCo]
      = InScopeSet
    -> Coercion
    -> Coercion
    -> Coercion
    -> [Coercion]
    -> Coercion
    -> [Coercion]
    -> Maybe Coercion
    opt_trans_rule_app InScopeSet
    is Coercion
    in_co1 Coercion
    in_co2 Coercion
    co1a [Coercion
    co1b] Coercion
    co2a [Coercion
    co2b]

    -- Eta rules
    opt_trans_rule InScopeSet
    is co1 :: Coercion
    co1@(TyConAppCo Role
    r TyCon
    tc [Coercion]
    cos1) Coercion
    co2
      | Just [Coercion]
    cos2 <- TyCon -> Coercion -> Maybe [Coercion]
    etaTyConAppCo_maybe TyCon
    tc Coercion
    co2
      = String -> Coercion -> Coercion -> Coercion -> Maybe Coercion
    fireTransRule String
    "EtaCompL" Coercion
    co1 Coercion
    co2 (Coercion -> Maybe Coercion) -> Coercion -> Maybe Coercion
    forall a b. (a -> b) -> a -> b
    $
        HasDebugCallStack => Role -> TyCon -> [Coercion] -> Coercion
    Role -> TyCon -> [Coercion] -> Coercion
    mkTyConAppCo Role
    r TyCon
    tc (HasDebugCallStack =>
    InScopeSet -> [Coercion] -> [Coercion] -> [Coercion]
    InScopeSet -> [Coercion] -> [Coercion] -> [Coercion]
    opt_transList InScopeSet
    is [Coercion]
    cos1 [Coercion]
    cos2)

    opt_trans_rule InScopeSet
    is Coercion
    co1 co2 :: Coercion
    co2@(TyConAppCo Role
    r TyCon
    tc [Coercion]
    cos2)
      | Just [Coercion]
    cos1 <- TyCon -> Coercion -> Maybe [Coercion]
    etaTyConAppCo_maybe TyCon
    tc Coercion
    co1
      = String -> Coercion -> Coercion -> Coercion -> Maybe Coercion
    fireTransRule String
    "EtaCompR" Coercion
    co1 Coercion
    co2 (Coercion -> Maybe Coercion) -> Coercion -> Maybe Coercion
    forall a b. (a -> b) -> a -> b
    $
        HasDebugCallStack => Role -> TyCon -> [Coercion] -> Coercion
    Role -> TyCon -> [Coercion] -> Coercion
    mkTyConAppCo Role
    r TyCon
    tc (HasDebugCallStack =>
    InScopeSet -> [Coercion] -> [Coercion] -> [Coercion]
    InScopeSet -> [Coercion] -> [Coercion] -> [Coercion]
    opt_transList InScopeSet
    is [Coercion]
    cos1 [Coercion]
    cos2)

    opt_trans_rule InScopeSet
    is co1 :: Coercion
    co1@(AppCo Coercion
    co1a Coercion
    co1b) Coercion
    co2
      | Just (Coercion
    co2a,Coercion
    co2b) <- Coercion -> Maybe (Coercion, Coercion)
    etaAppCo_maybe Coercion
    co2
      = InScopeSet
    -> Coercion
    -> Coercion
    -> Coercion
    -> [Coercion]
    -> Coercion
    -> [Coercion]
    -> Maybe Coercion
    opt_trans_rule_app InScopeSet
    is Coercion
    co1 Coercion
    co2 Coercion
    co1a [Coercion
    co1b] Coercion
    co2a [Coercion
    co2b]

    opt_trans_rule InScopeSet
    is Coercion
    co1 co2 :: Coercion
    co2@(AppCo Coercion
    co2a Coercion
    co2b)
      | Just (Coercion
    co1a,Coercion
    co1b) <- Coercion -> Maybe (Coercion, Coercion)
    etaAppCo_maybe Coercion
    co1
      = InScopeSet
    -> Coercion
    -> Coercion
    -> Coercion
    -> [Coercion]
    -> Coercion
    -> [Coercion]
    -> Maybe Coercion
    opt_trans_rule_app InScopeSet
    is Coercion
    co1 Coercion
    co2 Coercion
    co1a [Coercion
    co1b] Coercion
    co2a [Coercion
    co2b]

    -- Push transitivity inside forall
    -- forall over types.
    opt_trans_rule InScopeSet
    is Coercion
    co1 Coercion
    co2
      | Just (CoVar
    tv1, ForAllTyFlag
    visL1, ForAllTyFlag
    _visR1, Coercion
    eta1, Coercion
    r1) <- Coercion
    -> Maybe (CoVar, ForAllTyFlag, ForAllTyFlag, Coercion, Coercion)
    splitForAllCo_ty_maybe Coercion
    co1
      , Just (CoVar
    tv2, ForAllTyFlag
    _visL2, ForAllTyFlag
    visR2, Coercion
    eta2, Coercion
    r2) <- Coercion
    -> Maybe (CoVar, ForAllTyFlag, ForAllTyFlag, Coercion, Coercion)
    etaForAllCo_ty_maybe Coercion
    co2
      = CoVar
    -> Coercion
    -> Coercion
    -> CoVar
    -> Coercion
    -> Coercion
    -> ForAllTyFlag
    -> ForAllTyFlag
    -> Maybe Coercion
    push_trans CoVar
    tv1 Coercion
    eta1 Coercion
    r1 CoVar
    tv2 Coercion
    eta2 Coercion
    r2 ForAllTyFlag
    visL1 ForAllTyFlag
    visR2

      | Just (CoVar
    tv2, ForAllTyFlag
    _visL2, ForAllTyFlag
    visR2, Coercion
    eta2, Coercion
    r2) <- Coercion
    -> Maybe (CoVar, ForAllTyFlag, ForAllTyFlag, Coercion, Coercion)
    splitForAllCo_ty_maybe Coercion
    co2
      , Just (CoVar
    tv1, ForAllTyFlag
    visL1, ForAllTyFlag
    _visR1, Coercion
    eta1, Coercion
    r1) <- Coercion
    -> Maybe (CoVar, ForAllTyFlag, ForAllTyFlag, Coercion, Coercion)
    etaForAllCo_ty_maybe Coercion
    co1
      = CoVar
    -> Coercion
    -> Coercion
    -> CoVar
    -> Coercion
    -> Coercion
    -> ForAllTyFlag
    -> ForAllTyFlag
    -> Maybe Coercion
    push_trans CoVar
    tv1 Coercion
    eta1 Coercion
    r1 CoVar
    tv2 Coercion
    eta2 Coercion
    r2 ForAllTyFlag
    visL1 ForAllTyFlag
    visR2

      where
      push_trans :: CoVar
    -> Coercion
    -> Coercion
    -> CoVar
    -> Coercion
    -> Coercion
    -> ForAllTyFlag
    -> ForAllTyFlag
    -> Maybe Coercion
    push_trans CoVar
    tv1 Coercion
    eta1 Coercion
    r1 CoVar
    tv2 Coercion
    eta2 Coercion
    r2 ForAllTyFlag
    visL ForAllTyFlag
    visR
        -- Given:
        --   co1 = /\ tv1 : eta1 <visL, visM>. r1
        --   co2 = /\ tv2 : eta2 <visM, visR>. r2
        -- Wanted:
        --   /\tv1 : (eta1;eta2) <visL, visR>.  (r1; r2[tv2 |-> tv1 |> eta1])
        = String -> Coercion -> Coercion -> Coercion -> Maybe Coercion
    fireTransRule String
    "EtaAllTy_ty" Coercion
    co1 Coercion
    co2 (Coercion -> Maybe Coercion) -> Coercion -> Maybe Coercion
    forall a b. (a -> b) -> a -> b
    $
          HasDebugCallStack =>
    CoVar
    -> ForAllTyFlag -> ForAllTyFlag -> Coercion -> Coercion -> Coercion
    CoVar
    -> ForAllTyFlag -> ForAllTyFlag -> Coercion -> Coercion -> Coercion
    mkForAllCo CoVar
    tv1 ForAllTyFlag
    visL ForAllTyFlag
    visR (InScopeSet -> Coercion -> Coercion -> Coercion
    opt_trans InScopeSet
    is Coercion
    eta1 Coercion
    eta2) (InScopeSet -> Coercion -> Coercion -> Coercion
    opt_trans InScopeSet
    is' Coercion
    r1 Coercion
    r2')
        where
          is' :: InScopeSet
    is' = InScopeSet
    is InScopeSet -> CoVar -> InScopeSet
    `extendInScopeSet` CoVar
    tv1
          r2' :: Coercion
    r2' = [CoVar] -> [Type] -> Coercion -> Coercion
    substCoWithUnchecked [CoVar
    tv2] [Type -> Coercion -> Type
    mkCastTy (CoVar -> Type
    TyVarTy CoVar
    tv1) Coercion
    eta1] Coercion
    r2

    -- Push transitivity inside forall
    -- forall over coercions.
    opt_trans_rule InScopeSet
    is Coercion
    co1 Coercion
    co2
      | Just (CoVar
    cv1, ForAllTyFlag
    visL1, ForAllTyFlag
    _visR1, Coercion
    eta1, Coercion
    r1) <- Coercion
    -> Maybe (CoVar, ForAllTyFlag, ForAllTyFlag, Coercion, Coercion)
    splitForAllCo_co_maybe Coercion
    co1
      , Just (CoVar
    cv2, ForAllTyFlag
    _visL2, ForAllTyFlag
    visR2, Coercion
    eta2, Coercion
    r2) <- Coercion
    -> Maybe (CoVar, ForAllTyFlag, ForAllTyFlag, Coercion, Coercion)
    etaForAllCo_co_maybe Coercion
    co2
      = CoVar
    -> Coercion
    -> Coercion
    -> CoVar
    -> Coercion
    -> Coercion
    -> ForAllTyFlag
    -> ForAllTyFlag
    -> Maybe Coercion
    push_trans CoVar
    cv1 Coercion
    eta1 Coercion
    r1 CoVar
    cv2 Coercion
    eta2 Coercion
    r2 ForAllTyFlag
    visL1 ForAllTyFlag
    visR2

      | Just (CoVar
    cv2, ForAllTyFlag
    _visL2, ForAllTyFlag
    visR2, Coercion
    eta2, Coercion
    r2) <- Coercion
    -> Maybe (CoVar, ForAllTyFlag, ForAllTyFlag, Coercion, Coercion)
    splitForAllCo_co_maybe Coercion
    co2
      , Just (CoVar
    cv1, ForAllTyFlag
    visL1, ForAllTyFlag
    _visR1, Coercion
    eta1, Coercion
    r1) <- Coercion
    -> Maybe (CoVar, ForAllTyFlag, ForAllTyFlag, Coercion, Coercion)
    etaForAllCo_co_maybe Coercion
    co1
      = CoVar
    -> Coercion
    -> Coercion
    -> CoVar
    -> Coercion
    -> Coercion
    -> ForAllTyFlag
    -> ForAllTyFlag
    -> Maybe Coercion
    push_trans CoVar
    cv1 Coercion
    eta1 Coercion
    r1 CoVar
    cv2 Coercion
    eta2 Coercion
    r2 ForAllTyFlag
    visL1 ForAllTyFlag
    visR2

      where
      push_trans :: CoVar
    -> Coercion
    -> Coercion
    -> CoVar
    -> Coercion
    -> Coercion
    -> ForAllTyFlag
    -> ForAllTyFlag
    -> Maybe Coercion
    push_trans CoVar
    cv1 Coercion
    eta1 Coercion
    r1 CoVar
    cv2 Coercion
    eta2 Coercion
    r2 ForAllTyFlag
    visL ForAllTyFlag
    visR
        -- Given:
        --   co1 = /\ (cv1 : eta1) <visL, visM>. r1
        --   co2 = /\ (cv2 : eta2) <visM, visR>. r2
        -- Wanted:
        --   n1 = nth 2 eta1
        --   n2 = nth 3 eta1
        --   nco = /\ cv1 : (eta1;eta2). (r1; r2[cv2 |-> (sym n1);cv1;n2])
        = String -> Coercion -> Coercion -> Coercion -> Maybe Coercion
    fireTransRule String
    "EtaAllTy_co" Coercion
    co1 Coercion
    co2 (Coercion -> Maybe Coercion) -> Coercion -> Maybe Coercion
    forall a b. (a -> b) -> a -> b
    $
          HasDebugCallStack =>
    CoVar
    -> ForAllTyFlag -> ForAllTyFlag -> Coercion -> Coercion -> Coercion
    CoVar
    -> ForAllTyFlag -> ForAllTyFlag -> Coercion -> Coercion -> Coercion
    mkForAllCo CoVar
    cv1 ForAllTyFlag
    visL ForAllTyFlag
    visR (InScopeSet -> Coercion -> Coercion -> Coercion
    opt_trans InScopeSet
    is Coercion
    eta1 Coercion
    eta2) (InScopeSet -> Coercion -> Coercion -> Coercion
    opt_trans InScopeSet
    is' Coercion
    r1 Coercion
    r2')
        where
          is' :: InScopeSet
    is'  = InScopeSet
    is InScopeSet -> CoVar -> InScopeSet
    `extendInScopeSet` CoVar
    cv1
          role :: Role
    role = CoVar -> Role
    coVarRole CoVar
    cv1
          eta1' :: Coercion
    eta1' = Role -> Role -> Coercion -> Coercion
    downgradeRole Role
    role Role
    Nominal Coercion
    eta1
          n1 :: Coercion
    n1   = HasDebugCallStack => CoSel -> Coercion -> Coercion
    CoSel -> Coercion -> Coercion
    mkSelCo (Int -> Role -> CoSel
    SelTyCon Int
    2 Role
    role) Coercion
    eta1'
          n2 :: Coercion
    n2   = HasDebugCallStack => CoSel -> Coercion -> Coercion
    CoSel -> Coercion -> Coercion
    mkSelCo (Int -> Role -> CoSel
    SelTyCon Int
    3 Role
    role) Coercion
    eta1'
          r2' :: Coercion
    r2'  = HasDebugCallStack => Subst -> Coercion -> Coercion
    Subst -> Coercion -> Coercion
    substCo ([CoVar] -> [Coercion] -> Subst
    HasDebugCallStack => [CoVar] -> [Coercion] -> Subst
    zipCvSubst [CoVar
    cv2] [(Coercion -> Coercion
    mkSymCo Coercion
    n1) Coercion -> Coercion -> Coercion
    `mkTransCo`
                                            (CoVar -> Coercion
    mkCoVarCo CoVar
    cv1) Coercion -> Coercion -> Coercion
    `mkTransCo` Coercion
    n2])
                        Coercion
    r2

    -- Push transitivity inside axioms
    opt_trans_rule InScopeSet
    is Coercion
    co1 Coercion
    co2

      -- See Note [Push transitivity inside axioms] and
      -- Note [Push transitivity inside newtype axioms only]
      -- TrPushSymAxR
      | Just (Bool
    sym, CoAxiom Branched
    con, Int
    ind, [Coercion]
    cos1) <- Maybe (Bool, CoAxiom Branched, Int, [Coercion])
    co1_is_axiom_maybe
      , TyCon -> Bool
    isNewTyCon (CoAxiom Branched -> TyCon
    forall (br :: BranchFlag). CoAxiom br -> TyCon
    coAxiomTyCon CoAxiom Branched
    con)
      , Bool
    True <- Bool
    sym
      , Just [Coercion]
    cos2 <- Bool -> CoAxiom Branched -> Int -> Coercion -> Maybe [Coercion]
    forall (br :: BranchFlag).
    Bool -> CoAxiom br -> Int -> Coercion -> Maybe [Coercion]
    matchAxiom Bool
    sym CoAxiom Branched
    con Int
    ind Coercion
    co2
      , let newAxInst :: Coercion
    newAxInst = CoAxiom Branched -> Int -> [Coercion] -> Coercion
    AxiomInstCo CoAxiom Branched
    con Int
    ind (HasDebugCallStack =>
    InScopeSet -> [Coercion] -> [Coercion] -> [Coercion]
    InScopeSet -> [Coercion] -> [Coercion] -> [Coercion]
    opt_transList InScopeSet
    is ((Coercion -> Coercion) -> [Coercion] -> [Coercion]
    forall a b. (a -> b) -> [a] -> [b]
    map Coercion -> Coercion
    mkSymCo [Coercion]
    cos2) [Coercion]
    cos1)
      = String -> Coercion -> Coercion -> Coercion -> Maybe Coercion
    fireTransRule String
    "TrPushSymAxR" Coercion
    co1 Coercion
    co2 (Coercion -> Maybe Coercion) -> Coercion -> Maybe Coercion
    forall a b. (a -> b) -> a -> b
    $ Coercion -> Coercion
    SymCo Coercion
    newAxInst

      -- TrPushAxR
      | Just (Bool
    sym, CoAxiom Branched
    con, Int
    ind, [Coercion]
    cos1) <- Maybe (Bool, CoAxiom Branched, Int, [Coercion])
    co1_is_axiom_maybe
      , TyCon -> Bool
    isNewTyCon (CoAxiom Branched -> TyCon
    forall (br :: BranchFlag). CoAxiom br -> TyCon
    coAxiomTyCon CoAxiom Branched
    con)
      , Bool
    False <- Bool
    sym
      , Just [Coercion]
    cos2 <- Bool -> CoAxiom Branched -> Int -> Coercion -> Maybe [Coercion]
    forall (br :: BranchFlag).
    Bool -> CoAxiom br -> Int -> Coercion -> Maybe [Coercion]
    matchAxiom Bool
    sym CoAxiom Branched
    con Int
    ind Coercion
    co2
      , let newAxInst :: Coercion
    newAxInst = CoAxiom Branched -> Int -> [Coercion] -> Coercion
    AxiomInstCo CoAxiom Branched
    con Int
    ind (HasDebugCallStack =>
    InScopeSet -> [Coercion] -> [Coercion] -> [Coercion]
    InScopeSet -> [Coercion] -> [Coercion] -> [Coercion]
    opt_transList InScopeSet
    is [Coercion]
    cos1 [Coercion]
    cos2)
      = String -> Coercion -> Coercion -> Coercion -> Maybe Coercion
    fireTransRule String
    "TrPushAxR" Coercion
    co1 Coercion
    co2 Coercion
    newAxInst

      -- TrPushSymAxL
      | Just (Bool
    sym, CoAxiom Branched
    con, Int
    ind, [Coercion]
    cos2) <- Maybe (Bool, CoAxiom Branched, Int, [Coercion])
    co2_is_axiom_maybe
      , TyCon -> Bool
    isNewTyCon (CoAxiom Branched -> TyCon
    forall (br :: BranchFlag). CoAxiom br -> TyCon
    coAxiomTyCon CoAxiom Branched
    con)
      , Bool
    True <- Bool
    sym
      , Just [Coercion]
    cos1 <- Bool -> CoAxiom Branched -> Int -> Coercion -> Maybe [Coercion]
    forall (br :: BranchFlag).
    Bool -> CoAxiom br -> Int -> Coercion -> Maybe [Coercion]
    matchAxiom (Bool -> Bool
    not Bool
    sym) CoAxiom Branched
    con Int
    ind Coercion
    co1
      , let newAxInst :: Coercion
    newAxInst = CoAxiom Branched -> Int -> [Coercion] -> Coercion
    AxiomInstCo CoAxiom Branched
    con Int
    ind (HasDebugCallStack =>
    InScopeSet -> [Coercion] -> [Coercion] -> [Coercion]
    InScopeSet -> [Coercion] -> [Coercion] -> [Coercion]
    opt_transList InScopeSet
    is [Coercion]
    cos2 ((Coercion -> Coercion) -> [Coercion] -> [Coercion]
    forall a b. (a -> b) -> [a] -> [b]
    map Coercion -> Coercion
    mkSymCo [Coercion]
    cos1))
      = String -> Coercion -> Coercion -> Coercion -> Maybe Coercion
    fireTransRule String
    "TrPushSymAxL" Coercion
    co1 Coercion
    co2 (Coercion -> Maybe Coercion) -> Coercion -> Maybe Coercion
    forall a b. (a -> b) -> a -> b
    $ Coercion -> Coercion
    SymCo Coercion
    newAxInst

      -- TrPushAxL
      | Just (Bool
    sym, CoAxiom Branched
    con, Int
    ind, [Coercion]
    cos2) <- Maybe (Bool, CoAxiom Branched, Int, [Coercion])
    co2_is_axiom_maybe
      , TyCon -> Bool
    isNewTyCon (CoAxiom Branched -> TyCon
    forall (br :: BranchFlag). CoAxiom br -> TyCon
    coAxiomTyCon CoAxiom Branched
    con)
      , Bool
    False <- Bool
    sym
      , Just [Coercion]
    cos1 <- Bool -> CoAxiom Branched -> Int -> Coercion -> Maybe [Coercion]
    forall (br :: BranchFlag).
    Bool -> CoAxiom br -> Int -> Coercion -> Maybe [Coercion]
    matchAxiom (Bool -> Bool
    not Bool
    sym) CoAxiom Branched
    con Int
    ind Coercion
    co1
      , let newAxInst :: Coercion
    newAxInst = CoAxiom Branched -> Int -> [Coercion] -> Coercion
    AxiomInstCo CoAxiom Branched
    con Int
    ind (HasDebugCallStack =>
    InScopeSet -> [Coercion] -> [Coercion] -> [Coercion]
    InScopeSet -> [Coercion] -> [Coercion] -> [Coercion]
    opt_transList InScopeSet
    is [Coercion]
    cos1 [Coercion]
    cos2)
      = String -> Coercion -> Coercion -> Coercion -> Maybe Coercion
    fireTransRule String
    "TrPushAxL" Coercion
    co1 Coercion
    co2 Coercion
    newAxInst

      -- TrPushAxSym/TrPushSymAx
      | Just (Bool
    sym1, CoAxiom Branched
    con1, Int
    ind1, [Coercion]
    cos1) <- Maybe (Bool, CoAxiom Branched, Int, [Coercion])
    co1_is_axiom_maybe
      , Just (Bool
    sym2, CoAxiom Branched
    con2, Int
    ind2, [Coercion]
    cos2) <- Maybe (Bool, CoAxiom Branched, Int, [Coercion])
    co2_is_axiom_maybe
      , CoAxiom Branched
    con1 CoAxiom Branched -> CoAxiom Branched -> Bool
    forall a. Eq a => a -> a -> Bool
    == CoAxiom Branched
    con2
      , Int
    ind1 Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    ind2
      , Bool
    sym1 Bool -> Bool -> Bool
    forall a. Eq a => a -> a -> Bool
    == Bool -> Bool
    not Bool
    sym2
      , let branch :: CoAxBranch
    branch = CoAxiom Branched -> Int -> CoAxBranch
    forall (br :: BranchFlag). CoAxiom br -> Int -> CoAxBranch
    coAxiomNthBranch CoAxiom Branched
    con1 Int
    ind1
            qtvs :: [CoVar]
    qtvs = CoAxBranch -> [CoVar]
    coAxBranchTyVars CoAxBranch
    branch [CoVar] -> [CoVar] -> [CoVar]
    forall a. [a] -> [a] -> [a]
    ++ CoAxBranch -> [CoVar]
    coAxBranchCoVars CoAxBranch
    branch
            lhs :: Type
    lhs  = CoAxiom Branched -> Int -> Type
    forall (br :: BranchFlag). CoAxiom br -> Int -> Type
    coAxNthLHS CoAxiom Branched
    con1 Int
    ind1
            rhs :: Type
    rhs  = CoAxBranch -> Type
    coAxBranchRHS CoAxBranch
    branch
            pivot_tvs :: UniqSet CoVar
    pivot_tvs = Type -> UniqSet CoVar
    exactTyCoVarsOfType (if Bool
    sym2 then Type
    rhs else Type
    lhs)
      , (CoVar -> Bool) -> [CoVar] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    all (CoVar -> UniqSet CoVar -> Bool
    `elemVarSet` UniqSet CoVar
    pivot_tvs) [CoVar]
    qtvs
      = String -> Coercion -> Coercion -> Coercion -> Maybe Coercion
    fireTransRule String
    "TrPushAxSym" Coercion
    co1 Coercion
    co2 (Coercion -> Maybe Coercion) -> Coercion -> Maybe Coercion
    forall a b. (a -> b) -> a -> b
    $
        if Bool
    sym2
           -- TrPushAxSym
        then Role -> [CoVar] -> [Coercion] -> Type -> Coercion
    liftCoSubstWith Role
    role [CoVar]
    qtvs (HasDebugCallStack =>
    InScopeSet -> [Coercion] -> [Coercion] -> [Coercion]
    InScopeSet -> [Coercion] -> [Coercion] -> [Coercion]
    opt_transList InScopeSet
    is [Coercion]
    cos1 ((Coercion -> Coercion) -> [Coercion] -> [Coercion]
    forall a b. (a -> b) -> [a] -> [b]
    map Coercion -> Coercion
    mkSymCo [Coercion]
    cos2)) Type
    lhs
           -- TrPushSymAx
        else Role -> [CoVar] -> [Coercion] -> Type -> Coercion
    liftCoSubstWith Role
    role [CoVar]
    qtvs (HasDebugCallStack =>
    InScopeSet -> [Coercion] -> [Coercion] -> [Coercion]
    InScopeSet -> [Coercion] -> [Coercion] -> [Coercion]
    opt_transList InScopeSet
    is ((Coercion -> Coercion) -> [Coercion] -> [Coercion]
    forall a b. (a -> b) -> [a] -> [b]
    map Coercion -> Coercion
    mkSymCo [Coercion]
    cos1) [Coercion]
    cos2) Type
    rhs
      where
        co1_is_axiom_maybe :: Maybe (Bool, CoAxiom Branched, Int, [Coercion])
    co1_is_axiom_maybe = Coercion -> Maybe (Bool, CoAxiom Branched, Int, [Coercion])
    isAxiom_maybe Coercion
    co1
        co2_is_axiom_maybe :: Maybe (Bool, CoAxiom Branched, Int, [Coercion])
    co2_is_axiom_maybe = Coercion -> Maybe (Bool, CoAxiom Branched, Int, [Coercion])
    isAxiom_maybe Coercion
    co2
        role :: Role
    role = Coercion -> Role
    coercionRole Coercion
    co1 -- should be the same as coercionRole co2!

    opt_trans_rule InScopeSet
    _ Coercion
    co1 Coercion
    co2        -- Identity rule
      | let ty1 :: Type
    ty1 = Coercion -> Type
    coercionLKind Coercion
    co1
            r :: Role
    r   = Coercion -> Role
    coercionRole Coercion
    co1
            ty2 :: Type
    ty2 = Coercion -> Type
    coercionRKind Coercion
    co2
      , Type
    ty1 Type -> Type -> Bool
    `eqType` Type
    ty2
      = String -> Coercion -> Coercion -> Coercion -> Maybe Coercion
    fireTransRule String
    "RedTypeDirRefl" Coercion
    co1 Coercion
    co2 (Coercion -> Maybe Coercion) -> Coercion -> Maybe Coercion
    forall a b. (a -> b) -> a -> b
    $
        Role -> Type -> Coercion
    mkReflCo Role
    r Type
    ty2

    opt_trans_rule InScopeSet
    _ Coercion
    _ Coercion
    _ = Maybe Coercion
    forall a. Maybe a
    Nothing

    -- See Note [EtaAppCo]
    opt_trans_rule_app :: InScopeSet
                       -> Coercion   -- original left-hand coercion (printing only)
                       -> Coercion   -- original right-hand coercion (printing only)
                       -> Coercion   -- left-hand coercion "function"
                       -> [Coercion] -- left-hand coercion "args"
                       -> Coercion   -- right-hand coercion "function"
                       -> [Coercion] -- right-hand coercion "args"
                       -> Maybe Coercion
    opt_trans_rule_app :: InScopeSet
    -> Coercion
    -> Coercion
    -> Coercion
    -> [Coercion]
    -> Coercion
    -> [Coercion]
    -> Maybe Coercion
    opt_trans_rule_app InScopeSet
    is Coercion
    orig_co1 Coercion
    orig_co2 Coercion
    co1a [Coercion]
    co1bs Coercion
    co2a [Coercion]
    co2bs
      | AppCo Coercion
    co1aa Coercion
    co1ab <- Coercion
    co1a
      , Just (Coercion
    co2aa, Coercion
    co2ab) <- Coercion -> Maybe (Coercion, Coercion)
    etaAppCo_maybe Coercion
    co2a
      = InScopeSet
    -> Coercion
    -> Coercion
    -> Coercion
    -> [Coercion]
    -> Coercion
    -> [Coercion]
    -> Maybe Coercion
    opt_trans_rule_app InScopeSet
    is Coercion
    orig_co1 Coercion
    orig_co2 Coercion
    co1aa (Coercion
    co1abCoercion -> [Coercion] -> [Coercion]
    forall a. a -> [a] -> [a]
    :[Coercion]
    co1bs) Coercion
    co2aa (Coercion
    co2abCoercion -> [Coercion] -> [Coercion]
    forall a. a -> [a] -> [a]
    :[Coercion]
    co2bs)

      | AppCo Coercion
    co2aa Coercion
    co2ab <- Coercion
    co2a
      , Just (Coercion
    co1aa, Coercion
    co1ab) <- Coercion -> Maybe (Coercion, Coercion)
    etaAppCo_maybe Coercion
    co1a
      = InScopeSet
    -> Coercion
    -> Coercion
    -> Coercion
    -> [Coercion]
    -> Coercion
    -> [Coercion]
    -> Maybe Coercion
    opt_trans_rule_app InScopeSet
    is Coercion
    orig_co1 Coercion
    orig_co2 Coercion
    co1aa (Coercion
    co1abCoercion -> [Coercion] -> [Coercion]
    forall a. a -> [a] -> [a]
    :[Coercion]
    co1bs) Coercion
    co2aa (Coercion
    co2abCoercion -> [Coercion] -> [Coercion]
    forall a. a -> [a] -> [a]
    :[Coercion]
    co2bs)

      | Bool
    otherwise
      = Bool -> Maybe Coercion -> Maybe Coercion
    forall a. HasCallStack => Bool -> a -> a
    assert ([Coercion]
    co1bs [Coercion] -> [Coercion] -> Bool
    forall a b. [a] -> [b] -> Bool
    `equalLength` [Coercion]
    co2bs) (Maybe Coercion -> Maybe Coercion)
    -> Maybe Coercion -> Maybe Coercion
    forall a b. (a -> b) -> a -> b
    $
        String -> Coercion -> Coercion -> Coercion -> Maybe Coercion
    fireTransRule (String
    "EtaApps:" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Int -> String
    forall a. Show a => a -> String
    show ([Coercion] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [Coercion]
    co1bs)) Coercion
    orig_co1 Coercion
    orig_co2 (Coercion -> Maybe Coercion) -> Coercion -> Maybe Coercion
    forall a b. (a -> b) -> a -> b
    $
        let rt1a :: Type
    rt1a = Coercion -> Type
    coercionRKind Coercion
    co1a

            lt2a :: Type
    lt2a = Coercion -> Type
    coercionLKind Coercion
    co2a
            rt2a :: Role
    rt2a = Coercion -> Role
    coercionRole  Coercion
    co2a

            rt1bs :: [Type]
    rt1bs = (Coercion -> Type) -> [Coercion] -> [Type]
    forall a b. (a -> b) -> [a] -> [b]
    map Coercion -> Type
    coercionRKind [Coercion]
    co1bs
            lt2bs :: [Type]
    lt2bs = (Coercion -> Type) -> [Coercion] -> [Type]
    forall a b. (a -> b) -> [a] -> [b]
    map Coercion -> Type
    coercionLKind [Coercion]
    co2bs
            rt2bs :: [Role]
    rt2bs = (Coercion -> Role) -> [Coercion] -> [Role]
    forall a b. (a -> b) -> [a] -> [b]
    map Coercion -> Role
    coercionRole [Coercion]
    co2bs

            kcoa :: Coercion
    kcoa = Coercion -> Coercion
    mkKindCo (Coercion -> Coercion) -> Coercion -> Coercion
    forall a b. (a -> b) -> a -> b
    $ Type -> Type -> Coercion
    buildCoercion Type
    lt2a Type
    rt1a
            kcobs :: [Coercion]
    kcobs = (Coercion -> Coercion) -> [Coercion] -> [Coercion]
    forall a b. (a -> b) -> [a] -> [b]
    map Coercion -> Coercion
    mkKindCo ([Coercion] -> [Coercion]) -> [Coercion] -> [Coercion]
    forall a b. (a -> b) -> a -> b
    $ (Type -> Type -> Coercion) -> [Type] -> [Type] -> [Coercion]
    forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
    zipWith Type -> Type -> Coercion
    buildCoercion [Type]
    lt2bs [Type]
    rt1bs

            co2a' :: Coercion
    co2a'   = Role -> Type -> Coercion -> Coercion -> Coercion
    mkCoherenceLeftCo Role
    rt2a Type
    lt2a Coercion
    kcoa Coercion
    co2a
            co2bs' :: [Coercion]
    co2bs'  = (Role -> Type -> Coercion -> Coercion)
    -> [Role] -> [Type] -> [Coercion] -> [Coercion]
    forall a b c d. (a -> b -> c -> d) -> [a] -> [b] -> [c] -> [d]
    zipWith3 Role -> Type -> Coercion -> Coercion
    mkGReflLeftCo [Role]
    rt2bs [Type]
    lt2bs [Coercion]
    kcobs
            co2bs'' :: [Coercion]
    co2bs'' = (Coercion -> Coercion -> Coercion)
    -> [Coercion] -> [Coercion] -> [Coercion]
    forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
    zipWith Coercion -> Coercion -> Coercion
    mkTransCo [Coercion]
    co2bs' [Coercion]
    co2bs
        in
        Coercion -> [Coercion] -> Coercion
    mkAppCos (InScopeSet -> Coercion -> Coercion -> Coercion
    opt_trans InScopeSet
    is Coercion
    co1a Coercion
    co2a')
                 ((Coercion -> Coercion -> Coercion)
    -> [Coercion] -> [Coercion] -> [Coercion]
    forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
    zipWith (InScopeSet -> Coercion -> Coercion -> Coercion
    opt_trans InScopeSet
    is) [Coercion]
    co1bs [Coercion]
    co2bs'')

    fireTransRule :: String -> Coercion -> Coercion -> Coercion -> Maybe Coercion
    fireTransRule :: String -> Coercion -> Coercion -> Coercion -> Maybe Coercion
    fireTransRule String
    _rule Coercion
    _co1 Coercion
    _co2 Coercion
    res
      = Coercion -> Maybe Coercion
    forall a. a -> Maybe a
    Just Coercion
    res

    {-
    Note [Push transitivity inside axioms]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    opt_trans_rule tries to push transitivity inside axioms to deal with cases like
    the following:

        newtype N a = MkN a

        axN :: N a ~R# a

        covar :: a ~R# b
        co1 = axN <a> :: N a ~R# a
        co2 = axN <b> :: N b ~R# b

        co :: a ~R# b
        co = sym co1 ; N covar ; co2

    When we are optimising co, we want to notice that the two axiom instantiations
    cancel out. This is implemented by rules such as TrPushSymAxR, which transforms
        sym (axN <a>) ; N covar
    into
        sym (axN covar)
    so that TrPushSymAx can subsequently transform
        sym (axN covar) ; axN <b>
    into
        covar
    which is much more compact. In some perf test cases this kind of pattern can be
    generated repeatedly during simplification, so it is very important we squash it
    to stop coercions growing exponentially.  For more details see the paper:

        Evidence normalisation in System FC
        Dimitrios Vytiniotis and Simon Peyton Jones
        RTA'13, 2013
        https://www.microsoft.com/en-us/research/publication/evidence-normalization-system-fc-2/

    Note [Push transitivity inside newtype axioms only]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    The optimization described in Note [Push transitivity inside axioms] is possible
    for both newtype and type family axioms.  However, for type family axioms it is
    relatively common to have transitive sequences of axioms instantiations, for
    example:

        data Nat = Zero | Suc Nat

        type family Index (n :: Nat) (xs :: [Type]) :: Type where
          Index Zero    (x : xs) = x
          Index (Suc n) (x : xs) = Index n xs

        axIndex :: { forall x::Type. forall xs::[Type]. Index Zero (x : xs) ~ x
                   ; forall n::Nat. forall x::Type. forall xs::[Type]. Index (Suc n) (x : xs) ~ Index n xs }

        co :: Index (Suc (Suc Zero)) [a, b, c] ~ c
        co = axIndex[1] <Suc Zero> <a> <[b, c]>
           ; axIndex[1] <Zero> <b> <[c]>
           ; axIndex[0] <c> <[]>

    Not only are there no cancellation opportunities here, but calling matchAxiom
    repeatedly down the transitive chain is very expensive.  Hence we do not attempt
    to push transitivity inside type family axioms.  See #8095, !9210 and related tickets.

    This is implemented by opt_trans_rule checking that the axiom is for a newtype
    constructor (i.e. not a type family).  Adding these guards substantially
    improved performance (reduced bytes allocated by more than 10%) for the tests
    CoOpt_Singletons, LargeRecord, T12227, T12545, T13386, T15703, T5030, T8095.

    A side benefit is that we do not risk accidentally creating an ill-typed
    coercion; see Note [Why call checkAxInstCo during optimisation].

    There may exist programs that previously relied on pushing transitivity inside
    type family axioms to avoid creating huge coercions, which will regress in
    compile time performance as a result of this change.  We do not currently know
    of any examples, but if any come to light we may need to reconsider this
    behaviour.

    Note [Why call checkAxInstCo during optimisation]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    NB: The following is no longer relevant, because we no longer push transitivity
    into type family axioms (Note [Push transitivity inside newtype axioms only]).
    It is retained for reference in case we change this behaviour in the future.

    It is possible that otherwise-good-looking optimisations meet with disaster
    in the presence of axioms with multiple equations. Consider

    type family Equal (a :: *) (b :: *) :: Bool where
      Equal a a = True
      Equal a b = False
    type family Id (a :: *) :: * where
      Id a = a

    axEq :: { [a::*].       Equal a a ~ True
            ; [a::*, b::*]. Equal a b ~ False }
    axId :: [a::*]. Id a ~ a

    co1 = Equal (axId[0] Int) (axId[0] Bool)
      :: Equal (Id Int) (Id Bool) ~  Equal Int Bool
    co2 = axEq[1] <Int> <Bool>
      :: Equal Int Bool ~ False

    We wish to optimise (co1 ; co2). We end up in rule TrPushAxL, noting that
    co2 is an axiom and that matchAxiom succeeds when looking at co1. But, what
    happens when we push the coercions inside? We get

    co3 = axEq[1] (axId[0] Int) (axId[0] Bool)
      :: Equal (Id Int) (Id Bool) ~ False

    which is bogus! This is because the type system isn't smart enough to know
    that (Id Int) and (Id Bool) are Surely Apart, as they're headed by type
    families. At the time of writing, I (Richard Eisenberg) couldn't think of
    a way of detecting this any more efficient than just building the optimised
    coercion and checking.

    Note [EtaAppCo]
    ~~~~~~~~~~~~~~~
    Suppose we're trying to optimize (co1a co1b ; co2a co2b). Ideally, we'd
    like to rewrite this to (co1a ; co2a) (co1b ; co2b). The problem is that
    the resultant coercions might not be well kinded. Here is an example (things
    labeled with x don't matter in this example):

      k1 :: Type
      k2 :: Type

      a :: k1 -> Type
      b :: k1

      h :: k1 ~ k2

      co1a :: x1 ~ (a |> (h -> <Type>)
      co1b :: x2 ~ (b |> h)

      co2a :: a ~ x3
      co2b :: b ~ x4

    First, convince yourself of the following:

      co1a co1b :: x1 x2 ~ (a |> (h -> <Type>)) (b |> h)
      co2a co2b :: a b   ~ x3 x4

      (a |> (h -> <Type>)) (b |> h) `eqType` a b

    That last fact is due to Note [Non-trivial definitional equality] in GHC.Core.TyCo.Rep,
    where we ignore coercions in types as long as two types' kinds are the same.
    In our case, we meet this last condition, because

      (a |> (h -> <Type>)) (b |> h) :: Type
        and
      a b :: Type

    So the input coercion (co1a co1b ; co2a co2b) is well-formed. But the
    suggested output coercions (co1a ; co2a) and (co1b ; co2b) are not -- the
    kinds don't match up.

    The solution here is to twiddle the kinds in the output coercions. First, we
    need to find coercions

      ak :: kind(a |> (h -> <Type>)) ~ kind(a)
      bk :: kind(b |> h)             ~ kind(b)

    This can be done with mkKindCo and buildCoercion. The latter assumes two
    types are identical modulo casts and builds a coercion between them.

    Then, we build (co1a ; co2a |> sym ak) and (co1b ; co2b |> sym bk) as the
    output coercions. These are well-kinded.

    Also, note that all of this is done after accumulated any nested AppCo
    parameters. This step is to avoid quadratic behavior in calling coercionKind.

    The problem described here was first found in dependent/should_compile/dynamic-paper.

    -}

    -----------
    swapSym :: SymFlag -> (a,a) -> (a,a)
    swapSym :: forall a. Bool -> (a, a) -> (a, a)
    swapSym Bool
    sym (a
    x,a
    y) | Bool
    sym       = (a
    y,a
    x)
                      | Bool
    otherwise = (a
    x,a
    y)

    wrapSym :: SymFlag -> Coercion -> Coercion
    wrapSym :: Bool -> Coercion -> Coercion
    wrapSym Bool
    sym Coercion
    co | Bool
    sym       = Coercion -> Coercion
    mkSymCo Coercion
    co
                   | Bool
    otherwise = Coercion
    co

    -- | Conditionally set a role to be representational
    wrapRole :: ReprFlag
             -> Role         -- ^ current role
             -> Coercion -> Coercion
    wrapRole :: Bool -> Role -> Coercion -> Coercion
    wrapRole Bool
    False Role
    _       = Coercion -> Coercion
    forall a. a -> a
    id
    wrapRole Bool
    True  Role
    current = Role -> Role -> Coercion -> Coercion
    downgradeRole Role
    Representational Role
    current

    -- | If we require a representational role, return that. Otherwise,
    -- return the "default" role provided.
    chooseRole :: ReprFlag
               -> Role    -- ^ "default" role
               -> Role
    chooseRole :: Bool -> Role -> Role
    chooseRole Bool
    True Role
    _ = Role
    Representational
    chooseRole Bool
    _    Role
    r = Role
    r

    -----------
    isAxiom_maybe :: Coercion -> Maybe (Bool, CoAxiom Branched, Int, [Coercion])
    isAxiom_maybe :: Coercion -> Maybe (Bool, CoAxiom Branched, Int, [Coercion])
    isAxiom_maybe (SymCo Coercion
    co)
      | Just (Bool
    sym, CoAxiom Branched
    con, Int
    ind, [Coercion]
    cos) <- Coercion -> Maybe (Bool, CoAxiom Branched, Int, [Coercion])
    isAxiom_maybe Coercion
    co
      = (Bool, CoAxiom Branched, Int, [Coercion])
    -> Maybe (Bool, CoAxiom Branched, Int, [Coercion])
    forall a. a -> Maybe a
    Just (Bool -> Bool
    not Bool
    sym, CoAxiom Branched
    con, Int
    ind, [Coercion]
    cos)
    isAxiom_maybe (AxiomInstCo CoAxiom Branched
    con Int
    ind [Coercion]
    cos)
      = (Bool, CoAxiom Branched, Int, [Coercion])
    -> Maybe (Bool, CoAxiom Branched, Int, [Coercion])
    forall a. a -> Maybe a
    Just (Bool
    False, CoAxiom Branched
    con, Int
    ind, [Coercion]
    cos)
    isAxiom_maybe Coercion
    _ = Maybe (Bool, CoAxiom Branched, Int, [Coercion])
    forall a. Maybe a
    Nothing

    matchAxiom :: Bool -- True = match LHS, False = match RHS
               -> CoAxiom br -> Int -> Coercion -> Maybe [Coercion]
    matchAxiom :: forall (br :: BranchFlag).
    Bool -> CoAxiom br -> Int -> Coercion -> Maybe [Coercion]
    matchAxiom Bool
    sym ax :: CoAxiom br
    ax@(CoAxiom { co_ax_tc :: forall (br :: BranchFlag). CoAxiom br -> TyCon
    co_ax_tc = TyCon
    tc }) Int
    ind Coercion
    co
      | CoAxBranch { cab_tvs :: CoAxBranch -> [CoVar]
    cab_tvs = [CoVar]
    qtvs
                   , cab_cvs :: CoAxBranch -> [CoVar]
    cab_cvs = []   -- can't infer these, so fail if there are any
                   , cab_roles :: CoAxBranch -> [Role]
    cab_roles = [Role]
    roles
                   , cab_lhs :: CoAxBranch -> [Type]
    cab_lhs = [Type]
    lhs
                   , cab_rhs :: CoAxBranch -> Type
    cab_rhs = Type
    rhs } <- CoAxiom br -> Int -> CoAxBranch
    forall (br :: BranchFlag). CoAxiom br -> Int -> CoAxBranch
    coAxiomNthBranch CoAxiom br
    ax Int
    ind
      , Just LiftingContext
    subst <- UniqSet CoVar -> Type -> Coercion -> Maybe LiftingContext
    liftCoMatch ([CoVar] -> UniqSet CoVar
    mkVarSet [CoVar]
    qtvs)
                                  (if Bool
    sym then (TyCon -> [Type] -> Type
    mkTyConApp TyCon
    tc [Type]
    lhs) else Type
    rhs)
                                  Coercion
    co
      , (CoVar -> Bool) -> [CoVar] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    all (CoVar -> LiftingContext -> Bool
    `isMappedByLC` LiftingContext
    subst) [CoVar]
    qtvs
      = (Role -> CoVar -> Maybe Coercion)
    -> [Role] -> [CoVar] -> Maybe [Coercion]
    forall (m :: * -> *) a b c.
    Applicative m =>
    (a -> b -> m c) -> [a] -> [b] -> m [c]
    zipWithM (LiftingContext -> Role -> CoVar -> Maybe Coercion
    liftCoSubstTyVar LiftingContext
    subst) [Role]
    roles [CoVar]
    qtvs

      | Bool
    otherwise
      = Maybe [Coercion]
    forall a. Maybe a
    Nothing

    -------------
    compatible_co :: Coercion -> Coercion -> Bool
    -- Check whether (co1 . co2) will be well-kinded
    compatible_co :: Coercion -> Coercion -> Bool
    compatible_co Coercion
    co1 Coercion
    co2
      = Type
    x1 Type -> Type -> Bool
    `eqType` Type
    x2
      where
        x1 :: Type
    x1 = Coercion -> Type
    coercionRKind Coercion
    co1
        x2 :: Type
    x2 = Coercion -> Type
    coercionLKind Coercion
    co2

    -------------
    {-
    etaForAllCo
    ~~~~~~~~~~~~~~~~~
    (1) etaForAllCo_ty_maybe
    Suppose we have

      g : all a1:k1.t1  ~  all a2:k2.t2

    but g is *not* a ForAllCo. We want to eta-expand it. So, we do this:

      g' = all a1:(ForAllKindCo g).(InstCo g (a1 ~ a1 |> ForAllKindCo g))

    Call the kind coercion h1 and the body coercion h2. We can see that

      h2 : t1 ~ t2[a2 |-> (a1 |> h1)]

    According to the typing rule for ForAllCo, we get that

      g' : all a1:k1.t1  ~  all a1:k2.(t2[a2 |-> (a1 |> h1)][a1 |-> a1 |> sym h1])

    or

      g' : all a1:k1.t1  ~  all a1:k2.(t2[a2 |-> a1])

    as desired.

    (2) etaForAllCo_co_maybe
    Suppose we have

      g : all c1:(s1~s2). t1 ~ all c2:(s3~s4). t2

    Similarly, we do this

      g' = all c1:h1. h2
         : all c1:(s1~s2). t1 ~ all c1:(s3~s4). t2[c2 |-> (sym eta1;c1;eta2)]
                                                  [c1 |-> eta1;c1;sym eta2]

    Here,

      h1   = mkSelCo Nominal 0 g       :: (s1~s2)~(s3~s4)
      eta1 = mkSelCo (SelTyCon 2 r) h1 :: (s1 ~ s3)
      eta2 = mkSelCo (SelTyCon 3 r) h1 :: (s2 ~ s4)
      h2   = mkInstCo g (cv1 ~ (sym eta1;c1;eta2))
    -}
    etaForAllCo_ty_maybe :: Coercion -> Maybe (TyVar, ForAllTyFlag, ForAllTyFlag, Coercion, Coercion)
    -- Try to make the coercion be of form (forall tv:kind_co. co)
    etaForAllCo_ty_maybe :: Coercion
    -> Maybe (CoVar, ForAllTyFlag, ForAllTyFlag, Coercion, Coercion)
    etaForAllCo_ty_maybe Coercion
    co
      | Just (CoVar
    tv, ForAllTyFlag
    visL, ForAllTyFlag
    visR, Coercion
    kind_co, Coercion
    r) <- Coercion
    -> Maybe (CoVar, ForAllTyFlag, ForAllTyFlag, Coercion, Coercion)
    splitForAllCo_ty_maybe Coercion
    co
      = (CoVar, ForAllTyFlag, ForAllTyFlag, Coercion, Coercion)
    -> Maybe (CoVar, ForAllTyFlag, ForAllTyFlag, Coercion, Coercion)
    forall a. a -> Maybe a
    Just (CoVar
    tv, ForAllTyFlag
    visL, ForAllTyFlag
    visR, Coercion
    kind_co, Coercion
    r)

      | (Pair Type
    ty1 Type
    ty2, Role
    role)  <- Coercion -> (Pair Type, Role)
    coercionKindRole Coercion
    co
      , Just (Bndr CoVar
    tv1 ForAllTyFlag
    vis1, Type
    _) <- Type -> Maybe (ForAllTyBinder, Type)
    splitForAllForAllTyBinder_maybe Type
    ty1
      , CoVar -> Bool
    isTyVar CoVar
    tv1
      , Just (Bndr CoVar
    tv2 ForAllTyFlag
    vis2, Type
    _) <- Type -> Maybe (ForAllTyBinder, Type)
    splitForAllForAllTyBinder_maybe Type
    ty2
      , CoVar -> Bool
    isTyVar CoVar
    tv2
      -- can't eta-expand at nominal role unless visibilities match
      , (Role
    role Role -> Role -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Role
    Nominal) Bool -> Bool -> Bool
    || (ForAllTyFlag
    vis1 ForAllTyFlag -> ForAllTyFlag -> Bool
    `eqForAllVis` ForAllTyFlag
    vis2)
      , let kind_co :: Coercion
    kind_co = HasDebugCallStack => CoSel -> Coercion -> Coercion
    CoSel -> Coercion -> Coercion
    mkSelCo CoSel
    SelForAll Coercion
    co
      = (CoVar, ForAllTyFlag, ForAllTyFlag, Coercion, Coercion)
    -> Maybe (CoVar, ForAllTyFlag, ForAllTyFlag, Coercion, Coercion)
    forall a. a -> Maybe a
    Just ( CoVar
    tv1, ForAllTyFlag
    vis1, ForAllTyFlag
    vis2, Coercion
    kind_co
             , Coercion -> Coercion -> Coercion
    mkInstCo Coercion
    co (Role -> Type -> Coercion -> Coercion
    mkGReflRightCo Role
    Nominal (CoVar -> Type
    TyVarTy CoVar
    tv1) Coercion
    kind_co))

      | Bool
    otherwise
      = Maybe (CoVar, ForAllTyFlag, ForAllTyFlag, Coercion, Coercion)
    forall a. Maybe a
    Nothing

    etaForAllCo_co_maybe :: Coercion -> Maybe (CoVar, ForAllTyFlag, ForAllTyFlag, Coercion, Coercion)
    -- Try to make the coercion be of form (forall cv:kind_co. co)
    etaForAllCo_co_maybe :: Coercion
    -> Maybe (CoVar, ForAllTyFlag, ForAllTyFlag, Coercion, Coercion)
    etaForAllCo_co_maybe Coercion
    co
      | Just (CoVar
    cv, ForAllTyFlag
    visL, ForAllTyFlag
    visR, Coercion
    kind_co, Coercion
    r) <- Coercion
    -> Maybe (CoVar, ForAllTyFlag, ForAllTyFlag, Coercion, Coercion)
    splitForAllCo_co_maybe Coercion
    co
      = (CoVar, ForAllTyFlag, ForAllTyFlag, Coercion, Coercion)
    -> Maybe (CoVar, ForAllTyFlag, ForAllTyFlag, Coercion, Coercion)
    forall a. a -> Maybe a
    Just (CoVar
    cv, ForAllTyFlag
    visL, ForAllTyFlag
    visR, Coercion
    kind_co, Coercion
    r)

      | (Pair Type
    ty1 Type
    ty2, Role
    role)  <- Coercion -> (Pair Type, Role)
    coercionKindRole Coercion
    co
      , Just (Bndr CoVar
    cv1 ForAllTyFlag
    vis1, Type
    _) <- Type -> Maybe (ForAllTyBinder, Type)
    splitForAllForAllTyBinder_maybe Type
    ty1
      , CoVar -> Bool
    isCoVar CoVar
    cv1
      , Just (Bndr CoVar
    cv2 ForAllTyFlag
    vis2, Type
    _) <- Type -> Maybe (ForAllTyBinder, Type)
    splitForAllForAllTyBinder_maybe Type
    ty2
      , CoVar -> Bool
    isCoVar CoVar
    cv2
      -- can't eta-expand at nominal role unless visibilities match
      , (Role
    role Role -> Role -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Role
    Nominal)
      = let kind_co :: Coercion
    kind_co  = HasDebugCallStack => CoSel -> Coercion -> Coercion
    CoSel -> Coercion -> Coercion
    mkSelCo CoSel
    SelForAll Coercion
    co
            r :: Role
    r        = CoVar -> Role
    coVarRole CoVar
    cv1
            l_co :: Coercion
    l_co     = CoVar -> Coercion
    mkCoVarCo CoVar
    cv1
            kind_co' :: Coercion
    kind_co' = Role -> Role -> Coercion -> Coercion
    downgradeRole Role
    r Role
    Nominal Coercion
    kind_co
            r_co :: Coercion
    r_co     = Coercion -> Coercion
    mkSymCo (HasDebugCallStack => CoSel -> Coercion -> Coercion
    CoSel -> Coercion -> Coercion
    mkSelCo (Int -> Role -> CoSel
    SelTyCon Int
    2 Role
    r) Coercion
    kind_co')
                       Coercion -> Coercion -> Coercion
    `mkTransCo` Coercion
    l_co
                       Coercion -> Coercion -> Coercion
    `mkTransCo` HasDebugCallStack => CoSel -> Coercion -> Coercion
    CoSel -> Coercion -> Coercion
    mkSelCo (Int -> Role -> CoSel
    SelTyCon Int
    3 Role
    r) Coercion
    kind_co'
        in (CoVar, ForAllTyFlag, ForAllTyFlag, Coercion, Coercion)
    -> Maybe (CoVar, ForAllTyFlag, ForAllTyFlag, Coercion, Coercion)
    forall a. a -> Maybe a
    Just ( CoVar
    cv1, ForAllTyFlag
    vis1, ForAllTyFlag
    vis2, Coercion
    kind_co
                , Coercion -> Coercion -> Coercion
    mkInstCo Coercion
    co (Role -> Coercion -> Coercion -> Coercion -> Coercion
    mkProofIrrelCo Role
    Nominal Coercion
    kind_co Coercion
    l_co Coercion
    r_co))

      | Bool
    otherwise
      = Maybe (CoVar, ForAllTyFlag, ForAllTyFlag, Coercion, Coercion)
    forall a. Maybe a
    Nothing

    etaAppCo_maybe :: Coercion -> Maybe (Coercion,Coercion)
    -- If possible, split a coercion
    --   g :: t1a t1b ~ t2a t2b
    -- into a pair of coercions (left g, right g)
    etaAppCo_maybe :: Coercion -> Maybe (Coercion, Coercion)
    etaAppCo_maybe Coercion
    co
      | Just (Coercion
    co1,Coercion
    co2) <- Coercion -> Maybe (Coercion, Coercion)
    splitAppCo_maybe Coercion
    co
      = (Coercion, Coercion) -> Maybe (Coercion, Coercion)
    forall a. a -> Maybe a
    Just (Coercion
    co1,Coercion
    co2)
      | (Pair Type
    ty1 Type
    ty2, Role
    Nominal) <- Coercion -> (Pair Type, Role)
    coercionKindRole Coercion
    co
      , Just (Type
    _,Type
    t1) <- Type -> Maybe (Type, Type)
    splitAppTy_maybe Type
    ty1
      , Just (Type
    _,Type
    t2) <- Type -> Maybe (Type, Type)
    splitAppTy_maybe Type
    ty2
      , let isco1 :: Bool
    isco1 = Type -> Bool
    isCoercionTy Type
    t1
      , let isco2 :: Bool
    isco2 = Type -> Bool
    isCoercionTy Type
    t2
      , Bool
    isco1 Bool -> Bool -> Bool
    forall a. Eq a => a -> a -> Bool
    == Bool
    isco2
      = (Coercion, Coercion) -> Maybe (Coercion, Coercion)
    forall a. a -> Maybe a
    Just (LeftOrRight -> Coercion -> Coercion
    LRCo LeftOrRight
    CLeft Coercion
    co, LeftOrRight -> Coercion -> Coercion
    LRCo LeftOrRight
    CRight Coercion
    co)
      | Bool
    otherwise
      = Maybe (Coercion, Coercion)
    forall a. Maybe a
    Nothing

    etaTyConAppCo_maybe :: TyCon -> Coercion -> Maybe [Coercion]
    -- If possible, split a coercion
    --       g :: T s1 .. sn ~ T t1 .. tn
    -- into [ SelCo (SelTyCon 0)     g :: s1~t1
    --      , ...
    --      , SelCo (SelTyCon (n-1)) g :: sn~tn ]
    etaTyConAppCo_maybe :: TyCon -> Coercion -> Maybe [Coercion]
    etaTyConAppCo_maybe TyCon
    tc (TyConAppCo Role
    _ TyCon
    tc2 [Coercion]
    cos2)
      = Bool -> Maybe [Coercion] -> Maybe [Coercion]
    forall a. HasCallStack => Bool -> a -> a
    assert (TyCon
    tc TyCon -> TyCon -> Bool
    forall a. Eq a => a -> a -> Bool
    == TyCon
    tc2) (Maybe [Coercion] -> Maybe [Coercion])
    -> Maybe [Coercion] -> Maybe [Coercion]
    forall a b. (a -> b) -> a -> b
    $ [Coercion] -> Maybe [Coercion]
    forall a. a -> Maybe a
    Just [Coercion]
    cos2

    etaTyConAppCo_maybe TyCon
    tc Coercion
    co
      | Bool -> Bool
    not (TyCon -> Bool
    tyConMustBeSaturated TyCon
    tc)
      , (Pair Type
    ty1 Type
    ty2, Role
    r) <- Coercion -> (Pair Type, Role)
    coercionKindRole Coercion
    co
      , Just (TyCon
    tc1, [Type]
    tys1)  <- HasDebugCallStack => Type -> Maybe (TyCon, [Type])
    Type -> Maybe (TyCon, [Type])
    splitTyConApp_maybe Type
    ty1
      , Just (TyCon
    tc2, [Type]
    tys2)  <- HasDebugCallStack => Type -> Maybe (TyCon, [Type])
    Type -> Maybe (TyCon, [Type])
    splitTyConApp_maybe Type
    ty2
      , TyCon
    tc1 TyCon -> TyCon -> Bool
    forall a. Eq a => a -> a -> Bool
    == TyCon
    tc2
      , TyCon -> Role -> Bool
    isInjectiveTyCon TyCon
    tc Role
    r  -- See Note [SelCo and newtypes] in GHC.Core.TyCo.Rep
      , let n :: Int
    n = [Type] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [Type]
    tys1
      , [Type]
    tys2 [Type] -> Int -> Bool
    forall a. [a] -> Int -> Bool
    `lengthIs` Int
    n      -- This can fail in an erroneous program
                               -- E.g. T a ~# T a b
                               -- #14607
      = Bool -> Maybe [Coercion] -> Maybe [Coercion]
    forall a. HasCallStack => Bool -> a -> a
    assert (TyCon
    tc TyCon -> TyCon -> Bool
    forall a. Eq a => a -> a -> Bool
    == TyCon
    tc1) (Maybe [Coercion] -> Maybe [Coercion])
    -> Maybe [Coercion] -> Maybe [Coercion]
    forall a b. (a -> b) -> a -> b
    $
        [Coercion] -> Maybe [Coercion]
    forall a. a -> Maybe a
    Just (Int -> Coercion -> Infinite Role -> [Coercion]
    decomposeCo Int
    n Coercion
    co (Role -> TyCon -> Infinite Role
    tyConRolesX Role
    r TyCon
    tc1))
        -- NB: n might be <> tyConArity tc
        -- e.g.   data family T a :: * -> *
        --        g :: T a b ~ T c d

      | Bool
    otherwise
      = Maybe [Coercion]
    forall a. Maybe a
    Nothing

    {-
    Note [Eta for AppCo]
    ~~~~~~~~~~~~~~~~~~~~
    Suppose we have
       g :: s1 t1 ~ s2 t2

    Then we can't necessarily make
       left  g :: s1 ~ s2
       right g :: t1 ~ t2
    because it's possible that
       s1 :: * -> *         t1 :: *
       s2 :: (*->*) -> *    t2 :: * -> *
    and in that case (left g) does not have the same
    kind on either side.

    It's enough to check that
      kind t1 = kind t2
    because if g is well-kinded then
      kind (s1 t2) = kind (s2 t2)
    and these two imply
      kind s1 = kind s2

    -}

    optForAllCoBndr :: LiftingContext -> Bool
                    -> TyCoVar -> Coercion -> (LiftingContext, TyCoVar, Coercion)
    optForAllCoBndr :: LiftingContext
    -> Bool -> CoVar -> Coercion -> (LiftingContext, CoVar, Coercion)
    optForAllCoBndr LiftingContext
    env Bool
    sym
      = Bool
    -> (Coercion -> Coercion)
    -> LiftingContext
    -> CoVar
    -> Coercion
    -> (LiftingContext, CoVar, Coercion)
    substForAllCoBndrUsingLC Bool
    sym (LiftingContext -> Bool -> Bool -> Role -> Coercion -> Coercion
    opt_co4_wrap LiftingContext
    env Bool
    sym Bool
    False Role
    Nominal) LiftingContext
    env