[commit: ghc] master: Fix bug in 88a6f863d9f127fc1b03a1e2f068fd20ecbe096c (#7366) (24b4bfb)

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