Commits (6)
# Changelog for [`hoopl` package](http://hackage.haskell.org/package/hoopl)
## 3.10.2.2 *Feb 2017*
This release includes non-API changes.
- Use cabal builtin options to enable test coverage
- Move up the constraints of base and containers
- Refactor the references of the fold family functions to their equivalant foldr functions.
- Drop the support for 7.0.1
- Fix a bug that drops out dominators when joined DPATHs have non-shared nodes in the middle.
## 3.10.2.1 *Dec 2015*
This release includes only non-functional changes.
......
Name: hoopl
Version: 3.10.2.1
Version: 3.10.2.2
-- NOTE: Don't forget to update ./changelog.md
Description:
Higher-order optimization library
......
{-# LANGUAGE CPP, GADTs #-}
{-# OPTIONS_GHC -Wall -fno-warn-name-shadowing #-}
#if __GLASGOW_HASKELL__ >= 701
#if __GLASGOW_HASKELL__ >= 723
{-# LANGUAGE Safe #-}
#endif
......@@ -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,10 @@ 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 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
......