[commit: ghc] supercompiler: Small tweak to MSG utility function (a509ad4)

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

On branch  : supercompiler

http://hackage.haskell.org/trac/ghc/changeset/a509ad47d2e9b6df73209d18546fd671f2425149

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

commit a509ad47d2e9b6df73209d18546fd671f2425149
Author: Max Bolingbroke <[email protected]>
Date:   Fri Apr 27 10:55:28 2012 +0100

    Small tweak to MSG utility function

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

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

diff --git a/compiler/supercompile/Supercompile/Drive/MSG.hs b/compiler/supercompile/Supercompile/Drive/MSG.hs
index 41961d0..2e6fb5c 100644
--- a/compiler/supercompile/Supercompile/Drive/MSG.hs
+++ b/compiler/supercompile/Supercompile/Drive/MSG.hs
@@ -1010,9 +1010,9 @@ msgPureHeap mm rn2 msg_e msg_s (Heap init_h_l init_ids_l) (Heap init_h_r init_id
                       -- 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 = second (\individual -> if x `M.member` h then return (used, Nothing) else individual) $ 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 liftM (second Just) 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),       return (used', Just hb))
+        Just hb | S.notMember x used -> (return (used', hb),               return (used', hb))
                 | otherwise          -> (lft "used heap binding (common)", lft "used heap binding (individual)")
           where used' | Just (_, e) <- heapBindingTerm hb
                       , not (termIsCheap e)
@@ -1022,7 +1022,7 @@ msgPureHeap mm rn2 msg_e msg_s (Heap init_h_l init_ids_l) (Heap init_h_r init_id
          -- 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 -> (lft "used stack binding (common)", if x `elemVarSet` k_bvs then return (used, Just lambdaBound) else lft "used stack binding (individual)")
+        Nothing -> (lft "used stack binding (common)", if x `elemVarSet` k_bvs then return (used, lambdaBound) else lft "used stack binding (individual)")
      where lft msg = Left (msg ++ ": " ++ showPpr x)
 
     suck :: PureHeap -> BoundVars -> PureHeap -> Var -> (S.Set Var, Maybe HeapBinding) -> MSG' (S.Set Var, PureHeap)