X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Ftypes%2FCoercion.lhs;h=eda45a3efb99b57655c1f3fb6aaf946bcf78dbff;hb=a17d329568660592dad5c7668fb09f31ab77cd69;hp=b247a3f9c173f7932d2313d2338310feca3ca288;hpb=678086d0d26108713d1c361ab07d5ae12e24f363;p=ghc-hetmet.git

diff --git a/compiler/types/Coercion.lhs b/compiler/types/Coercion.lhs
index b247a3f..eda45a3 100644
--- a/compiler/types/Coercion.lhs
+++ b/compiler/types/Coercion.lhs
@@ -22,7 +22,7 @@ module Coercion (
         Coercion,
  
         mkCoKind, mkReflCoKind, splitCoercionKind_maybe, splitCoercionKind,
-        coercionKind, coercionKinds, coercionKindPredTy,
+        coercionKind, coercionKinds, coercionKindPredTy, isIdentityCoercion,
 
 	-- ** Equality predicates
 	isEqPred, mkEqPred, getEqPredTys, isEqPredTy,  
@@ -46,7 +46,7 @@ module Coercion (
 
 	-- * CoercionI
 	CoercionI(..),
-	isIdentityCoercion,
+	isIdentityCoI,
 	mkSymCoI, mkTransCoI, 
 	mkTyConAppCoI, mkAppTyCoI, mkFunTyCoI,
 	mkForAllTyCoI,
@@ -184,6 +184,12 @@ coercionKinds :: [Coercion] -> ([Type], [Type])
 coercionKinds tys = unzip $ map coercionKind tys
 
 -------------------------------------
+isIdentityCoercion :: Coercion -> Bool
+isIdentityCoercion co  
+  = case coercionKind co of
+       (t1,t2) -> t1 `coreEqType` t2
+
+-------------------------------------
 -- Coercion kind and type mk's
 -- (make saturated TyConApp CoercionTyCon{...} args)
 
@@ -580,13 +586,13 @@ instance Outputable CoercionI where
   ppr IdCo     = ptext (sLit "IdCo")
   ppr (ACo co) = ppr co
 
-isIdentityCoercion :: CoercionI -> Bool
-isIdentityCoercion IdCo = True
-isIdentityCoercion _    = False
+isIdentityCoI :: CoercionI -> Bool
+isIdentityCoI IdCo = True
+isIdentityCoI _    = False
 
 -- | Tests whether all the given 'CoercionI's represent the identity coercion
-allIdCos :: [CoercionI] -> Bool
-allIdCos = all isIdentityCoercion
+allIdCoIs :: [CoercionI] -> Bool
+allIdCoIs = all isIdentityCoI
 
 -- | For each 'CoercionI' in the input list, return either the 'Coercion' it
 -- contains or the corresponding 'Type' from the other list
@@ -615,8 +621,8 @@ mkTransCoI (ACo co1) (ACo co2) = ACo $ mkTransCoercion co1 co2
 -- | Smart constructor for type constructor application on 'CoercionI', see also 'mkAppCoercion'
 mkTyConAppCoI :: TyCon -> [Type] -> [CoercionI] -> CoercionI
 mkTyConAppCoI tyCon tys cois
-  | allIdCos cois = IdCo
-  | otherwise	  = ACo (TyConApp tyCon (zipCoArgs cois tys))
+  | allIdCoIs cois = IdCo
+  | otherwise	   = ACo (TyConApp tyCon (zipCoArgs cois tys))
 
 -- | Smart constructor for honest-to-god 'Coercion' application on 'CoercionI', see also 'mkAppCoercion'
 mkAppTyCoI :: Type -> CoercionI -> Type -> CoercionI -> CoercionI
@@ -645,8 +651,8 @@ fromACo (ACo co) = co
 -- > mkClassPPredCoI cls tys cois :: PredTy (cls tys) ~ PredTy (cls (tys `cast` cois))
 mkClassPPredCoI :: Class -> [Type] -> [CoercionI] -> CoercionI
 mkClassPPredCoI cls tys cois 
-  | allIdCos cois = IdCo
-  | otherwise     = ACo $ PredTy $ ClassP cls (zipCoArgs cois tys)
+  | allIdCoIs cois = IdCo
+  | otherwise      = ACo $ PredTy $ ClassP cls (zipCoArgs cois tys)
 
 -- | Smart constructor for implicit parameter 'Coercion's on 'CoercionI'. Similar to 'mkClassPPredCoI'
 mkIParamPredCoI :: (IPName Name) -> CoercionI -> CoercionI