module Algorithm.Dominance
    (domFrontier) where

import qualified Data.Graph.Dom                as G
import           Data.IntMap                    ( (!) )
import           Data.IntSet                    ( IntSet )
import qualified Data.IntSet                   as IS
import qualified Data.IntMap as IM
import Base (orElse)

-- Computes the dominance frontier
-- see https://www.ed.tus.ac.jp/j-mune/keio/m/ssa2.pdf
domFrontier :: G.Graph -> G.Graph -> Int -> IS.IntSet
domFrontier :: Graph -> Graph -> Int -> IntSet
domFrontier Graph
g Graph
tree Int
n = IntSet -> IntSet -> IntSet
IS.union IntSet
df_local IntSet
df_up
 where
  -- the local part DF_{local}
  -- "idom y = n" is determined by looking up the edge (n,y) in the dominance tree
  df_local :: IntSet
df_local = (Int -> Bool) -> IntSet -> IntSet
IS.filter (Bool -> Bool
not (Bool -> Bool) -> (Int -> Bool) -> Int -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Graph -> Int -> Int -> Bool
is_edge Graph
tree Int
n) (IntSet -> IntSet) -> IntSet -> IntSet
forall a b. (a -> b) -> a -> b
$ Int -> Graph -> IntSet
succ Int
n Graph
g
  -- the up part DF_{up}
  df_up :: IntSet
df_up = [IntSet] -> IntSet
forall (f :: * -> *). Foldable f => f IntSet -> IntSet
IS.unions ([IntSet] -> IntSet) -> [IntSet] -> IntSet
forall a b. (a -> b) -> a -> b
$ Int -> IntSet
get_df_up_child (Int -> IntSet) -> [Int] -> [IntSet]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IntSet -> [Int]
IS.toList (Int -> Graph -> IntSet
succ Int
n Graph
tree)
  get_df_up_child :: Int -> IntSet
get_df_up_child Int
c =
    let df_children :: IntSet
df_children = Graph -> Graph -> Int -> IntSet
domFrontier Graph
g Graph
tree Int
c in
      (Int -> Bool) -> IntSet -> IntSet
IS.filter (Bool -> Bool
not (Bool -> Bool) -> (Int -> Bool) -> Int -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int -> Bool
strictly_dominates Int
n) IntSet
df_children
  -- does n strictly dominate w?
  -- See if w is reachable from n in the dominance tree, i.e., if n is an ancestor of w.
  dominates :: Int -> Int -> Bool
dominates Int
n Int
w = Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
w Bool -> Bool -> Bool
|| (let post :: IntSet
post = Int -> Graph -> IntSet
succ Int
n Graph
tree in Int -> IntSet -> Bool
IS.member Int
w IntSet
post Bool -> Bool -> Bool
|| (Int -> Bool) -> [Int] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Int -> Int -> Bool
`dominates` Int
w) (IntSet -> [Int]
IS.toList IntSet
post))
  strictly_dominates :: Int -> Int -> Bool
strictly_dominates Int
n Int
w = Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
w Bool -> Bool -> Bool
&& Int -> Int -> Bool
dominates Int
n Int
w
  -- the successors of vertex v in graph g
  succ :: Int -> Graph -> IntSet
succ Int
v Graph
g = Int -> Graph -> Maybe IntSet
forall a. Int -> IntMap a -> Maybe a
IM.lookup Int
v Graph
g Maybe IntSet -> IntSet -> IntSet
forall a. Eq a => Maybe a -> a -> a
`orElse` IntSet
IS.empty
  -- is (v,v') an edge in the graph?
  is_edge :: Graph -> Int -> Int -> Bool
is_edge Graph
g Int
v Int
v' =
    case Int -> Graph -> Maybe IntSet
forall a. Int -> IntMap a -> Maybe a
IM.lookup Int
v Graph
g of
      Maybe IntSet
Nothing -> Bool
False
      Just IntSet
vs -> Int -> IntSet -> Bool
IS.member Int
v' IntSet
vs