[commit: packages/hoopl] master: Improve fix to handle irreducible CFGs. (ef24795)

[git at git.haskell.org]

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

On branch  : master
Link       : http://git.haskell.org/packages/hoopl.git/commitdiff/ef24795cdc25415ffa79e8bcefe8ea1f5d6d151c

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

commit ef24795cdc25415ffa79e8bcefe8ea1f5d6d151c
Author: Ben Karel <eschew at gmail.com>
Date:   Sat Feb 11 16:57:12 2017 -0500

    Improve fix to handle irreducible CFGs.


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

ef24795cdc25415ffa79e8bcefe8ea1f5d6d151c
 src/Compiler/Hoopl/Passes/Dominator.hs | 4 +++-
 1 file changed, 3 insertions(+), 1 deletion(-)

diff --git a/src/Compiler/Hoopl/Passes/Dominator.hs b/src/Compiler/Hoopl/Passes/Dominator.hs
index 7cd8b7e..2d87962 100644
--- a/src/Compiler/Hoopl/Passes/Dominator.hs
+++ b/src/Compiler/Hoopl/Passes/Dominator.hs
@@ -48,8 +48,10 @@ domLattice = addPoints "dominators" extend
 extend :: JoinFun DPath
 extend _ (OldFact (DPath l)) (NewFact (DPath l')) =
                                 (changeIf (l `lengthDiffers` j), DPath j)
-    where j = filter (\elem -> Set.member elem common) l
+    where lx = filter (\elem -> Set.member elem common) l
+          rx = filter (\elem -> Set.member elem common) l'
           common = Set.intersection (Set.fromList l) (Set.fromList l')
+          j = [x | (x, y) <- zip lx rx, x == y]
 
           lengthDiffers [] [] = False
           lengthDiffers (_:xs) (_:ys) = lengthDiffers xs ys