[commit: ghc] master: cmm/CBE: Fix a few more zip uses (a27056f)

[git at git.haskell.org]

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

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

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

commit a27056f9823f8bbe2302f1924b3ab38fd6752e37
Author: Ben Gamari <bgamari.foss at gmail.com>
Date:   Mon Nov 6 15:34:37 2017 -0500

    cmm/CBE: Fix a few more zip uses
    
    Ensure that we don't consider lists of equal length to be equal when
    they are not. I noticed these while working on the fix for #14361.
    
    Reviewers: austin, simonmar, michalt
    
    Reviewed By: michalt
    
    Subscribers: rwbarton, thomie
    
    GHC Trac Issues: #14361
    
    Differential Revision: https://phabricator.haskell.org/D4153


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

a27056f9823f8bbe2302f1924b3ab38fd6752e37
 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 b3a0b6f..c822078 100644
--- a/compiler/cmm/CmmCommonBlockElim.hs
+++ b/compiler/cmm/CmmCommonBlockElim.hs
@@ -316,7 +316,7 @@ eqMiddleWith dflags eqBid env a b =
      -- result registers aren't compared since they are binding occurrences
     (CmmUnsafeForeignCall t1 _ a1,  CmmUnsafeForeignCall t2 _ a2) ->
         let eq = t1 == t2
-              && and (zipWith (eqExprWith eqBid env) a1 a2)
+              && eqLists (eqExprWith eqBid env) a1 a2
         in (env', eq)
 
     _ -> (env, False)
@@ -326,6 +326,11 @@ eqMiddleWith dflags eqBid env a b =
     defd_a = foldLocalRegsDefd dflags (flip (:)) [] a
     defd_b = foldLocalRegsDefd dflags (flip (:)) [] b
 
+eqLists :: (a -> b -> Bool) -> [a] -> [b] -> Bool
+eqLists f (a:as) (b:bs) = f a b && eqLists f as bs
+eqLists _ []     []     = True
+eqLists _ _      _      = False
+
 eqExprWith :: (BlockId -> BlockId -> Bool)
            -> LocalRegMapping
            -> CmmExpr -> CmmExpr
@@ -340,7 +345,7 @@ eqExprWith eqBid env = 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 = eqLists eq xs ys
 
   -- See Note [Equivalence up to local registers in CBE]
   CmmLocal a `eqReg` CmmLocal b
@@ -399,7 +404,7 @@ eqLastWith eqBid env a b =
       (CmmForeignCall t1 _ a1 s1 ret_args1 ret_off1 intrbl1,
        CmmForeignCall t2 _ a2 s2 ret_args2 ret_off2 intrbl2) ->
              t1 == t2
-          && and (zipWith (eqExprWith eqBid env) a1 a2)
+          && eqLists (eqExprWith eqBid env) a1 a2
           && s1 == s2
           && ret_args1 == ret_args2
           && ret_off1 == ret_off2