+isCoVar v = isCoVarType (varType v)
+
+isCoVarType :: Type -> Bool
+isCoVarType = isEqPredTy
+\end{code}
+
+
+\begin{code}
+tyCoVarsOfCo :: Coercion -> VarSet
+-- Extracts type and coercion variables from a coercion
+tyCoVarsOfCo (Refl ty) = tyVarsOfType ty
+tyCoVarsOfCo (TyConAppCo _ cos) = tyCoVarsOfCos cos
+tyCoVarsOfCo (AppCo co1 co2) = tyCoVarsOfCo co1 `unionVarSet` tyCoVarsOfCo co2
+tyCoVarsOfCo (ForAllCo tv co) = tyCoVarsOfCo co `delVarSet` tv
+tyCoVarsOfCo (CoVarCo v) = unitVarSet v
+tyCoVarsOfCo (AxiomInstCo _ cos) = tyCoVarsOfCos cos
+tyCoVarsOfCo (UnsafeCo ty1 ty2) = tyVarsOfType ty1 `unionVarSet` tyVarsOfType ty2
+tyCoVarsOfCo (SymCo co) = tyCoVarsOfCo co
+tyCoVarsOfCo (TransCo co1 co2) = tyCoVarsOfCo co1 `unionVarSet` tyCoVarsOfCo co2
+tyCoVarsOfCo (NthCo _ co) = tyCoVarsOfCo co
+tyCoVarsOfCo (InstCo co ty) = tyCoVarsOfCo co `unionVarSet` tyVarsOfType ty
+
+tyCoVarsOfCos :: [Coercion] -> VarSet
+tyCoVarsOfCos cos = foldr (unionVarSet . tyCoVarsOfCo) emptyVarSet cos
+
+coVarsOfCo :: Coercion -> VarSet
+-- Extract *coerction* variables only. Tiresome to repeat the code, but easy.
+coVarsOfCo (Refl _) = emptyVarSet
+coVarsOfCo (TyConAppCo _ cos) = coVarsOfCos cos
+coVarsOfCo (AppCo co1 co2) = coVarsOfCo co1 `unionVarSet` coVarsOfCo co2
+coVarsOfCo (ForAllCo _ co) = coVarsOfCo co
+coVarsOfCo (CoVarCo v) = unitVarSet v
+coVarsOfCo (AxiomInstCo _ cos) = coVarsOfCos cos
+coVarsOfCo (UnsafeCo _ _) = emptyVarSet
+coVarsOfCo (SymCo co) = coVarsOfCo co
+coVarsOfCo (TransCo co1 co2) = coVarsOfCo co1 `unionVarSet` coVarsOfCo co2
+coVarsOfCo (NthCo _ co) = coVarsOfCo co
+coVarsOfCo (InstCo co _) = coVarsOfCo co
+
+coVarsOfCos :: [Coercion] -> VarSet
+coVarsOfCos cos = foldr (unionVarSet . coVarsOfCo) emptyVarSet cos
+
+coercionSize :: Coercion -> Int
+coercionSize (Refl ty) = typeSize ty
+coercionSize (TyConAppCo _ cos) = 1 + sum (map coercionSize cos)
+coercionSize (AppCo co1 co2) = coercionSize co1 + coercionSize co2
+coercionSize (ForAllCo _ co) = 1 + coercionSize co
+coercionSize (CoVarCo _) = 1
+coercionSize (AxiomInstCo _ cos) = 1 + sum (map coercionSize cos)
+coercionSize (UnsafeCo ty1 ty2) = typeSize ty1 + typeSize ty2
+coercionSize (SymCo co) = 1 + coercionSize co
+coercionSize (TransCo co1 co2) = 1 + coercionSize co1 + coercionSize co2
+coercionSize (NthCo _ co) = 1 + coercionSize co
+coercionSize (InstCo co ty) = 1 + coercionSize co + typeSize ty
+\end{code}
+
+%************************************************************************
+%* *
+ Pretty-printing coercions
+%* *
+%************************************************************************
+
+@pprCo@ is the standard @Coercion@ printer; the overloaded @ppr@
+function is defined to use this. @pprParendCo@ is the same, except it
+puts parens around the type, except for the atomic cases.
+@pprParendCo@ works just by setting the initial context precedence
+very high.
+
+\begin{code}
+instance Outputable Coercion where
+ ppr = pprCo
+
+pprCo, pprParendCo :: Coercion -> SDoc
+pprCo co = ppr_co TopPrec co
+pprParendCo co = ppr_co TyConPrec co
+
+ppr_co :: Prec -> Coercion -> SDoc
+ppr_co _ (Refl ty) = angles (ppr ty)
+
+ppr_co p co@(TyConAppCo tc cos)
+ | tc `hasKey` funTyConKey = ppr_fun_co p co
+ | otherwise = pprTcApp p ppr_co tc cos
+
+ppr_co p (AppCo co1 co2) = maybeParen p TyConPrec $
+ pprCo co1 <+> ppr_co TyConPrec co2
+
+ppr_co p co@(ForAllCo {}) = ppr_forall_co p co
+
+ppr_co _ (CoVarCo cv)
+ | isSymOcc (getOccName cv) = parens (ppr cv)
+ | otherwise = ppr cv
+
+ppr_co p (AxiomInstCo con cos) = pprTypeNameApp p ppr_co (getName con) cos
+
+
+ppr_co p (TransCo co1 co2) = maybeParen p FunPrec $
+ ppr_co FunPrec co1
+ <+> ptext (sLit ";")
+ <+> ppr_co FunPrec co2
+ppr_co p (InstCo co ty) = maybeParen p TyConPrec $
+ pprParendCo co <> ptext (sLit "@") <> pprType ty
+
+ppr_co p (UnsafeCo ty1 ty2) = pprPrefixApp p (ptext (sLit "UnsafeCo")) [pprParendType ty1, pprParendType ty2]
+ppr_co p (SymCo co) = pprPrefixApp p (ptext (sLit "Sym")) [pprParendCo co]
+ppr_co p (NthCo n co) = pprPrefixApp p (ptext (sLit "Nth:") <+> int n) [pprParendCo co]
+
+
+angles :: SDoc -> SDoc
+angles p = char '<' <> p <> char '>'
+
+ppr_fun_co :: Prec -> Coercion -> SDoc
+ppr_fun_co p co = pprArrowChain p (split co)
+ where
+ split (TyConAppCo f [arg,res])
+ | f `hasKey` funTyConKey
+ = ppr_co FunPrec arg : split res
+ split co = [ppr_co TopPrec co]
+
+ppr_forall_co :: Prec -> Coercion -> SDoc
+ppr_forall_co p ty
+ = maybeParen p FunPrec $
+ sep [pprForAll tvs, ppr_co TopPrec rho]
+ where
+ (tvs, rho) = split1 [] ty
+ split1 tvs (ForAllCo tv ty) = split1 (tv:tvs) ty
+ split1 tvs ty = (reverse tvs, ty)
+\end{code}
+
+\begin{code}
+pprCoAxiom :: CoAxiom -> SDoc
+pprCoAxiom ax
+ = sep [ ptext (sLit "axiom") <+> ppr ax <+> ppr (co_ax_tvs ax)
+ , nest 2 (dcolon <+> pprEqPred (Pair (co_ax_lhs ax) (co_ax_rhs ax))) ]
+\end{code}
+
+%************************************************************************
+%* *
+ Functions over Kinds
+%* *
+%************************************************************************
+
+\begin{code}
+-- | This breaks a 'Coercion' with type @T A B C ~ T D E F@ into
+-- a list of 'Coercion's of kinds @A ~ D@, @B ~ E@ and @E ~ F@. Hence:
+--
+-- > decomposeCo 3 c = [nth 0 c, nth 1 c, nth 2 c]
+decomposeCo :: Arity -> Coercion -> [Coercion]
+decomposeCo arity co = [mkNthCo n co | n <- [0..(arity-1)] ]
+
+-- | Attempts to obtain the type variable underlying a 'Coercion'
+getCoVar_maybe :: Coercion -> Maybe CoVar
+getCoVar_maybe (CoVarCo cv) = Just cv
+getCoVar_maybe _ = Nothing
+
+-- | Attempts to tease a coercion apart into a type constructor and the application
+-- of a number of coercion arguments to that constructor
+splitTyConAppCo_maybe :: Coercion -> Maybe (TyCon, [Coercion])
+splitTyConAppCo_maybe (Refl ty) = (fmap . second . map) Refl (splitTyConApp_maybe ty)
+splitTyConAppCo_maybe (TyConAppCo tc cos) = Just (tc, cos)
+splitTyConAppCo_maybe _ = Nothing
+
+splitAppCo_maybe :: Coercion -> Maybe (Coercion, Coercion)
+-- ^ Attempt to take a coercion application apart.
+splitAppCo_maybe (AppCo co1 co2) = Just (co1, co2)
+splitAppCo_maybe (TyConAppCo tc cos)
+ | isDecomposableTyCon tc || cos `lengthExceeds` tyConArity tc
+ , Just (cos', co') <- snocView cos
+ = Just (mkTyConAppCo tc cos', co') -- Never create unsaturated type family apps!
+ -- Use mkTyConAppCo to preserve the invariant
+ -- that identity coercions are always represented by Refl
+splitAppCo_maybe (Refl ty)
+ | Just (ty1, ty2) <- splitAppTy_maybe ty
+ = Just (Refl ty1, Refl ty2)
+splitAppCo_maybe _ = Nothing
+
+splitForAllCo_maybe :: Coercion -> Maybe (TyVar, Coercion)
+splitForAllCo_maybe (ForAllCo tv co) = Just (tv, co)
+splitForAllCo_maybe _ = Nothing
+
+-------------------------------------------------------
+-- and some coercion kind stuff
+
+coVarPred :: CoVar -> PredType
+coVarPred cv
+ = ASSERT( isCoVar cv )
+ case splitPredTy_maybe (varType cv) of
+ Just pred -> pred
+ other -> pprPanic "coVarPred" (ppr cv $$ ppr other)
+
+coVarKind :: CoVar -> (Type,Type)
+-- c :: t1 ~ t2
+coVarKind cv = case coVarKind_maybe cv of
+ Just ts -> ts
+ Nothing -> pprPanic "coVarKind" (ppr cv $$ ppr (tyVarKind cv))
+
+coVarKind_maybe :: CoVar -> Maybe (Type,Type)
+coVarKind_maybe cv = splitEqPredTy_maybe (varType cv)
+
+-- | Makes a coercion type from two types: the types whose equality
+-- is proven by the relevant 'Coercion'
+mkCoType :: Type -> Type -> Type
+mkCoType ty1 ty2 = PredTy (EqPred ty1 ty2)
+
+splitCoPredTy_maybe :: Type -> Maybe (Type, Type, Type)
+splitCoPredTy_maybe ty
+ | Just (cv,r) <- splitForAllTy_maybe ty
+ , isCoVar cv
+ , Just (s,t) <- coVarKind_maybe cv
+ = Just (s,t,r)