Commit a27056f9 authored by Ben Gamari's avatar Ben Gamari Committed by Ben Gamari
Browse files

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
parent 6f990c54
...@@ -316,7 +316,7 @@ eqMiddleWith dflags eqBid env a b = ...@@ -316,7 +316,7 @@ eqMiddleWith dflags eqBid env a b =
-- result registers aren't compared since they are binding occurrences -- result registers aren't compared since they are binding occurrences
(CmmUnsafeForeignCall t1 _ a1, CmmUnsafeForeignCall t2 _ a2) -> (CmmUnsafeForeignCall t1 _ a1, CmmUnsafeForeignCall t2 _ a2) ->
let eq = t1 == t2 let eq = t1 == t2
&& and (zipWith (eqExprWith eqBid env) a1 a2) && eqLists (eqExprWith eqBid env) a1 a2
in (env', eq) in (env', eq)
_ -> (env, False) _ -> (env, False)
...@@ -326,6 +326,11 @@ eqMiddleWith dflags eqBid env a b = ...@@ -326,6 +326,11 @@ eqMiddleWith dflags eqBid env a b =
defd_a = foldLocalRegsDefd dflags (flip (:)) [] a defd_a = foldLocalRegsDefd dflags (flip (:)) [] a
defd_b = foldLocalRegsDefd dflags (flip (:)) [] b 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) eqExprWith :: (BlockId -> BlockId -> Bool)
-> LocalRegMapping -> LocalRegMapping
-> CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr
...@@ -340,7 +345,7 @@ eqExprWith eqBid env = eq ...@@ -340,7 +345,7 @@ eqExprWith eqBid env = eq
CmmStackSlot a1 i1 `eq` CmmStackSlot a2 i2 = eqArea a1 a2 && i1==i2 CmmStackSlot a1 i1 `eq` CmmStackSlot a2 i2 = eqArea a1 a2 && i1==i2
_e1 `eq` _e2 = False _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] -- See Note [Equivalence up to local registers in CBE]
CmmLocal a `eqReg` CmmLocal b CmmLocal a `eqReg` CmmLocal b
...@@ -399,7 +404,7 @@ eqLastWith eqBid env a b = ...@@ -399,7 +404,7 @@ eqLastWith eqBid env a b =
(CmmForeignCall t1 _ a1 s1 ret_args1 ret_off1 intrbl1, (CmmForeignCall t1 _ a1 s1 ret_args1 ret_off1 intrbl1,
CmmForeignCall t2 _ a2 s2 ret_args2 ret_off2 intrbl2) -> CmmForeignCall t2 _ a2 s2 ret_args2 ret_off2 intrbl2) ->
t1 == t2 t1 == t2
&& and (zipWith (eqExprWith eqBid env) a1 a2) && eqLists (eqExprWith eqBid env) a1 a2
&& s1 == s2 && s1 == s2
&& ret_args1 == ret_args2 && ret_args1 == ret_args2
&& ret_off1 == ret_off2 && ret_off1 == ret_off2
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment