[commit: ghc] master: cmm/CBE: Fix comparison between blocks of different lengths (6f990c5)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/6f990c54f922beae80362fe62426beededc21290/ghc

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

commit 6f990c54f922beae80362fe62426beededc21290
Author: Ben Gamari <bgamari.foss at gmail.com>
Date:   Mon Nov 6 15:33:26 2017 -0500

    cmm/CBE: Fix comparison between blocks of different lengths
    
    Previously CBE computed equality by taking the lists of middle nodes of
    the blocks being compared and zipping them together. It would then map
    over this list with the equality relation, and accumulate the result.
    
    However, this is completely wrong: Consider what will happen when we
    compare a block with no middle nodes with one with one or more. The
    result of `zip` will be empty and consequently the pass may conclude
    that the two are indeed equivalent (if their last nodes also match).
    This is very bad and the cause of #14361.
    
    The solution I chose was just to write out an explicit recursion, like I
    distinctly recall considering doing when I first wrote this code.
    Unfortunately I was feeling clever at the time.
    
    Unfortunately this case was just rare enough not to be triggered by the
    testsuite. I still need to find a testcase that doesn't have external
    dependencies.
    
    Test Plan: Need to find a more minimal testcase
    
    Reviewers: austin, simonmar, michalt
    
    Reviewed By: michalt
    
    Subscribers: michalt, rwbarton, thomie, hvr
    
    GHC Trac Issues: #14361
    
    Differential Revision: https://phabricator.haskell.org/D4152


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

6f990c54f922beae80362fe62426beededc21290
 compiler/cmm/CmmCommonBlockElim.hs | 14 +++++++++-----
 1 file changed, 9 insertions(+), 5 deletions(-)

diff --git a/compiler/cmm/CmmCommonBlockElim.hs b/compiler/cmm/CmmCommonBlockElim.hs
index c83497e..b3a0b6f 100644
--- a/compiler/cmm/CmmCommonBlockElim.hs
+++ b/compiler/cmm/CmmCommonBlockElim.hs
@@ -371,11 +371,15 @@ eqBlockBodyWith dflags eqBid block block'
         (_,m',l') = blockSplit block'
         nodes'    = filter (not . dont_care) (blockToList m')
 
-        (env_mid, eqs_mid) =
-            List.mapAccumL (\acc (a,b) -> eqMiddleWith dflags eqBid acc a b)
-                           emptyUFM
-                           (List.zip nodes nodes')
-        equal = and eqs_mid && eqLastWith eqBid env_mid l l'
+        eqMids :: LocalRegMapping -> [CmmNode O O] -> [CmmNode O O] -> Bool
+        eqMids env (a:as) (b:bs)
+          | eq = eqMids env' as bs
+          where
+            (env', eq) = eqMiddleWith dflags eqBid env a b
+        eqMids env [] [] = eqLastWith eqBid env l l'
+        eqMids _ _ _ = False
+
+        equal = eqMids emptyUFM nodes nodes'
 
 
 eqLastWith :: (BlockId -> BlockId -> Bool) -> LocalRegMapping