qute

  1-- SPDX-FileCopyrightText: 2025 Sören Tempel <soeren+git@soeren-tempel.net>
  2-- SPDX-FileCopyrightText: 2026 Reliable System Software, Technische Universität Braunschweig <vss@ibr.cs.tu-bs.de>
  3--
  4-- SPDX-License-Identifier: GPL-3.0-only
  5
  6module Language.QBE.Analysis.CFG
  7  ( -- * Control Flow Graph
  8    Label,
  9    CFG (cfgFunction),
 10    build,
 11    identToLabel,
 12    labelToIdent,
 13    labelToBlock,
 14    lookupSuccs,
 15
 16    -- * Graph Representation
 17    asGraph,
 18    nodes,
 19    edges,
 20    bounds,
 21
 22    -- * Dominator Analysis
 23    asDomGraph,
 24    startNode,
 25  )
 26where
 27
 28import Data.Graph (Bounds, Graph, buildG)
 29import Data.IntMap (IntMap)
 30import Data.IntMap qualified as IntMap
 31import Data.IntSet qualified as IntSet
 32import Data.Map (Map)
 33import Data.Map qualified as Map
 34import Data.Maybe (fromJust)
 35import Data.Tuple (swap)
 36import Language.QBE.Analysis.Graph qualified as DG
 37import Language.QBE.Types qualified as QBE
 38
 39-- | Representation of a node in the t'CFG'.
 40type Label = IntMap.Key
 41
 42-- | A representation of the control-flow within a 'QBE.FuncDef'.
 43data CFG
 44  = CFG
 45  { -- | Function for which this CFG was built.
 46    cfgFunction :: QBE.FuncDef,
 47    cfgMaxBound :: Int,
 48    cfgLabelMap :: Map QBE.BlockIdent Label,
 49    cfgBlockMap :: IntMap QBE.BlockIdent,
 50    cfgSuccessors :: IntMap [Label]
 51  }
 52
 53-- | Returns a list of all graph nodes in an unspecified order.
 54nodes :: CFG -> [Label]
 55nodes = IntMap.keys . cfgBlockMap
 56
 57-- | Returns a list of graph edges in an unspecified order.
 58edges :: CFG -> [(Label, Label)]
 59edges cfg = foldl go [] $ IntMap.toList (cfgSuccessors cfg)
 60  where
 61    go acc (p, c) = acc ++ map (p,) c
 62
 63-- | Returns the bounds of the t'CFG'. This is useful, for example, to
 64-- build a subgraph using 'Data.Graph.buildG'.
 65bounds :: CFG -> Bounds
 66bounds cfg = (0, cfgMaxBound cfg)
 67
 68-- | Convert a 'QBE.BlockIdent' to a CFG node 'Label'.
 69--
 70-- This function is partial, on an invalid 'Label', an error is thrown.
 71identToLabel :: CFG -> QBE.BlockIdent -> Label
 72identToLabel CFG {cfgLabelMap = m} blkId =
 73  fromJust $ Map.lookup blkId m
 74
 75-- | Convert a CFG node 'Label' to a 'QBE.BlockIdent'.
 76--
 77-- This function is partial, on an invalid 'Label', an error is thrown.
 78labelToIdent :: CFG -> Label -> QBE.BlockIdent
 79labelToIdent CFG {cfgBlockMap = m} label =
 80  fromJust $ IntMap.lookup label m
 81
 82-- | Utility function to convert a node 'Label' to a 'QBE.Block'.
 83-- Performs two \(O(\log n)\) lookups internally.
 84--
 85-- This function is partial, on an invalid 'Label', an error is thrown.
 86labelToBlock :: CFG -> Label -> QBE.Block
 87labelToBlock cfg label =
 88  let blocks = QBE.fBlock $ cfgFunction cfg
 89   in fromJust $ Map.lookup (labelToIdent cfg label) blocks
 90
 91-- | Mapping of 'Label' to its successors in the CFG, represented as an
 92-- ordered list of zero, one, or two elements. A list with two elements
 93-- represents a conditional jump where the left child is the is the true
 94-- branch and the right child is the false branch. A list wih a single
 95-- element signifies an unconditional jump. If the given node does not
 96-- have any successors an empty list is returned.
 97--
 98-- This function is partial, on an invalid 'Label', an error is thrown.
 99lookupSuccs :: CFG -> Label -> [Label]
100lookupSuccs CFG {cfgSuccessors = succs} label =
101  fromJust $ IntMap.lookup label succs
102
103------------------------------------------------------------------------
104
105identStart :: Label
106identStart = 0
107
108-- | Construct a t'CFG' for a given function.
109build :: QBE.FuncDef -> CFG
110build func =
111  CFG
112    { cfgMaxBound = snd $ last blkIdLabels,
113      cfgFunction = func,
114      cfgLabelMap = labelMap,
115      cfgBlockMap = IntMap.fromList $ map swap blkIdLabels,
116      cfgSuccessors = IntMap.fromList $ build' labelMap blocks
117    }
118  where
119    labelMap :: Map QBE.BlockIdent Label
120    labelMap = Map.fromList blkIdLabels
121
122    blocks :: [QBE.Block]
123    blocks = Map.elems $ QBE.fBlock func
124
125    blkIdLabels :: [(QBE.BlockIdent, Label)]
126    blkIdLabels = zip (map QBE.label blocks) [identStart ..]
127
128build' :: Map QBE.BlockIdent Label -> [QBE.Block] -> [(IntMap.Key, [Label])]
129build' labelMap = foldl go []
130  where
131    toLabel :: QBE.BlockIdent -> Label
132    toLabel ident = fromJust $ Map.lookup ident labelMap
133
134    go acc block@(QBE.Block {QBE.label = ident}) =
135      let succs = case QBE.term block of
136            QBE.Jump target -> [toLabel target]
137            QBE.Jnz _ i1 i2 -> [toLabel i1, toLabel i2]
138            QBE.Return _ -> []
139            QBE.Halt -> []
140       in (toLabel ident, succs) : acc
141
142------------------------------------------------------------------------
143
144asGraph :: CFG -> Graph
145asGraph cfg = buildG (identStart, cfgMaxBound cfg) $ edges cfg
146
147asDomGraph :: CFG -> DG.Graph
148asDomGraph cfg = IntMap.map IntSet.fromList (cfgSuccessors cfg)
149
150-- | Determine the entry node of the t'CFG'. Useful, for example, to
151-- generated a 'DG.Rooted' representation for the control-flow graph.
152startNode :: CFG -> Label
153startNode cfg@(CFG {cfgFunction = func}) =
154  identToLabel cfg (QBE.fStart func)