Repository : ssh://darcs.haskell.org//srv/darcs/ghc On branch : supercompiler
http://hackage.haskell.org/trac/ghc/changeset/64667edfaf92756b0a9a2c65a688accfb99d8bdd >--------------------------------------------------------------- commit 64667edfaf92756b0a9a2c65a688accfb99d8bdd Author: Max Bolingbroke <batterseapo...@hotmail.com> 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 _______________________________________________ Cvs-ghc mailing list Cvs-ghc@haskell.org http://www.haskell.org/mailman/listinfo/cvs-ghc
