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