X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Ftypes%2FCoercion.lhs;h=3bc5d84541e201edeecfa5338efdde1bb318cb76;hb=8ad973aef4ff86b5a3e2aa6276d9dd8c99732eca;hp=b74a8af8b7bb518cff572a8c52aab1ac49fd9149;hpb=14ddfba2df68917958afb54142bb609c66fa2110;p=ghc-hetmet.git

diff --git a/compiler/types/Coercion.lhs b/compiler/types/Coercion.lhs
index b74a8af..3bc5d84 100644
--- a/compiler/types/Coercion.lhs
+++ b/compiler/types/Coercion.lhs
@@ -42,12 +42,15 @@ module Coercion (
         transCoercionTyCon, leftCoercionTyCon, 
         rightCoercionTyCon, instCoercionTyCon, -- needed by TysWiredIn
 
+        -- Comparison
+        coreEqCoercion,
+
 	-- CoercionI
 	CoercionI(..),
 	isIdentityCoercion,
 	mkSymCoI, mkTransCoI, 
 	mkTyConAppCoI, mkAppTyCoI, mkFunTyCoI,
-	mkNoteTyCoI, mkForAllTyCoI,
+	mkForAllTyCoI,
 	fromCoI, fromACo,
 	mkClassPPredCoI, mkIParamPredCoI, mkEqPredCoI
 
@@ -67,7 +70,7 @@ import Util
 import Unique
 import BasicTypes
 import Outputable
-
+import FastString
 
 type Coercion     = Type
 type CoercionKind = Kind	-- A CoercionKind is always of form (ty1 :=: ty2)
@@ -142,7 +145,6 @@ coercionKind (FunTy ty1 ty2)
 coercionKind (ForAllTy tv ty) 
   = let (ty1, ty2) = coercionKind ty in
     (ForAllTy tv ty1, ForAllTy tv ty2)
-coercionKind (NoteTy _ ty) = coercionKind ty
 coercionKind (PredTy (EqPred c1 c2)) 
   = let k1 = coercionKindPredTy c1
         k2 = coercionKindPredTy c2 in
@@ -436,18 +438,18 @@ unsafeCoercionTyCon
 --------------------------------------
 -- ...and their names
 
-mkCoConName :: FS.FastString -> Unique -> TyCon -> Name
+mkCoConName :: FastString -> Unique -> TyCon -> Name
 mkCoConName occ key coCon = mkWiredInName gHC_PRIM (mkOccNameFS tcName occ)
                             key (ATyCon coCon) BuiltInSyntax
 
 transCoercionTyConName, symCoercionTyConName, leftCoercionTyConName, rightCoercionTyConName, instCoercionTyConName, unsafeCoercionTyConName :: Name
 
-transCoercionTyConName = mkCoConName FSLIT("trans") transCoercionTyConKey transCoercionTyCon
-symCoercionTyConName   = mkCoConName FSLIT("sym") symCoercionTyConKey symCoercionTyCon
-leftCoercionTyConName  = mkCoConName FSLIT("left") leftCoercionTyConKey leftCoercionTyCon
-rightCoercionTyConName = mkCoConName FSLIT("right") rightCoercionTyConKey rightCoercionTyCon
-instCoercionTyConName  = mkCoConName FSLIT("inst") instCoercionTyConKey instCoercionTyCon
-unsafeCoercionTyConName = mkCoConName FSLIT("CoUnsafe") unsafeCoercionTyConKey unsafeCoercionTyCon
+transCoercionTyConName = mkCoConName (fsLit "trans") transCoercionTyConKey transCoercionTyCon
+symCoercionTyConName   = mkCoConName (fsLit "sym") symCoercionTyConKey symCoercionTyCon
+leftCoercionTyConName  = mkCoConName (fsLit "left") leftCoercionTyConKey leftCoercionTyCon
+rightCoercionTyConName = mkCoConName (fsLit "right") rightCoercionTyConKey rightCoercionTyCon
+instCoercionTyConName  = mkCoConName (fsLit "inst") instCoercionTyConKey instCoercionTyCon
+unsafeCoercionTyConName = mkCoConName (fsLit "CoUnsafe") unsafeCoercionTyConKey unsafeCoercionTyCon
 
 
 
@@ -482,6 +484,12 @@ splitNewTypeRepCo_maybe (TyConApp tc tys)
 			-- This case handled by coreView
 splitNewTypeRepCo_maybe _
   = Nothing
+
+-------------------------------------
+-- Syntactic equality of coercions
+
+coreEqCoercion :: Coercion -> Coercion -> Bool
+coreEqCoercion = coreEqType
 \end{code}
 
 
@@ -535,10 +543,6 @@ mkFunTyCoI _   IdCo _   IdCo = IdCo
 mkFunTyCoI ty1 coi1 ty2 coi2 =
 	ACo $ FunTy (fromCoI coi1 ty1) (fromCoI coi2 ty2)
 
-mkNoteTyCoI :: TyNote -> CoercionI -> CoercionI
-mkNoteTyCoI _ IdCo = IdCo
-mkNoteTyCoI note (ACo co) = ACo $ NoteTy note co
-
 mkForAllTyCoI :: TyVar -> CoercionI -> CoercionI
 mkForAllTyCoI _ IdCo = IdCo
 mkForAllTyCoI tv (ACo co) = ACo $ ForAllTy tv co