[commit: packages/hoopl] master: Fix dominator join function. (a833a36)

[git at git.haskell.org]

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

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

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

commit a833a369dd387d6fcadfa010b91ead6ea9c08932
Author: Ben Karel <eschew at gmail.com>
Date:   Sun Dec 25 08:55:51 2016 -0500

    Fix dominator join function.


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

a833a369dd387d6fcadfa010b91ead6ea9c08932
 src/Compiler/Hoopl/Passes/Dominator.hs | 12 +++---------
 1 file changed, 3 insertions(+), 9 deletions(-)

diff --git a/src/Compiler/Hoopl/Passes/Dominator.hs b/src/Compiler/Hoopl/Passes/Dominator.hs
index 19fc833..1926cb1 100644
--- a/src/Compiler/Hoopl/Passes/Dominator.hs
+++ b/src/Compiler/Hoopl/Passes/Dominator.hs
@@ -13,6 +13,7 @@ module Compiler.Hoopl.Passes.Dominator
 where
 
 import Data.Maybe
+import qualified Data.Set as Set
 
 import Compiler.Hoopl
 
@@ -47,15 +48,8 @@ domLattice = addPoints "dominators" extend
 extend :: JoinFun DPath
 extend _ (OldFact (DPath l)) (NewFact (DPath l')) =
                                 (changeIf (l `lengthDiffers` j), DPath j)
-    where j = lcs l l'
-          lcs :: [Label] -> [Label] -> [Label] -- longest common suffix
-          lcs l l' | length l > length l' = lcs (drop (length l - length l') l) l'
-                   | length l < length l' = lcs l' l
-                   | otherwise = dropUnlike l l' l
-          dropUnlike [] [] maybe_like = maybe_like
-          dropUnlike (x:xs) (y:ys) maybe_like =
-              dropUnlike xs ys (if x == y then maybe_like else xs)
-          dropUnlike _ _ _ = error "this can't happen"
+    where j = filter (\elem -> Set.member elem common) l
+          common = Set.intersection (Set.fromList l) (Set.fromList l')
 
           lengthDiffers [] [] = False
           lengthDiffers (_:xs) (_:ys) = lengthDiffers xs ys