diff options
| author | Ben Gamari <bgamari.foss@gmail.com> | 2017-11-06 15:34:37 -0500 |
|---|---|---|
| committer | Ben Gamari <ben@smart-cactus.org> | 2017-11-06 15:34:38 -0500 |
| commit | a27056f9823f8bbe2302f1924b3ab38fd6752e37 (patch) | |
| tree | f91982ebd1176ebd666cc1f6fe72c159cabfc54d | |
| parent | 6f990c54f922beae80362fe62426beededc21290 (diff) | |
| download | haskell-a27056f9823f8bbe2302f1924b3ab38fd6752e37.tar.gz | |
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
| -rw-r--r-- | compiler/cmm/CmmCommonBlockElim.hs | 11 |
1 files changed, 8 insertions, 3 deletions
diff --git a/compiler/cmm/CmmCommonBlockElim.hs b/compiler/cmm/CmmCommonBlockElim.hs index b3a0b6ffa4..c8220787d7 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 |