X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Ftypecheck%2FTcBinds.lhs;h=d9f55874c07efb3d662d1c52452d53560fdfe1e0;hb=bf5153b43f3ba517163432d27061c32ae157b830;hp=9e60bbd47f29bb61f0bf384a7130be8183ed75be;hpb=43a2e4a26175b9dbf29e39b97f7d032ef00f9993;p=ghc-hetmet.git

diff --git a/compiler/typecheck/TcBinds.lhs b/compiler/typecheck/TcBinds.lhs
index 9e60bbd..d9f5587 100644
--- a/compiler/typecheck/TcBinds.lhs
+++ b/compiler/typecheck/TcBinds.lhs
@@ -56,6 +56,9 @@ import List
 import Util
 import BasicTypes
 import Outputable
+import FastString
+
+import Control.Monad
 \end{code}
 
 
@@ -141,11 +144,11 @@ tcLocalBinds (HsIPBinds (IPBinds ip_binds _)) thing_inside
 	-- I wonder if we should do these one at at time
 	-- Consider	?x = 4
 	--		?y = ?x + 1
-    tc_ip_bind (IPBind ip expr)
-      = newFlexiTyVarTy argTypeKind		`thenM` \ ty ->
-  	newIPDict (IPBindOrigin ip) ip ty	`thenM` \ (ip', ip_inst) ->
-  	tcMonoExpr expr ty			`thenM` \ expr' ->
-  	returnM (ip_inst, (IPBind ip' expr'))
+    tc_ip_bind (IPBind ip expr) = do
+        ty <- newFlexiTyVarTy argTypeKind
+        (ip', ip_inst) <- newIPDict (IPBindOrigin ip) ip ty
+        expr' <- tcMonoExpr expr ty
+        return (ip_inst, (IPBind ip' expr'))
 
 ------------------------
 tcValBinds :: TopLevelFlag 
@@ -575,9 +578,9 @@ tcMonoBinds binds sig_fn non_rec
 			 	-- A monomorphic binding for each term variable that lacks 
 				-- a type sig.  (Ones with a sig are already in scope.)
 
-	; binds' <- tcExtendIdEnv2 rhs_id_env $
+	; binds' <- tcExtendIdEnv2 rhs_id_env $ do
 		    traceTc (text "tcMonoBinds" <+> vcat [ ppr n <+> ppr id <+> ppr (idType id) 
-							 | (n,id) <- rhs_id_env]) `thenM_`
+							 | (n,id) <- rhs_id_env])
 		    mapM (wrapLocM tcRhs) tc_binds
 	; return (listToBag binds', mono_info) }
 
@@ -743,7 +746,7 @@ generalise dflags top_lvl bind_list sig_fn mono_infos lie_req
    	-- Check that signature type variables are OK
 	; final_qtvs <- checkSigsTyVars qtvs sigs
 
-	; returnM (final_qtvs, sig_lie, binds) }
+	; return (final_qtvs, sig_lie, binds) }
   where
     bndrs   = bndrNames mono_infos
     sigs    = [sig | (_, Just sig, _) <- mono_infos]
@@ -799,7 +802,7 @@ unifyCtxts (sig1 : sigs) 	-- Argument is always non-empty
 checkSigsTyVars :: [TcTyVar] -> [TcSigInfo] -> TcM [TcTyVar]
 checkSigsTyVars qtvs sigs 
   = do	{ gbl_tvs <- tcGetGlobalTyVars
-	; sig_tvs_s <- mappM (check_sig gbl_tvs) sigs
+	; sig_tvs_s <- mapM (check_sig gbl_tvs) sigs
 
 	; let	-- Sigh.  Make sure that all the tyvars in the type sigs
 		-- appear in the returned ty var list, which is what we are
@@ -811,15 +814,15 @@ checkSigsTyVars qtvs sigs
 		-- Here, 'a' won't appear in qtvs, so we have to add it
 	 	sig_tvs = foldl extendVarSetList emptyVarSet sig_tvs_s
 		all_tvs = varSetElems (extendVarSetList sig_tvs qtvs)
-	; returnM all_tvs }
+	; return all_tvs }
   where
     check_sig gbl_tvs (TcSigInfo {sig_id = id, sig_tvs = tvs, 
 				  sig_theta = theta, sig_tau = tau})
       = addErrCtxt (ptext SLIT("In the type signature for") <+> quotes (ppr id))	$
 	addErrCtxtM (sigCtxt id tvs theta tau)						$
 	do { tvs' <- checkDistinctTyVars tvs
-	   ; ifM (any (`elemVarSet` gbl_tvs) tvs')
-		 (bleatEscapedTvs gbl_tvs tvs tvs') 
+	   ; when (any (`elemVarSet` gbl_tvs) tvs')
+	          (bleatEscapedTvs gbl_tvs tvs tvs')
 	   ; return tvs' }
 
 checkDistinctTyVars :: [TcTyVar] -> TcM [TcTyVar]
@@ -1198,5 +1201,5 @@ missingSigWarn True  name ty
 	; addWarnTcM (env1, mk_msg tidy_ty) }
   where
     mk_msg ty = vcat [ptext SLIT("Definition but no type signature for") <+> quotes (ppr name),
-		      sep [ptext SLIT("Inferred type:") <+> ppr name <+> dcolon <+> ppr ty]]
+		      sep [ptext SLIT("Inferred type:") <+> pprHsVar name <+> dcolon <+> ppr ty]]
 \end{code}