From: Twan van Laarhoven <twanvl@gmail.com>
Date: Thu, 17 Jan 2008 19:54:08 +0000 (+0000)
Subject: Monadify simplCore/Simplify: use do and return
X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=commitdiff_plain;h=145efe5483bba17e0ea9d55a9ab0aa891d3fc4de

Monadify simplCore/Simplify: use do and return
---

diff --git a/compiler/simplCore/Simplify.lhs b/compiler/simplCore/Simplify.lhs
index baf2a30..693f1a2 100644
--- a/compiler/simplCore/Simplify.lhs
+++ b/compiler/simplCore/Simplify.lhs
@@ -742,7 +742,7 @@ simplType :: SimplEnv -> InType -> SimplM OutType
 	-- Kept monadic just so we can do the seqType
 simplType env ty
   = -- pprTrace "simplType" (ppr ty $$ ppr (seTvSubst env)) $
-    seqType new_ty   `seq`   returnSmpl new_ty
+    seqType new_ty   `seq`   return new_ty
   where
     new_ty = substTy env ty
 \end{code}
@@ -939,8 +939,8 @@ simplNote env InlineMe e cont
 		-- (even a type application -- anything except Stop)
   = simplExprF env e cont
 
-simplNote env (CoreNote s) e cont
-  = simplExpr env e    `thenSmpl` \ e' ->
+simplNote env (CoreNote s) e cont = do
+    e' <- simplExpr env e
     rebuild env (Note (CoreNote s) e') cont
 \end{code}
 
@@ -1009,8 +1009,8 @@ completeCall env var cont
 				Just act_fn -> lookupRule act_fn in_scope 
 							  rules var args 
 	; case maybe_rule of {
-	    Just (rule, rule_rhs) -> 
-		tick (RuleFired (ru_name rule))			`thenSmpl_`
+	    Just (rule, rule_rhs) -> do
+		tick (RuleFired (ru_name rule))
 		(if dopt Opt_D_dump_rule_firings dflags then
 		   pprTrace "Rule fired" (vcat [
 			text "Rule:" <+> ftext (ru_name rule),
@@ -1019,8 +1019,8 @@ completeCall env var cont
 			text "Cont:  " <+> ppr call_cont])
 		 else
 			id)		$
-		simplExprF env rule_rhs (dropArgs (ruleArity rule) cont)
-		-- The ruleArity says how many args the rule consumed
+		 simplExprF env rule_rhs (dropArgs (ruleArity rule) cont)
+		 -- The ruleArity says how many args the rule consumed
 	
 	  ; Nothing -> do	-- No rules
 
@@ -1740,7 +1740,7 @@ mkDupableCont :: SimplEnv -> SimplCont
 
 mkDupableCont env cont
   | contIsDupable cont
-  = returnSmpl (env, cont, mkBoringStop (contResultType cont))
+  = return (env, cont, mkBoringStop (contResultType cont))
 
 mkDupableCont env (Stop {}) = panic "mkDupableCont" 	-- Handled by previous eqn