Type checking for type synonym families
[ghc.git] / compiler / types / Type.lhs
index ccabfb7..de7e460 100644 (file)
@@ -1,8 +1,9 @@
 %
+% (c) The University of Glasgow 2006
 % (c) The GRASP/AQUA Project, Glasgow University, 1998
 %
-\section[Type]{Type - public interface}
 
+Type - public interface
 
 \begin{code}
 module Type (
@@ -12,7 +13,7 @@ module Type (
 
        -- Kinds
         Kind, SimpleKind, KindVar,
-        kindFunResult, splitKindFunTys, 
+        kindFunResult, splitKindFunTys, splitKindFunTysN,
 
         liftedTypeKindTyCon, openTypeKindTyCon, unliftedTypeKindTyCon,
         argTypeKindTyCon, ubxTupleKindTyCon,
@@ -24,7 +25,7 @@ module Type (
 
         isLiftedTypeKind, isUnliftedTypeKind, isOpenTypeKind,
         isUbxTupleKind, isArgTypeKind, isKind, isTySuperKind, 
-        isCoSuperKind, isSuperKind, isCoercionKind,
+        isCoSuperKind, isSuperKind, isCoercionKind, isEqPred,
        mkArrowKind, mkArrowKinds,
 
         isSubArgTypeKind, isSubOpenTypeKind, isSubKind, defaultKind, eqKind,
@@ -47,16 +48,16 @@ module Type (
        splitTyConApp_maybe, splitTyConApp, 
         splitNewTyConApp_maybe, splitNewTyConApp,
 
-       repType, typePrimRep, coreView, tcView, stgView, kindView,
+       repType, repType', typePrimRep, coreView, tcView, kindView,
 
        mkForAllTy, mkForAllTys, splitForAllTy_maybe, splitForAllTys, 
        applyTy, applyTys, isForAllTy, dropForAlls,
 
        -- Source types
-       predTypeRep, mkPredTy, mkPredTys,
+       predTypeRep, mkPredTy, mkPredTys, pprSourceTyCon, mkFamilyTyConApp,
 
        -- Newtypes
-       splitRecNewType_maybe,
+       newTyConInstRhs,
 
        -- Lifting and boxity
        isUnLiftedType, isUnboxedTupleType, isAlgType, isPrimitiveType,
@@ -87,13 +88,14 @@ module Type (
        mkTvSubst, mkOpenTvSubst, zipOpenTvSubst, zipTopTvSubst, mkTopTvSubst, notElemTvSubst,
        getTvSubstEnv, setTvSubstEnv, getTvInScope, extendTvInScope,
        extendTvSubst, extendTvSubstList, isInScope, composeTvSubst, zipTyEnv,
+        isEmptyTvSubst,
 
        -- Performing substitution on types
        substTy, substTys, substTyWith, substTheta, 
-       substPred, substTyVar, substTyVarBndr, deShadowTy, lookupTyVar,
+       substPred, substTyVar, substTyVars, substTyVarBndr, deShadowTy, lookupTyVar,
 
        -- Pretty-printing
-       pprType, pprParendType, pprTyThingCategory,
+       pprType, pprParendType, pprTypeApp, pprTyThingCategory, pprForAll,
        pprPred, pprTheta, pprThetaArrow, pprClassPred, pprKind, pprParendKind
     ) where
 
@@ -105,36 +107,23 @@ module Type (
 import TypeRep
 
 -- friends:
-import Var     ( Var, TyVar, tyVarKind, tyVarName, 
-                 setTyVarName, setTyVarKind, mkTyVar, isTyVar )
-import Name    ( Name(..) )
-import Unique  ( Unique )
+import Var
 import VarEnv
 import VarSet
 
-import OccName ( tidyOccName )
-import Name    ( NamedThing(..), mkInternalName, tidyNameOcc )
-import Class   ( Class, classTyCon )
-import PrelNames( openTypeKindTyConKey, unliftedTypeKindTyConKey, 
-                  ubxTupleKindTyConKey, argTypeKindTyConKey, 
-                  eqCoercionKindTyConKey )
-import TyCon   ( TyCon, isRecursiveTyCon, isPrimTyCon,
-                 isUnboxedTupleTyCon, isUnLiftedTyCon,
-                 isFunTyCon, isNewTyCon, newTyConRep, newTyConRhs,
-                 isAlgTyCon, tyConArity, isSuperKindTyCon,
-                 tcExpandTyCon_maybe, coreExpandTyCon_maybe,
-                  stgExpandTyCon_maybe,
-                 tyConKind, PrimRep(..), tyConPrimRep, tyConUnique,
-                  isCoercionTyCon_maybe, isCoercionTyCon
-               )
+import Name
+import Class
+import PrelNames
+import TyCon
 
 -- others
-import StaticFlags     ( opt_DictsStrict )
-import SrcLoc          ( noSrcLoc )
-import Util            ( mapAccumL, seqList, lengthIs, snocView, thenCmp, isEqual, all2 )
+import StaticFlags
+import Util
 import Outputable
-import UniqSet         ( sizeUniqSet )         -- Should come via VarSet
-import Maybe           ( isJust )
+import UniqSet
+
+import Data.List
+import Data.Maybe      ( isJust )
 \end{code}
 
 
@@ -169,7 +158,9 @@ coreView :: Type -> Maybe Type
 -- By being non-recursive and inlined, this case analysis gets efficiently
 -- joined onto the case analysis that the caller is already doing
 coreView (NoteTy _ ty)            = Just ty
-coreView (PredTy p)               = Just (predTypeRep p)
+coreView (PredTy p)
+  | isEqPred p             = Nothing
+  | otherwise             = Just (predTypeRep p)
 coreView (TyConApp tc tys) | Just (tenv, rhs, tys') <- coreExpandTyCon_maybe tc tys 
                           = Just (mkAppTys (substTy (mkTopTvSubst tenv) rhs) tys')
                                -- Its important to use mkAppTys, rather than (foldl AppTy),
@@ -177,19 +168,6 @@ coreView (TyConApp tc tys) | Just (tenv, rhs, tys') <- coreExpandTyCon_maybe tc
                                -- partially-applied type constructor; indeed, usually will!
 coreView ty               = Nothing
 
-{-# INLINE stgView #-}
-stgView :: Type -> Maybe Type
--- When generating STG from Core it is important that we look through newtypes
--- but for the rest of Core we are just using coercions.  This does just what
--- coreView USED to do.
-stgView (NoteTy _ ty)     = Just ty
-stgView (PredTy p)        = Just (predTypeRep p)
-stgView (TyConApp tc tys) | Just (tenv, rhs, tys') <- stgExpandTyCon_maybe tc tys 
-                          = Just (mkAppTys (substTy (mkTopTvSubst tenv) rhs) tys')
-                               -- Its important to use mkAppTys, rather than (foldl AppTy),
-                               -- because the function part might well return a 
-                               -- partially-applied type constructor; indeed, usually will!
-stgView ty                = Nothing
 
 
 -----------------------------------------------
@@ -323,10 +301,11 @@ splitAppTys ty = split ty ty []
 
 \begin{code}
 mkFunTy :: Type -> Type -> Type
+mkFunTy (PredTy (EqPred ty1 ty2)) res = mkForAllTy (mkWildCoVar (PredTy (EqPred ty1 ty2))) res
 mkFunTy arg res = FunTy arg res
 
 mkFunTys :: [Type] -> Type -> Type
-mkFunTys tys ty = foldr FunTy ty tys
+mkFunTys tys ty = foldr mkFunTy ty tys
 
 isFunTy :: Type -> Bool 
 isFunTy ty = isJust (splitFunTy_maybe ty)
@@ -428,6 +407,9 @@ splitNewTyConApp_maybe (TyConApp tc tys) = Just (tc, tys)
 splitNewTyConApp_maybe (FunTy arg res)   = Just (funTyCon, [arg,res])
 splitNewTyConApp_maybe other         = Nothing
 
+newTyConInstRhs :: TyCon -> [Type] -> Type
+newTyConInstRhs tycon tys =
+    let (tvs, ty) = newTyConRhs tycon in substTyWith tvs tys ty
 \end{code}
 
 
@@ -457,7 +439,7 @@ repType looks through
        (b) synonyms
        (c) predicates
        (d) usage annotations
-       (e) all newtypes, including recursive ones
+       (e) all newtypes, including recursive ones, but not newtype families
 It's useful in the back end.
 
 \begin{code}
@@ -466,19 +448,26 @@ repType :: Type -> Type
 repType ty | Just ty' <- coreView ty = repType ty'
 repType (ForAllTy _ ty)  = repType ty
 repType (TyConApp tc tys)
-  | isNewTyCon tc       = -- Recursive newtypes are opaque to coreView
-                          -- but we must expand them here.  Sure to
-                          -- be saturated because repType is only applied
-                          -- to types of kind *
-                          ASSERT( {- isRecursiveTyCon tc && -} tys `lengthIs` tyConArity tc )
-                          repType (new_type_rep tc tys)
+  | isNewTyCon tc
+  , (tvs, rep_ty) <- newTyConRep tc
+  = -- Recursive newtypes are opaque to coreView
+    -- but we must expand them here.  Sure to
+    -- be saturated because repType is only applied
+    -- to types of kind *
+    ASSERT( tys `lengthIs` tyConArity tc )
+    repType (substTyWith tvs tys rep_ty)
+
 repType ty = ty
 
--- new_type_rep doesn't ask any questions: 
--- it just expands newtype, whether recursive or not
-new_type_rep new_tycon tys = ASSERT( tys `lengthIs` tyConArity new_tycon )
-                            case newTyConRep new_tycon of
-                                (tvs, rep_ty) -> substTyWith tvs tys rep_ty
+-- repType' aims to be a more thorough version of repType
+-- For now it simply looks through the TyConApp args too
+repType' ty -- | pprTrace "repType'" (ppr ty $$ ppr (go1 ty)) False = undefined
+            | otherwise = go1 ty 
+ where 
+        go1 = go . repType
+        go (TyConApp tc tys) = mkTyConApp tc (map repType' tys)
+        go ty = ty
+
 
 -- ToDo: this could be moved to the code generator, using splitTyConApp instead
 -- of inspecting the type directly.
@@ -494,7 +483,6 @@ typePrimRep ty = case repType ty of
        -- The reason is that f must have kind *->*, not *->*#, because
        -- (we claim) there is no way to constrain f's kind any other
        -- way.
-
 \end{code}
 
 
@@ -608,34 +596,31 @@ predTypeRep (IParam _ ty)     = ty
 predTypeRep (ClassP clas tys) = mkTyConApp (classTyCon clas) tys
        -- Result might be a newtype application, but the consumer will
        -- look through that too if necessary
-\end{code}
-
-
-%************************************************************************
-%*                                                                     *
-               NewTypes
-%*                                                                     *
-%************************************************************************
-
-\begin{code}
-splitRecNewType_maybe :: Type -> Maybe Type
--- Sometimes we want to look through a recursive newtype, and that's what happens here
--- It only strips *one layer* off, so the caller will usually call itself recursively
--- Only applied to types of kind *, hence the newtype is always saturated
-splitRecNewType_maybe ty | Just ty' <- coreView ty = splitRecNewType_maybe ty'
-splitRecNewType_maybe (TyConApp tc tys)
-  | isNewTyCon tc
-  = ASSERT( tys `lengthIs` tyConArity tc )     -- splitRecNewType_maybe only be applied 
-                                               --      to *types* (of kind *)
-    ASSERT( isRecursiveTyCon tc )              -- Guaranteed by coreView
-    case newTyConRhs tc of
-       (tvs, rep_ty) -> ASSERT( length tvs == length tys )
-                        Just (substTyWith tvs tys rep_ty)
-       
-splitRecNewType_maybe other = Nothing
-
-
-
+predTypeRep (EqPred ty1 ty2) = pprPanic "predTypeRep" (ppr (EqPred ty1 ty2))
+
+mkFamilyTyConApp :: TyCon -> [Type] -> Type
+-- Given a family instance TyCon and its arg types, return the
+-- corresponding family type.  E.g.
+--     data family T a
+--     data instance T (Maybe b) = MkT b       -- Instance tycon :RTL
+-- Then 
+--     mkFamilyTyConApp :RTL Int  =  T (Maybe Int)
+mkFamilyTyConApp tc tys
+  | Just (fam_tc, fam_tys) <- tyConFamInst_maybe tc
+  , let fam_subst = zipTopTvSubst (tyConTyVars tc) tys
+  = mkTyConApp fam_tc (substTys fam_subst fam_tys)
+  | otherwise
+  = mkTyConApp tc tys
+
+-- Pretty prints a tycon, using the family instance in case of a
+-- representation tycon.  For example
+--     e.g.  data T [a] = ...
+-- In that case we want to print `T [a]', where T is the family TyCon
+pprSourceTyCon tycon 
+  | Just (fam_tc, tys) <- tyConFamInst_maybe tycon
+  = ppr $ fam_tc `TyConApp` tys               -- can't be FunTyCon
+  | otherwise
+  = ppr tycon
 \end{code}
 
 
@@ -695,8 +680,9 @@ tyVarsOfTypes :: [Type] -> TyVarSet
 tyVarsOfTypes tys = foldr (unionVarSet.tyVarsOfType) emptyVarSet tys
 
 tyVarsOfPred :: PredType -> TyVarSet
-tyVarsOfPred (IParam _ ty)  = tyVarsOfType ty
-tyVarsOfPred (ClassP _ tys) = tyVarsOfTypes tys
+tyVarsOfPred (IParam _ ty)    = tyVarsOfType ty
+tyVarsOfPred (ClassP _ tys)   = tyVarsOfTypes tys
+tyVarsOfPred (EqPred ty1 ty2) = tyVarsOfType ty1 `unionVarSet` tyVarsOfType ty2
 
 tyVarsOfTheta :: ThetaType -> TyVarSet
 tyVarsOfTheta = foldr (unionVarSet . tyVarsOfPred) emptyVarSet
@@ -721,13 +707,17 @@ It doesn't change the uniques at all, just the print names.
 
 \begin{code}
 tidyTyVarBndr :: TidyEnv -> TyVar -> (TidyEnv, TyVar)
-tidyTyVarBndr (tidy_env, subst) tyvar
+tidyTyVarBndr env@(tidy_env, subst) tyvar
   = case tidyOccName tidy_env (getOccName name) of
-      (tidy', occ') ->         ((tidy', subst'), tyvar')
-                   where
-                       subst' = extendVarEnv subst tyvar tyvar'
-                       tyvar' = setTyVarName tyvar name'
-                       name'  = tidyNameOcc name occ'
+      (tidy', occ') -> ((tidy', subst'), tyvar'')
+       where
+         subst' = extendVarEnv subst tyvar tyvar''
+         tyvar' = setTyVarName tyvar name'
+         name'  = tidyNameOcc name occ'
+               -- Don't forget to tidy the kind for coercions!
+         tyvar'' | isCoVar tyvar = setTyVarKind tyvar' kind'
+                 | otherwise     = tyvar'
+         kind'  = tidyType env (tyVarKind tyvar)
   where
     name = tyVarName tyvar
 
@@ -770,6 +760,7 @@ tidyTypes env tys = map (tidyType env) tys
 tidyPred :: TidyEnv -> PredType -> PredType
 tidyPred env (IParam n ty)     = IParam n (tidyType env ty)
 tidyPred env (ClassP clas tys) = ClassP clas (tidyTypes env tys)
+tidyPred env (EqPred ty1 ty2)  = EqPred (tidyType env ty1) (tidyType env ty2)
 \end{code}
 
 
@@ -888,8 +879,9 @@ seqNote :: TyNote -> ()
 seqNote (FTVNote set) = sizeUniqSet set `seq` ()
 
 seqPred :: PredType -> ()
-seqPred (ClassP c tys) = c  `seq` seqTypes tys
-seqPred (IParam n ty)  = n  `seq` seqType ty
+seqPred (ClassP c tys)   = c `seq` seqTypes tys
+seqPred (IParam n ty)    = n `seq` seqType ty
+seqPred (EqPred ty1 ty2) = seqType ty1 `seq` seqType ty2
 \end{code}
 
 
@@ -1028,12 +1020,19 @@ cmpTypesX env ty        []        = GT
 -------------
 cmpPredX :: RnEnv2 -> PredType -> PredType -> Ordering
 cmpPredX env (IParam n1 ty1) (IParam n2 ty2) = (n1 `compare` n2) `thenCmp` cmpTypeX env ty1 ty2
-       -- Compare types as well as names for implicit parameters
-       -- This comparison is used exclusively (I think) for the
-       -- finite map built in TcSimplify
-cmpPredX env (ClassP c1 tys1) (ClassP c2 tys2) = (c1 `compare` c2) `thenCmp` cmpTypesX env tys1 tys2
-cmpPredX env (IParam _ _)     (ClassP _ _)     = LT
-cmpPredX env (ClassP _ _)     (IParam _ _)     = GT
+       -- Compare names only for implicit parameters
+       -- This comparison is used exclusively (I believe) 
+       -- for the Avails finite map built in TcSimplify
+       -- If the types differ we keep them distinct so that we see 
+       -- a distinct pair to run improvement on 
+cmpPredX env (ClassP c1 tys1) (ClassP c2 tys2) = (c1 `compare` c2) `thenCmp` (cmpTypesX env tys1 tys2)
+cmpPredX env (EqPred ty1 ty2) (EqPred ty1' ty2') = (cmpTypeX env ty1 ty1') `thenCmp` (cmpTypeX env ty2 ty2')
+
+-- Constructor order: IParam < ClassP < EqPred
+cmpPredX env (IParam {})     _             = LT
+cmpPredX env (ClassP {})    (IParam {})     = GT
+cmpPredX env (ClassP {})    (EqPred {})     = LT
+cmpPredX env (EqPred {})    _              = GT
 \end{code}
 
 PredTypes are used as a FM key in TcSimplify, 
@@ -1055,11 +1054,13 @@ instance Ord PredType where { compare = tcCmpPred }
 data TvSubst           
   = TvSubst InScopeSet         -- The in-scope type variables
            TvSubstEnv  -- The substitution itself
-                       -- See Note [Apply Once]
+       -- See Note [Apply Once]
+       -- and Note [Extending the TvSubstEnv]
 
 {- ----------------------------------------------------------
-               Note [Apply Once]
 
+Note [Apply Once]
+~~~~~~~~~~~~~~~~~
 We use TvSubsts to instantiate things, and we might instantiate
        forall a b. ty
 \with the types
@@ -1076,6 +1077,38 @@ variations happen to; for example [a -> (a, b)].
 
 A TvSubst is not idempotent, but, unlike the non-idempotent substitution
 we use during unifications, it must not be repeatedly applied.
+
+Note [Extending the TvSubst]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+The following invariant should hold of a TvSubst
+
+       The in-scope set is needed *only* to
+       guide the generation of fresh uniques
+
+       In particular, the *kind* of the type variables in 
+       the in-scope set is not relevant
+
+This invariant allows a short-cut when the TvSubstEnv is empty:
+if the TvSubstEnv is empty --- i.e. (isEmptyTvSubt subst) holds ---
+then (substTy subst ty) does nothing.
+
+For example, consider:
+       (/\a. /\b:(a~Int). ...b..) Int
+We substitute Int for 'a'.  The Unique of 'b' does not change, but
+nevertheless we add 'b' to the TvSubstEnv, because b's type does change
+
+This invariant has several crucial consequences:
+
+* In substTyVarBndr, we need extend the TvSubstEnv 
+       - if the unique has changed
+       - or if the kind has changed
+
+* In substTyVar, we do not need to consult the in-scope set;
+  the TvSubstEnv is enough
+
+* In substTy, substTheta, we can short-circuit when the TvSubstEnv is empty
+  
+
 -------------------------------------------------------------- -}
 
 
@@ -1104,6 +1137,7 @@ composeTvSubst in_scope env1 env2
 emptyTvSubst = TvSubst emptyInScopeSet emptyVarEnv
 
 isEmptyTvSubst :: TvSubst -> Bool
+        -- See Note [Extending the TvSubstEnv]
 isEmptyTvSubst (TvSubst _ env) = isEmptyVarEnv env
 
 mkTvSubst :: InScopeSet -> TvSubstEnv -> TvSubst
@@ -1160,7 +1194,7 @@ zipTopTvSubst :: [TyVar] -> [Type] -> TvSubst
 zipTopTvSubst tyvars tys 
 #ifdef DEBUG
   | length tyvars /= length tys
-  = pprTrace "zipOpenTvSubst" (ppr tyvars $$ ppr tys) emptyTvSubst
+  = pprTrace "zipTopTvSubst" (ppr tyvars $$ ppr tys) emptyTvSubst
   | otherwise
 #endif
   = TvSubst emptyInScopeSet (zipTyEnv tyvars tys)
@@ -1262,17 +1296,22 @@ subst_ty subst ty
 substTyVar :: TvSubst -> TyVar  -> Type
 substTyVar subst@(TvSubst in_scope env) tv
   = case lookupTyVar subst tv of {
-       Nothing  -> TyVarTy tv;
+       Nothing -> TyVarTy tv;
                Just ty -> ty   -- See Note [Apply Once]
     } 
 
+substTyVars :: TvSubst -> [TyVar] -> [Type]
+substTyVars subst tvs = map (substTyVar subst) tvs
+
 lookupTyVar :: TvSubst -> TyVar  -> Maybe Type
+       -- See Note [Extending the TvSubst]
 lookupTyVar (TvSubst in_scope env) tv = lookupVarEnv env tv
 
 substTyVarBndr :: TvSubst -> TyVar -> (TvSubst, TyVar) 
 substTyVarBndr subst@(TvSubst in_scope env) old_var
   = (TvSubst (in_scope `extendInScopeSet` new_var) new_env, new_var)
   where
+    is_co_var = isCoVar old_var
 
     new_env | no_change = delVarEnv env old_var
            | otherwise = extendVarEnv env old_var (TyVarTy new_var)
@@ -1280,6 +1319,7 @@ substTyVarBndr subst@(TvSubst in_scope env) old_var
     no_change = new_var == old_var && not is_co_var
        -- no_change means that the new_var is identical in
        -- all respects to the old_var (same unique, same kind)
+       -- See Note [Extending the TvSubst]
        --
        -- In that case we don't need to extend the substitution
        -- to map old to new.  But instead we must zap any 
@@ -1291,12 +1331,10 @@ substTyVarBndr subst@(TvSubst in_scope env) old_var
        -- The uniqAway part makes sure the new variable is not already in scope
 
     subst_old_var -- subst_old_var is old_var with the substitution applied to its kind
-                -- It's only worth doing the substitution for coercions,
-                -- becuase only they can have free type variables
-       | is_co_var = setTyVarKind old_var (substTy subst kind)
+                 -- It's only worth doing the substitution for coercions,
+                 -- becuase only they can have free type variables
+       | is_co_var = setTyVarKind old_var (substTy subst (tyVarKind old_var))
        | otherwise = old_var
-    kind = tyVarKind old_var
-    is_co_var = isCoercionKind kind
 \end{code}
 
 ----------------------------------------------------
@@ -1375,6 +1413,9 @@ kindFunResult k = funResultTy k
 splitKindFunTys :: Kind -> ([Kind],Kind)
 splitKindFunTys k = splitFunTys k
 
+splitKindFunTysN :: Int -> Kind -> ([Kind],Kind)
+splitKindFunTysN k = splitFunTysN k
+
 isUbxTupleKind, isOpenTypeKind, isArgTypeKind, isUnliftedTypeKind :: Kind -> Bool
 
 isOpenTypeKindCon tc    = tyConUnique tc == openTypeKindTyConKey
@@ -1426,12 +1467,12 @@ isSuperKind other = False
 isKind :: Kind -> Bool
 isKind k = isSuperKind (typeKind k)
 
-
-
 isSubKind :: Kind -> Kind -> Bool
 -- (k1 `isSubKind` k2) checks that k1 <: k2
-isSubKind (TyConApp kc1 []) (TyConApp kc2 []) = kc1 `isSubKindCon` kc1
+isSubKind (TyConApp kc1 []) (TyConApp kc2 []) = kc1 `isSubKindCon` kc2
 isSubKind (FunTy a1 r1) (FunTy a2 r2)        = (a2 `isSubKind` a1) && (r1 `isSubKind` r2)
+isSubKind (PredTy (EqPred ty1 ty2)) (PredTy (EqPred ty1' ty2')) 
+  = ty1 `tcEqType` ty1' && ty2 `tcEqType` ty2'
 isSubKind k1           k2                    = False
 
 eqKind :: Kind -> Kind -> Bool
@@ -1467,11 +1508,7 @@ defaultKind k
   | isSubArgTypeKind k  = liftedTypeKind
   | otherwise        = k
 
-isCoercionKind :: Kind -> Bool
--- All coercions are of form (ty1 :=: ty2)
--- This function is here rather than in Coercion, 
--- because it's used by substTy
-isCoercionKind k | Just k' <- kindView k = isCoercionKind k'
-isCoercionKind (PredTy (EqPred {}))     = True
-isCoercionKind other                    = False
+isEqPred :: PredType -> Bool
+isEqPred (EqPred _ _) = True
+isEqPred other       = False
 \end{code}