X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Ftypecheck%2FTcHsType.lhs;h=4d3224c596d1643ff60f2cf5031a01944aeb92bb;hp=6f92e4b4384ba6e9de40b3ae92c6fddd90e6bad7;hb=654a1ba16e47d3ddabeb74b809ee6097c0770d35;hpb=ae52214482136fdeaaf9d741cf1211cf3cdce5c6

diff --git a/compiler/typecheck/TcHsType.lhs b/compiler/typecheck/TcHsType.lhs
index 6f92e4b..4d3224c 100644
--- a/compiler/typecheck/TcHsType.lhs
+++ b/compiler/typecheck/TcHsType.lhs
@@ -388,13 +388,21 @@ kc_pred :: HsPred Name -> TcM (HsPred Name, TcKind)
 	-- Does *not* check for a saturated
 	-- application (reason: used from TcDeriv)
 kc_pred pred@(HsIParam name ty)
-  = kcHsType ty		`thenM` \ (ty', kind) ->
-    returnM (HsIParam name ty', kind)
-
+  = do { (ty', kind) <- kcHsType ty
+       ; returnM (HsIParam name ty', kind)
+       }
 kc_pred pred@(HsClassP cls tys)
-  = kcClass cls			`thenM` \ kind ->
-    kcApps kind (ppr cls) tys	`thenM` \ (tys', res_kind) ->
-    returnM (HsClassP cls tys', res_kind)
+  = do { kind <- kcClass cls
+       ; (tys', res_kind) <- kcApps kind (ppr cls) tys
+       ; returnM (HsClassP cls tys', res_kind)
+       }
+kc_pred pred@(HsEqualP ty1 ty2)
+  = do { (ty1', kind1) <- kcHsType ty1
+       ; checkExpectedKind ty1 kind1 liftedTypeKind
+       ; (ty2', kind2) <- kcHsType ty2
+       ; checkExpectedKind ty2 kind2 liftedTypeKind
+       ; returnM (HsEqualP ty1 ty2, liftedTypeKind)
+       }
 
 ---------------------------
 kcTyVar :: Name -> TcM TcKind
@@ -534,13 +542,19 @@ dsHsLPred :: LHsPred Name -> TcM PredType
 dsHsLPred pred = dsHsPred (unLoc pred)
 
 dsHsPred pred@(HsClassP class_name tys)
-  = dsHsTypes tys			`thenM` \ arg_tys ->
-    tcLookupClass class_name		`thenM` \ clas ->
-    returnM (ClassP clas arg_tys)
-
+  = do { arg_tys <- dsHsTypes tys
+       ; clas <- tcLookupClass class_name
+       ; returnM (ClassP clas arg_tys)
+       }
+dsHsPred pred@(HsEqualP ty1 ty2)
+  = do { arg_ty1 <- dsHsType ty1
+       ; arg_ty2 <- dsHsType ty2
+       ; returnM (EqPred arg_ty1 arg_ty2)
+       }
 dsHsPred (HsIParam name ty)
-  = dsHsType ty					`thenM` \ arg_ty ->
-    returnM (IParam name arg_ty)
+  = do { arg_ty <- dsHsType ty
+       ; returnM (IParam name arg_ty)
+       }
 \end{code}
 
 GADT constructor signatures