-- SPDX-FileCopyrightText: 2010 Tristan Ravitch <travitch@cs.wisc.edu>
-- SPDX-FileCopyrightText: 2026 Reliable System Software, Technische Universität Braunschweig <vss@ibr.cs.tu-bs.de>
--
-- SPDX-License-Identifier: BSD-3-Clause AND GPL-3.0-only

-- Based on the implementation provided by LLVM.Analysis.CDG from Tristan Ravitch
-- See https://hackage.haskell.org/package/llvm-analysis-0.3.0/docs/src/LLVM-Analysis-CDG.html
--
-- The implementation by Tristan Ravitch mentions a paper by Cytron et al.
-- See: https://doi.org/10.1145/115372.115320
--
-- However, I found that the original paper by Ferrante et al. does a much better job at
-- explaining what was implemented by Tristan Ravitch in llvm-analysis. Hence, the comments
-- below mainly refer to that: https://doi.org/10.1145/24039.24041

-- | This module implements a control dependency analysis, using a
-- /control dependency graph/ (CDG) for more information on the concept
-- refer to <https://doi.org/10.1145/24039.24041>. Roughly speaking, a
-- node /A/ is control dependent on /B/ if there is an edge /B → A/ so
-- that the node is taken, as well as an edge so that it is not taken.
module Language.QBE.Analysis.CDG
  ( CDG (..),
    build,
    edges,
    ctrlDeps,
  )
where

import Data.Bifunctor (second)
import Data.IntMap (IntMap)
import Data.IntMap qualified as M
import Data.IntSet (IntSet)
import Data.IntSet qualified as S
import Data.List (find)
import Data.Maybe (fromMaybe)
import Language.QBE.Analysis.CFG qualified as CFG
import Language.QBE.Analysis.Graph qualified as G

-- | A CDG signifying control-dependence between nodes in the 'CFG.CFG'.
data CDG
  = CDG
  { -- | Underlying 'CFG.CFG' for which the CDG was built.
    CDG -> CFG
cdgCfg :: CFG.CFG,
    -- | Root node of the t'CDG', used for determining post-dominance.
    CDG -> Node
cdgRoot :: CFG.Label,
    -- | Graph representation of control-dependence.
    CDG -> Graph
cdgGraph :: G.Graph
  }

-- | All edges of the t'CDG', in an unspecified order.
edges :: CDG -> [(CFG.Label, CFG.Label)]
edges :: CDG -> [(Node, Node)]
edges CDG
cdg = ([(Node, Node)] -> (Node, IntSet) -> [(Node, Node)])
-> [(Node, Node)] -> [(Node, IntSet)] -> [(Node, Node)]
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl [(Node, Node)] -> (Node, IntSet) -> [(Node, Node)]
forall {t}. [(t, Node)] -> (t, IntSet) -> [(t, Node)]
go [] ([(Node, IntSet)] -> [(Node, Node)])
-> [(Node, IntSet)] -> [(Node, Node)]
forall a b. (a -> b) -> a -> b
$ Graph -> [(Node, IntSet)]
forall a. IntMap a -> [(Node, a)]
M.toList (CDG -> Graph
cdgGraph CDG
cdg)
  where
    go :: [(t, Node)] -> (t, IntSet) -> [(t, Node)]
go [(t, Node)]
acc (t
p, IntSet
c) = [(t, Node)]
acc [(t, Node)] -> [(t, Node)] -> [(t, Node)]
forall a. [a] -> [a] -> [a]
++ (Node -> (t, Node)) -> [Node] -> [(t, Node)]
forall a b. (a -> b) -> [a] -> [b]
map (t
p,) (IntSet -> [Node]
S.toList IntSet
c)

-- | Returns the control dependencies of a given node in the 'CFG.CFG'.
-- If the node doesn't have any control dependencies, 'Nothing' is
-- returned.
ctrlDeps :: CDG -> CFG.Label -> Maybe IntSet
ctrlDeps :: CDG -> Node -> Maybe IntSet
ctrlDeps CDG {cdgGraph :: CDG -> Graph
cdgGraph = Graph
cDeps} = (Node -> Graph -> Maybe IntSet
forall a. Node -> IntMap a -> Maybe a
`M.lookup` Graph
cDeps)

------------------------------------------------------------------------

-- | Construct a new t'CDG' from an existing 'CFG.CFG'. The CDG is build
-- based on the given 'CFG.Label' from the CFG, which is used to as the
-- root of a post-dominator tree to establish a post-dominance
-- relationship between nodes.
build :: CFG.CFG -> CFG.Label -> CDG
build :: CFG -> Node -> CDG
build CFG
cfg Node
root =
  CDG
    { cdgCfg :: CFG
cdgCfg = CFG
cfg,
      cdgRoot :: Node
cdgRoot = Node
root,
      cdgGraph :: Graph
cdgGraph = CFG -> Node -> Graph
build' CFG
cfg Node
root
    }

build' :: CFG.CFG -> CFG.Label -> IntMap IntSet
build' :: CFG -> Node -> Graph
build' CFG
cfg Node
label =
  -- From the CFG, generate a post-dominator tree and also convert this tree
  -- to an IntMap representation for efficient successor lookup in 'addCDGEdge'.
  let rooted :: (Node, Graph)
rooted = (Node
label, CFG -> Graph
CFG.asDomGraph CFG
cfg)
      pdTree :: Tree Node
pdTree = (Node, Graph) -> Tree Node
G.pdomTree (Node, Graph)
rooted
      pdtMap :: Graph
pdtMap = [(Node, IntSet)] -> Graph
forall a. [(Node, a)] -> IntMap a
M.fromList ([(Node, IntSet)] -> Graph) -> [(Node, IntSet)] -> Graph
forall a b. (a -> b) -> a -> b
$ ((Node, [Node]) -> (Node, IntSet))
-> [(Node, [Node])] -> [(Node, IntSet)]
forall a b. (a -> b) -> [a] -> [b]
map (([Node] -> IntSet) -> (Node, [Node]) -> (Node, IntSet)
forall b c a. (b -> c) -> (a, b) -> (a, c)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second [Node] -> IntSet
S.fromList) ((Node, Graph) -> [(Node, [Node])]
G.pdom (Node, Graph)
rooted)
      pdtAnc :: IntMap [Node]
pdtAnc = [(Node, [Node])] -> IntMap [Node]
forall a. [(Node, a)] -> IntMap a
M.fromList (Tree Node -> [(Node, [Node])]
forall a. Tree a -> [(a, [a])]
G.ancestors Tree Node
pdTree)
   in ((Node, Node) -> Graph -> Graph)
-> Graph -> [(Node, Node)] -> Graph
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ((Node -> Node -> Graph -> Graph) -> (Node, Node) -> Graph -> Graph
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ((Node -> Node -> Graph -> Graph)
 -> (Node, Node) -> Graph -> Graph)
-> (Node -> Node -> Graph -> Graph)
-> (Node, Node)
-> Graph
-> Graph
forall a b. (a -> b) -> a -> b
$ Graph -> IntMap [Node] -> Node -> Node -> Graph -> Graph
addCDGEdge Graph
pdtMap IntMap [Node]
pdtAnc) Graph
forall a. IntMap a
M.empty ([(Node, Node)] -> Graph) -> [(Node, Node)] -> Graph
forall a b. (a -> b) -> a -> b
$ CFG -> [(Node, Node)]
CFG.edges CFG
cfg

-- This function essentially implements the algorithm described in Section 3.1
-- of the Paper by Ferrante et al., using the algorithm by Cytron et al. may be
-- more efficient and could be considered in the future.
addCDGEdge ::
  IntMap IntSet ->
  IntMap [Int] ->
  CFG.Label ->
  CFG.Label ->
  IntMap IntSet ->
  IntMap IntSet
addCDGEdge :: Graph -> IntMap [Node] -> Node -> Node -> Graph -> Graph
addCDGEdge Graph
pdtMap IntMap [Node]
pdtAnc Node
a Node
b Graph
acc
  -- Consider all edges (A, B) in the control flow graph such that B does not
  -- post-dominate M. If it does, we return 'acc' unmodified (insert nothing).
  | Node -> Node -> Bool
postdominates Node
b Node
a = Graph
acc
  | Bool
otherwise =
      -- Let AC denote the least common ancestor of A and B in the post-dominator tree.
      case Node -> Node -> Maybe Node
commonAncestor Node
b Node
a of
        -- Case 1: All nodes in the post-dominator tree on the path from AC to
        -- B, including B but not AC, should be made control dependent on A.
        Just Node
ac ->
          let cdepsOnA :: IntSet
cdepsOnA = Node -> IntSet -> IntSet
S.insert Node
b ((Node -> Bool) -> IntSet -> IntSet
S.filter (Node -> Node -> Bool
forall a. Eq a => a -> a -> Bool
/= Node
ac) (IntSet -> IntSet) -> IntSet -> IntSet
forall a b. (a -> b) -> a -> b
$ Node -> IntSet
lookupSucc Node
b)
           in (Node -> Graph -> Graph) -> Graph -> [Node] -> Graph
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Node -> Graph -> Graph
insertEdge Graph
acc (IntSet -> [Node]
S.toList IntSet
cdepsOnA)
        -- Case 2: All nodes in the post-dominator tree on the path from A to B,
        -- including A and B, should be made control dependent on A.
        Maybe Node
Nothing ->
          let deps :: IntSet
deps = Node -> IntSet -> IntSet
S.insert Node
b (IntSet -> IntSet) -> IntSet -> IntSet
forall a b. (a -> b) -> a -> b
$ Node -> IntSet
lookupSucc Node
b
           in (Node -> Graph -> Graph) -> Graph -> [Node] -> Graph
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Node -> Graph -> Graph
insertEdge Graph
acc (IntSet -> [Node]
S.toList IntSet
deps)
  where
    insertEdge :: CFG.Label -> IntMap IntSet -> IntMap IntSet
    insertEdge :: Node -> Graph -> Graph
insertEdge Node
blk = (IntSet -> IntSet -> IntSet) -> Node -> IntSet -> Graph -> Graph
forall a. (a -> a -> a) -> Node -> a -> IntMap a -> IntMap a
M.insertWith IntSet -> IntSet -> IntSet
S.union Node
blk (Node -> IntSet
S.singleton Node
a)

    lookupSucc :: CFG.Label -> IntSet
    lookupSucc :: Node -> IntSet
lookupSucc Node
l = IntSet -> Maybe IntSet -> IntSet
forall a. a -> Maybe a -> a
fromMaybe IntSet
S.empty (Maybe IntSet -> IntSet) -> Maybe IntSet -> IntSet
forall a b. (a -> b) -> a -> b
$ Node -> Graph -> Maybe IntSet
forall a. Node -> IntMap a -> Maybe a
M.lookup Node
l Graph
pdtMap

    -- Returns true if 'x' post-dominates 'y'.
    postdominates :: CFG.Label -> CFG.Label -> Bool
    postdominates :: Node -> Node -> Bool
postdominates Node
x Node
y = Bool -> (IntSet -> Bool) -> Maybe IntSet -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (Node
x `S.member`) (Maybe IntSet -> Bool) -> Maybe IntSet -> Bool
forall a b. (a -> b) -> a -> b
$ Node -> Graph -> Maybe IntSet
forall a. Node -> IntMap a -> Maybe a
M.lookup Node
y Graph
pdtMap

    commonAncestor :: G.Node -> G.Node -> Maybe G.Node
    commonAncestor :: Node -> Node -> Maybe Node
commonAncestor Node
n1 Node
n2 = do
      [Node]
a1 <- Node -> IntMap [Node] -> Maybe [Node]
forall a. Node -> IntMap a -> Maybe a
M.lookup Node
n1 IntMap [Node]
pdtAnc
      [Node]
a2 <- Node -> IntMap [Node] -> Maybe [Node]
forall a. Node -> IntMap a -> Maybe a
M.lookup Node
n2 IntMap [Node]
pdtAnc
      (Node -> Bool) -> [Node] -> Maybe Node
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (Node -> [Node] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Node]
a1) [Node]
a2