Repository : ssh://darcs.haskell.org//srv/darcs/ghc On branch : supercompiler
http://hackage.haskell.org/trac/ghc/changeset/8388dd29c803ca8800beeea5e00dd5c6e3b398e0 >--------------------------------------------------------------- commit 8388dd29c803ca8800beeea5e00dd5c6e3b398e0 Author: Max Bolingbroke <batterseapo...@hotmail.com> Date: Fri Oct 19 16:24:40 2012 +0100 Fix bug in cheap node shortcutting that was pessimising the splitter >--------------------------------------------------------------- compiler/supercompile/Supercompile/Drive/Split2.hs | 7 ++++--- 1 files changed, 4 insertions(+), 3 deletions(-) diff --git a/compiler/supercompile/Supercompile/Drive/Split2.hs b/compiler/supercompile/Supercompile/Drive/Split2.hs index 51b412e..7a9041b 100644 --- a/compiler/supercompile/Supercompile/Drive/Split2.hs +++ b/compiler/supercompile/Supercompile/Drive/Split2.hs @@ -57,7 +57,7 @@ shortcutEdges :: forall node edge. Ord node => (node -> Bool) -> (edge -> edge -> edge) -- Used to join edges if after shortcutting there is more than one path from a node to another one - -> (edge -> node -> edge -> edge) -- Used when joining two edges in a contiguous path + -> (edge -> node -> edge -> edge) -- Used when joining two edges in a contiguous path (the node always satisfys the predicate) -> LGraph node edge -> LGraph node edge shortcutEdges should_shortcut combine_edges combine g = State.evalState visit_graph M.empty @@ -464,7 +464,8 @@ type PushedFocus = PushFocus PushedQA State push :: S.Set Context -> (Heap, Stack, PushFocus (Anned QA) (In AnnedTerm)) -> (PushedHeap, PushedStack, PushedFocus) -push generalised (Heap h ids, k, focus) = (h', k', focus') +push generalised (Heap h ids, k, focus) = -- pprTrace "push" (ppr verts $$ ppr marked) + (h', k', focus') where -- TODO: arguably I should try to get a QA for the thing in the focus. This will help in cases like where we MSG together: -- < H | v | > -- and: @@ -498,7 +499,7 @@ push generalised (Heap h ids, k, focus) = (h', k', focus') cheap_marked = S.fromDistinctAscList [HeapContext x' | (x', hb) <- M.toAscList h, maybe True (termIsCheap . snd) (heapBindingTerm hb)] S.\\ generalised verts = trimUnreachable FocusContext $ shortcutEdges (`S.member` cheap_marked) - plusEntries (\ent1 _ ent2 -> ent1 `plusEntries` ent2) + plusEntries (\ent1 _ _ent2 -> ent1) -- NB: we discard ent2. Consider inlining binding (x = Just y) [which marks y as Many] into context (case x of Just y -> ...) [which marks x as Once]. We don't want to mark y with Many (i.e. Once+Many) because we can in fact push it down safely. (verts_h `unionDisjoint` (verts_k `unionDisjoint` verts_focus)) extra_marked = solve generalised verts marked = cheap_marked `S.union` extra_marked _______________________________________________ Cvs-ghc mailing list Cvs-ghc@haskell.org http://www.haskell.org/mailman/listinfo/cvs-ghc
