X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FsimplCore%2FSimplEnv.lhs;h=462a697da36dc4cfea89151a7ea32e0fe0f17c9c;hb=6f27d4f8370610ac0672378a860a078d1679a8e7;hp=762758fadf308a8b48260dbebbddc94e96ec3f78;hpb=30c39066cfbbb9380fff1f3266405d37af798009;p=ghc-hetmet.git

diff --git a/compiler/simplCore/SimplEnv.lhs b/compiler/simplCore/SimplEnv.lhs
index 762758f..462a697 100644
--- a/compiler/simplCore/SimplEnv.lhs
+++ b/compiler/simplCore/SimplEnv.lhs
@@ -46,7 +46,7 @@ module SimplEnv (
 
 #include "HsVersions.h"
 
-import SimplMonad	
+import SimplMonad
 import IdInfo
 import CoreSyn
 import Rules
@@ -64,6 +64,7 @@ import Coercion
 import BasicTypes	
 import DynFlags
 import Util
+import MonadUtils
 import Outputable
 
 import Data.List
@@ -500,8 +501,8 @@ These functions are in the monad only so that they can be made strict via seq.
 \begin{code}
 simplBinders, simplLamBndrs
 	:: SimplEnv -> [InBndr] -> SimplM (SimplEnv, [OutBndr])
-simplBinders  env bndrs = mapAccumLSmpl simplBinder  env bndrs
-simplLamBndrs env bndrs = mapAccumLSmpl simplLamBndr env bndrs
+simplBinders  env bndrs = mapAccumLM simplBinder  env bndrs
+simplLamBndrs env bndrs = mapAccumLM simplLamBndr env bndrs
 
 -------------
 simplBinder :: SimplEnv -> InBndr -> SimplM (SimplEnv, OutBndr)
@@ -519,18 +520,19 @@ simplBinder env bndr
 -------------
 simplLamBndr :: SimplEnv -> Var -> SimplM (SimplEnv, Var)
 -- Used for lambda binders.  These sometimes have unfoldings added by
--- the worker/wrapper pass that must be preserved, becuase they can't
+-- the worker/wrapper pass that must be preserved, because they can't
 -- be reconstructed from context.  For example:
 --	f x = case x of (a,b) -> fw a b x
 --	fw a b x{=(a,b)} = ...
 -- The "{=(a,b)}" is an unfolding we can't reconstruct otherwise.
 simplLamBndr env bndr
-  | not (isId bndr && hasSomeUnfolding old_unf) = simplBinder env bndr	-- Normal case
-  | otherwise					= seqId id2 `seq` return (env', id2)
+  | isId bndr && hasSomeUnfolding old_unf = seqId id2 `seq` return (env2, id2)  -- Special case
+  | otherwise 				  = simplBinder env bndr	 	-- Normal case
   where
     old_unf = idUnfolding bndr
-    (env', id1) = substIdBndr env bndr
-    id2 = id1 `setIdUnfolding` substUnfolding env old_unf
+    (env1, id1) = substIdBndr env bndr
+    id2  = id1 `setIdUnfolding` substUnfolding env old_unf
+    env2 = modifyInScope env1 id1 id2
 
 ---------------
 simplNonRecBndr :: SimplEnv -> InBndr -> SimplM (SimplEnv, OutBndr)