[commit: ghc] ghc-8.4: CBE: re-introduce bgamari's fixes (af454c4)

[git at git.haskell.org]

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

On branch  : ghc-8.4
Link       : http://ghc.haskell.org/trac/ghc/changeset/af454c454a577ce20ee782a0b0e04dfcaeacb143/ghc

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

commit af454c454a577ce20ee782a0b0e04dfcaeacb143
Author: Michal Terepeta <michal.terepeta at gmail.com>
Date:   Sun Feb 18 11:09:40 2018 -0500

    CBE: re-introduce bgamari's fixes
    
    During some recent work on CBE we discovered that `zipWith` is used to
    check for equality, but that doesn't quite work if lists are of
    different lengths! This was fixed by bgamari, but unfortunately the fix
    had to be rolled back due to other changes in CBE in
    50adbd7c5fe5894d3e6e2a58b353ed07e5f8949d. Since I wanted to have another
    look at CBE anyway, we agreed that the first thing to do would be to
    re-introduce the fix.
    
    Sadly I don't have any actual test case that would exercise this.
    
    Signed-off-by: Michal Terepeta <michal.terepeta at gmail.com>
    
    Test Plan: ./validate
    
    Reviewers: bgamari, simonmar
    
    Reviewed By: bgamari
    
    Subscribers: rwbarton, thomie, carter
    
    GHC Trac Issues: #14226
    
    Differential Revision: https://phabricator.haskell.org/D4387
    
    (cherry picked from commit 4e513bf758c32804fc71b98215f96e8481697a36)


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

af454c454a577ce20ee782a0b0e04dfcaeacb143
 compiler/cmm/CmmCommonBlockElim.hs | 11 ++++++++---
 1 file changed, 8 insertions(+), 3 deletions(-)

diff --git a/compiler/cmm/CmmCommonBlockElim.hs b/compiler/cmm/CmmCommonBlockElim.hs
index f635520..7f4e290 100644
--- a/compiler/cmm/CmmCommonBlockElim.hs
+++ b/compiler/cmm/CmmCommonBlockElim.hs
@@ -209,7 +209,7 @@ eqMiddleWith eqBid (CmmStore l1 r1) (CmmStore l2 r2)
   = eqExprWith eqBid l1 l2 && eqExprWith eqBid r1 r2
 eqMiddleWith eqBid (CmmUnsafeForeignCall t1 r1 a1)
                    (CmmUnsafeForeignCall t2 r2 a2)
-  = t1 == t2 && r1 == r2 && and (zipWith (eqExprWith eqBid) a1 a2)
+  = t1 == t2 && r1 == r2 && eqListWith (eqExprWith eqBid) a1 a2
 eqMiddleWith _ _ _ = False
 
 eqExprWith :: (BlockId -> BlockId -> Bool)
@@ -224,7 +224,7 @@ eqExprWith eqBid = eq
   CmmStackSlot a1 i1 `eq` CmmStackSlot a2 i2 = eqArea a1 a2 && i1==i2
   _e1                `eq` _e2                = False
 
-  xs `eqs` ys = and (zipWith eq xs ys)
+  xs `eqs` ys = eqListWith eq xs ys
 
   eqLit (CmmBlock id1) (CmmBlock id2) = eqBid id1 id2
   eqLit l1 l2 = l1 == l2
@@ -247,7 +247,7 @@ eqBlockBodyWith eqBid block block'
         (_,m',l') = blockSplit block'
         nodes'    = filter (not . dont_care) (blockToList m')
 
-        equal = and (zipWith (eqMiddleWith eqBid) nodes nodes') &&
+        equal = eqListWith (eqMiddleWith eqBid) nodes nodes' &&
                 eqLastWith eqBid l l'
 
 
@@ -266,6 +266,11 @@ eqMaybeWith eltEq (Just e) (Just e') = eltEq e e'
 eqMaybeWith _ Nothing Nothing = True
 eqMaybeWith _ _ _ = False
 
+eqListWith :: (a -> b -> Bool) -> [a] -> [b] -> Bool
+eqListWith f (a : as) (b : bs) = f a b && eqListWith f as bs
+eqListWith _ []       []       = True
+eqListWith _ _        _        = False
+
 -- | Given a block map, ensure that all "target" blocks are covered by
 -- the same ticks as the respective "source" blocks. This not only
 -- means copying ticks, but also adjusting tick scopes where