Repository : ssh://darcs.haskell.org//srv/darcs/ghc On branch : master
http://hackage.haskell.org/trac/ghc/changeset/24b4bfbcb320670a62dad10009d43f06211a5a2a >--------------------------------------------------------------- commit 24b4bfbcb320670a62dad10009d43f06211a5a2a Author: Simon Marlow <[email protected]> Date: Thu Oct 25 09:25:49 2012 +0100 Fix bug in 88a6f863d9f127fc1b03a1e2f068fd20ecbe096c (#7366) >--------------------------------------------------------------- compiler/cmm/CmmSink.hs | 40 ++++++++++++++++++++-------------------- 1 files changed, 20 insertions(+), 20 deletions(-) diff --git a/compiler/cmm/CmmSink.hs b/compiler/cmm/CmmSink.hs index ad70b96..9565fec 100644 --- a/compiler/cmm/CmmSink.hs +++ b/compiler/cmm/CmmSink.hs @@ -365,23 +365,31 @@ tryToInline dflags live node assigs = go usages node [] assigs go _usages node _skipped [] = (node, []) go usages node skipped (a@(l,rhs,_) : rest) - | can_inline = inline_and_discard - | isTrivial rhs = inline_and_keep + | cannot_inline = dont_inline + | occurs_once = inline_and_discard + | isTrivial rhs = inline_and_keep + | otherwise = dont_inline where - inline_and_discard = go usages' node' skipped rest + inline_and_discard = go usages' inl_node skipped rest + where usages' = foldRegsUsed addUsage usages rhs - inline_and_keep = (node'', a : rest') - where (node'',rest') = go usages' node' (l:skipped) rest + dont_inline = keep node -- don't inline the assignment, keep it + inline_and_keep = keep inl_node -- inline the assignment, keep it - can_inline = - not (l `elemRegSet` live) - && not (skipped `regsUsedIn` rhs) -- Note [dependent assignments] - && okToInline dflags rhs node - && lookupUFM usages l == Just 1 + keep node' = (final_node, a : rest') + where (final_node, rest') = go usages' node' (l:skipped) rest + usages' = foldRegsUsed (\m r -> addToUFM m r 2) usages rhs + -- we must not inline anything that is mentioned in the RHS + -- of a binding that we have already skipped, so we set the + -- usages of the regs on the RHS to 2. - usages' = foldRegsUsed addUsage usages rhs + cannot_inline = skipped `regsUsedIn` rhs -- Note [dependent assignments] + || not (okToInline dflags rhs node) - node' = mapExpDeep inline node + occurs_once = not (l `elemRegSet` live) + && lookupUFM usages l == Just 1 + + inl_node = mapExpDeep inline node where inline (CmmReg (CmmLocal l')) | l == l' = rhs inline (CmmRegOff (CmmLocal l') off) | l == l' = cmmOffset dflags rhs off @@ -389,14 +397,6 @@ tryToInline dflags live node assigs = go usages node [] assigs inline (CmmMachOp op args) = cmmMachOpFold dflags op args inline other = other - go usages node skipped (assig@(l,rhs,_) : rest) - = (node', assig : rest') - where (node', rest') = go usages' node (l:skipped) rest - usages' = foldRegsUsed (\m r -> addToUFM m r 2) usages rhs - -- we must not inline anything that is mentioned in the RHS - -- of a binding that we have already skipped, so we set the - -- usages of the regs on the RHS to 2. - -- Note [dependent assignments] -- -- If our assignment list looks like _______________________________________________ Cvs-ghc mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-ghc
