qute

  1-- SPDX-FileCopyrightText: 2010 Tristan Ravitch <travitch@cs.wisc.edu>
  2-- SPDX-FileCopyrightText: 2026 Reliable System Software, Technische Universität Braunschweig <vss@ibr.cs.tu-bs.de>
  3--
  4-- SPDX-License-Identifier: BSD-3-Clause AND GPL-3.0-only
  5
  6-- Based on the implementation provided by LLVM.Analysis.CDG from Tristan Ravitch
  7-- See https://hackage.haskell.org/package/llvm-analysis-0.3.0/docs/src/LLVM-Analysis-CDG.html
  8--
  9-- The implementation by Tristan Ravitch mentions a paper by Cytron et al.
 10-- See: https://doi.org/10.1145/115372.115320
 11--
 12-- However, I found that the original paper by Ferrante et al. does a much better job at
 13-- explaining what was implemented by Tristan Ravitch in llvm-analysis. Hence, the comments
 14-- below mainly refer to that: https://doi.org/10.1145/24039.24041
 15
 16-- | This module implements a control dependency analysis, using a
 17-- /control dependency graph/ (CDG) for more information on the concept
 18-- refer to <https://doi.org/10.1145/24039.24041>. Roughly speaking, a
 19-- node /A/ is control dependent on /B/ if there is an edge /B → A/ so
 20-- that the node is taken, as well as an edge so that it is not taken.
 21module Language.QBE.Analysis.CDG
 22  ( CDG (..),
 23    build,
 24    edges,
 25    ctrlDeps,
 26  )
 27where
 28
 29import Data.Bifunctor (second)
 30import Data.IntMap (IntMap)
 31import Data.IntMap qualified as M
 32import Data.IntSet (IntSet)
 33import Data.IntSet qualified as S
 34import Data.List (find)
 35import Data.Maybe (fromMaybe)
 36import Language.QBE.Analysis.CFG qualified as CFG
 37import Language.QBE.Analysis.Graph qualified as G
 38
 39-- | A CDG signifying control-dependence between nodes in the 'CFG.CFG'.
 40data CDG
 41  = CDG
 42  { -- | Underlying 'CFG.CFG' for which the CDG was built.
 43    cdgCfg :: CFG.CFG,
 44    -- | Root node of the t'CDG', used for determining post-dominance.
 45    cdgRoot :: CFG.Label,
 46    -- | Graph representation of control-dependence.
 47    cdgGraph :: G.Graph
 48  }
 49
 50-- | All edges of the t'CDG', in an unspecified order.
 51edges :: CDG -> [(CFG.Label, CFG.Label)]
 52edges cdg = foldl go [] $ M.toList (cdgGraph cdg)
 53  where
 54    go acc (p, c) = acc ++ map (p,) (S.toList c)
 55
 56-- | Returns the control dependencies of a given node in the 'CFG.CFG'.
 57-- If the node doesn't have any control dependencies, 'Nothing' is
 58-- returned.
 59ctrlDeps :: CDG -> CFG.Label -> Maybe IntSet
 60ctrlDeps CDG {cdgGraph = cDeps} = (`M.lookup` cDeps)
 61
 62------------------------------------------------------------------------
 63
 64-- | Construct a new t'CDG' from an existing 'CFG.CFG'. The CDG is build
 65-- based on the given 'CFG.Label' from the CFG, which is used to as the
 66-- root of a post-dominator tree to establish a post-dominance
 67-- relationship between nodes.
 68build :: CFG.CFG -> CFG.Label -> CDG
 69build cfg root =
 70  CDG
 71    { cdgCfg = cfg,
 72      cdgRoot = root,
 73      cdgGraph = build' cfg root
 74    }
 75
 76build' :: CFG.CFG -> CFG.Label -> IntMap IntSet
 77build' cfg label =
 78  -- From the CFG, generate a post-dominator tree and also convert this tree
 79  -- to an IntMap representation for efficient successor lookup in 'addCDGEdge'.
 80  let rooted = (label, CFG.asDomGraph cfg)
 81      pdTree = G.pdomTree rooted
 82      pdtMap = M.fromList $ map (second S.fromList) (G.pdom rooted)
 83      pdtAnc = M.fromList (G.ancestors pdTree)
 84   in foldr (uncurry $ addCDGEdge pdtMap pdtAnc) M.empty $ CFG.edges cfg
 85
 86-- This function essentially implements the algorithm described in Section 3.1
 87-- of the Paper by Ferrante et al., using the algorithm by Cytron et al. may be
 88-- more efficient and could be considered in the future.
 89addCDGEdge ::
 90  IntMap IntSet ->
 91  IntMap [Int] ->
 92  CFG.Label ->
 93  CFG.Label ->
 94  IntMap IntSet ->
 95  IntMap IntSet
 96addCDGEdge pdtMap pdtAnc a b acc
 97  -- Consider all edges (A, B) in the control flow graph such that B does not
 98  -- post-dominate M. If it does, we return 'acc' unmodified (insert nothing).
 99  | postdominates b a = acc
100  | otherwise =
101      -- Let AC denote the least common ancestor of A and B in the post-dominator tree.
102      case commonAncestor b a of
103        -- Case 1: All nodes in the post-dominator tree on the path from AC to
104        -- B, including B but not AC, should be made control dependent on A.
105        Just ac ->
106          let cdepsOnA = S.insert b (S.filter (/= ac) $ lookupSucc b)
107           in foldr insertEdge acc (S.toList cdepsOnA)
108        -- Case 2: All nodes in the post-dominator tree on the path from A to B,
109        -- including A and B, should be made control dependent on A.
110        Nothing ->
111          let deps = S.insert b $ lookupSucc b
112           in foldr insertEdge acc (S.toList deps)
113  where
114    insertEdge :: CFG.Label -> IntMap IntSet -> IntMap IntSet
115    insertEdge blk = M.insertWith S.union blk (S.singleton a)
116
117    lookupSucc :: CFG.Label -> IntSet
118    lookupSucc l = fromMaybe S.empty $ M.lookup l pdtMap
119
120    -- Returns true if 'x' post-dominates 'y'.
121    postdominates :: CFG.Label -> CFG.Label -> Bool
122    postdominates x y = maybe False (x `S.member`) $ M.lookup y pdtMap
123
124    commonAncestor :: G.Node -> G.Node -> Maybe G.Node
125    commonAncestor n1 n2 = do
126      a1 <- M.lookup n1 pdtAnc
127      a2 <- M.lookup n2 pdtAnc
128      find (`elem` a1) a2