[commit: ghc] supercompiler: Fix critical bug where FVs of generalised stack tails would not be sucked (64667ed)

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

On branch  : supercompiler

http://hackage.haskell.org/trac/ghc/changeset/64667edfaf92756b0a9a2c65a688accfb99d8bdd

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

commit 64667edfaf92756b0a9a2c65a688accfb99d8bdd
Author: Max Bolingbroke <[email protected]>
Date:   Fri Oct 19 12:23:41 2012 +0100

    Fix critical bug where FVs of generalised stack tails would not be sucked

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

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

diff --git a/compiler/supercompile/Supercompile/Drive/MSG.hs b/compiler/supercompile/Supercompile/Drive/MSG.hs
index a702cc0..935d48f 100644
--- a/compiler/supercompile/Supercompile/Drive/MSG.hs
+++ b/compiler/supercompile/Supercompile/Drive/MSG.hs
@@ -1152,7 +1152,7 @@ initStack xs i (Car kf_l k_l) (Car kf_r k_r) = do
       _ -> return (xs, Nothing, Nothing)
     let suck = initSuckStackFrame i mb_x kf_l kf_r
     liftM (\(mxs, k_lrs, sucks) -> (maybe id (:) mb_mx mxs, liftA2 (\kf_lr (k_avail_lr, k_lr) -> (kf_lr `Car` k_avail_lr, k_lr)) (Pair kf_l kf_r) k_lrs, IM.insert i suck sucks)) $ initStack xs (i + 1) k_l k_r
-initStack _ _ k_l k_r = return ([], Pair (Loco (stackGeneralised k_l), k_l) (Loco (stackGeneralised k_r), k_r), IM.empty)
+initStack _ i k_l k_r = return ([], Pair (Loco (stackGeneralised k_l), k_l) (Loco (stackGeneralised k_r), k_r), IM.singleton i (sucks2 $ fmap stackFreeVars (Pair k_l k_r)))
 
 initSuckStackFrame :: Int -> Maybe (Var {- partial loop -}, Pair Var) -> Tagged StackFrame -> Tagged StackFrame -> MSGU ()
 initSuckStackFrame i mb_x (Tagged tg_l kf_l) (Tagged tg_r kf_r) = do