X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FsimplCore%2FSimplify.lhs;h=3f3245935084eb61c3f8275f1a2dd30302525acd;hb=c412fa2e1a11ae4666bea97cd8d790ecf7fcb253;hp=89c5fb188d2511dec2128f9de2c594a15032fbb8;hpb=be7bf80fec1f471ceccbbe06885c265411baf25e;p=ghc-hetmet.git

diff --git a/compiler/simplCore/Simplify.lhs b/compiler/simplCore/Simplify.lhs
index 89c5fb1..3f32459 100644
--- a/compiler/simplCore/Simplify.lhs
+++ b/compiler/simplCore/Simplify.lhs
@@ -264,7 +264,7 @@ simplRecBind env top_lvl pairs
   where
     add_rules :: SimplEnv -> (InBndr,InExpr) -> (SimplEnv, (InBndr, OutBndr, InExpr))
 	-- Add the (substituted) rules to the binder
-    add_rules env (bndr, rhs) = (env, (bndr, bndr', rhs))
+    add_rules env (bndr, rhs) = (env', (bndr, bndr', rhs))
 	where
 	  (env', bndr') = addBndrRules env bndr (lookupRecBndr env bndr)
 
@@ -1027,12 +1027,10 @@ completeCall env var cont
 	------------- Next try inlining ----------------
 	{ let	arg_infos = [interestingArg arg | arg <- args, isValArg arg]
 		n_val_args = length arg_infos
-	      	interesting_cont = interestingCallContext (notNull args)
-						  	  (notNull arg_infos)
-						  	  call_cont
+	      	interesting_cont = interestingCallContext call_cont
 	 	active_inline = activeInline env var
-		maybe_inline  = callSiteInline dflags active_inline
-				       var arg_infos interesting_cont
+		maybe_inline  = callSiteInline dflags active_inline var
+				               (null args) arg_infos interesting_cont
 	; case maybe_inline of {
 	    Just unfolding  	-- There is an inlining!
 	      ->  do { tick (UnfoldingDone var)
@@ -1467,7 +1465,7 @@ simplCaseBinder env scrut case_bndr alts
 		-- See Note [no-case-of-case]
 	= (env, case_bndr)
 
-	| otherwise	-- Failed try [see Note 2 above]
+	| otherwise	-- Failed try; see Note [Suppressing the case binder-swap]
 			--     not (isEvaldUnfolding (idUnfolding v))
 	= case scrut of
 	    Var v -> (modifyInScope env1 v case_bndr', case_bndr')
@@ -1545,7 +1543,7 @@ simplAlts env scrut case_bndr alts cont'
     do	{ let alt_env = zapFloats env
 	; (alt_env, scrut', case_bndr') <- simplCaseBinder alt_env scrut case_bndr alts
 
-	; (imposs_deflt_cons, in_alts) <- prepareAlts scrut case_bndr' alts
+	; (imposs_deflt_cons, in_alts) <- prepareAlts alt_env scrut case_bndr' alts
 
 	; alts' <- mapM (simplAlt alt_env imposs_deflt_cons case_bndr' cont') in_alts
 	; return (scrut', case_bndr', alts') }