[commit: ghc] supercompiler: Correctly update type of a Case when pushing frames inside it (6cb88f4)

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

On branch  : supercompiler

http://hackage.haskell.org/trac/ghc/changeset/6cb88f4096c9c8d9416abeed0c7273a7cc9ac012

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

commit 6cb88f4096c9c8d9416abeed0c7273a7cc9ac012
Author: Max Bolingbroke <[email protected]>
Date:   Tue Jul 17 15:03:16 2012 +0100

    Correctly update type of a Case when pushing frames inside it

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

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

diff --git a/compiler/supercompile/Supercompile/Drive/Split2.hs b/compiler/supercompile/Supercompile/Drive/Split2.hs
index 312c28f..b84b5e3 100644
--- a/compiler/supercompile/Supercompile/Drive/Split2.hs
+++ b/compiler/supercompile/Supercompile/Drive/Split2.hs
@@ -623,6 +623,9 @@ splitPureHeap ids h = (M.fromDistinctAscList [ (HeapContext x', fmap fst mb_spli
                                              | (x', mb_split_hb) <- M.toAscList split_h ],
                        \generalised marked -> (\f -> M.mapWithKey f h) $ \x' hb -> if HeapContext x' `S.member` marked then hb else if HeapContext x' `S.member` generalised then generalisedLambdaBound else lambdaBound, -- FIXME: bugger around with howToBindCheap?
                        \h_prep -> (\f -> M.mapMaybe f split_h) $ \mb_split_hb -> do
+                                    -- TODO: we could only include in the output those bindings that are either NOT marked for inlining,
+                                    -- or are cheap (and thus had marking forced regardless of whether they are used in the residual).
+                                    -- Similarly, it would be cool to exclude bindings arising from the first update frame to avoid messiness in recurseHeap
                                     (_, (how_bound, mk_e)) <- mb_split_hb
                                     guard (how_bound == InternallyBound)
                                     return (mk_e h_prep))
@@ -665,7 +668,7 @@ splitStack ids k mb_scrut = go (fmap (\x' -> ((Uncast, x'), [])) mb_scrut, 0, []
           CoApply co'                  -> (Nothing, Nothing, False, varEdges ManyEntries (tyCoVarsOfCo co'), \_ _ -> CoApply co')
           Apply x'                     -> (Nothing, Nothing, False, M.singleton (HeapContext x') ManyEntries, \_ _ -> Apply x')
           Scrutinise x' ty' (rn, alts) -> (Nothing, Nothing, True, varBndrEdges x' $ foldr plusEntered M.empty alts_verts,
-                                           \h_prep k_prep -> Scrutinise x' ty' (map (($ k_prep) . ($ h_prep)) mk_alts))
+                                           \h_prep k_prep -> Scrutinise x' (stackType (lookupStackPrep next_frame k_prep) ty') (map (($ k_prep) . ($ h_prep)) mk_alts))
             where any_scrut_live = any (not . isDeadBinder . snd) scruts_flat
                   
                   -- These lines achieve two things: