[commit: ghc] supercompiler: Ensure we can copy in lambdaBound bindigns for update frames in MSG (56c89c4)

Repository : ssh://darcs.haskell.org//srv/darcs/ghc

On branch  : supercompiler

http://hackage.haskell.org/trac/ghc/changeset/56c89c4098aa8679e5ad45b4db81de3b414f3ef5

>---------------------------------------------------------------

commit 56c89c4098aa8679e5ad45b4db81de3b414f3ef5
Author: Max Bolingbroke <[email protected]>
Date:   Wed Apr 18 18:48:45 2012 +0100

    Ensure we can copy in lambdaBound bindigns for update frames in MSG

>---------------------------------------------------------------

 compiler/supercompile/Supercompile/Drive/MSG.hs |    8 ++++----
 1 files changed, 4 insertions(+), 4 deletions(-)

diff --git a/compiler/supercompile/Supercompile/Drive/MSG.hs b/compiler/supercompile/Supercompile/Drive/MSG.hs
index dd08bff..b8bbe2a 100644
--- a/compiler/supercompile/Supercompile/Drive/MSG.hs
+++ b/compiler/supercompile/Supercompile/Drive/MSG.hs
@@ -509,10 +509,10 @@ msgPureHeap {- mm -} rn2 msg_s init_h_l init_h_r (k_bvs_l, k_fvs_l) (k_bvs_r, k_
                       -- Nothing      ==> unavailable for individual heap
                       -- Just Nothing ==> available for individual heap but already in it
                       -- Just Just    ==> available for individual heap and not in it yet
-    find init_h k_bvs h used x = case M.lookup x init_h of
+    find init_h k_bvs h used x = second (\individual -> if x `M.member` h then return (used, Nothing) else individual) $ case M.lookup x init_h of
          -- Variable bound by the heap (vastly common case):
-        Just hb | S.notMember x used -> (return (used', hb),  if x `M.member` h then return (used, Nothing) else return (used', Just hb))
-                | otherwise          -> (Left "used heap binding", if x `M.member` h then return (used, Nothing) else Left "used heap binding")
+        Just hb | S.notMember x used -> (return (used', hb),       return (used', Just hb))
+                | otherwise          -> (Left "used heap binding", Left "used heap binding")
           where used' | Just (_, e) <- heapBindingTerm hb
                       , not (termIsCheap e)
                       = S.insert x used
@@ -521,7 +521,7 @@ msgPureHeap {- mm -} rn2 msg_s init_h_l init_h_r (k_bvs_l, k_fvs_l) (k_bvs_r, k_
          -- By a process of elimination, variable must be bound be the stack. Normally it will in fact be bound by the "instance" portion
          -- of the stack because matches involving the common portion variables either already failed or were discharged by RnEnv2, but
          -- if "find" is called by "sucks" then this may not necessarily be the case
-        Nothing -> (Left "used stack binding", if x `elemVarSet` k_bvs then return (used, Nothing) else Left $ "used stack binding")
+        Nothing -> (Left "used stack binding", if x `elemVarSet` k_bvs then return (used, Just lambdaBound) else Left "used stack binding")
 
     suck :: PureHeap -> BoundVars -> PureHeap -> Var -> (S.Set Var, Maybe HeapBinding) -> MSG' (S.Set Var, PureHeap)
     suck _      _     h _ (used, Nothing) = return (used, h)                                                                                   -- Already copied in