{-# LANGUAGE GADTs #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE MultiParamTypeClasses #-} {-| Module : GHC.Cmm.Reducibility Description : Tell if a `CmmGraph` is reducible, or make it so Test a Cmm control-flow graph for reducibility. And provide a function that, when given an arbitrary control-flow graph, returns an equivalent, reducible control-flow graph. The equivalent graph is obtained by "splitting" (copying) nodes of the original graph. The resulting equivalent graph has the same dynamic behavior as the original, but it is larger. Documentation uses the language of control-flow analysis, in which a basic block is called a "node." These "nodes" are `CmmBlock`s or equivalent; they have nothing to do with a `CmmNode`. For more on reducibility and related analyses and algorithms, see Note [Reducibility resources] -} module GHC.Cmm.Reducibility ( Reducibility(..) , reducibility , asReducible ) where import GHC.Prelude hiding (splitAt, succ) import Control.Monad import Data.List (nub) import Data.Maybe import Data.Semigroup import qualified Data.Sequence as Seq import GHC.Cmm import GHC.Cmm.BlockId import GHC.Cmm.Dataflow import GHC.Cmm.Dataflow.Collections import GHC.Cmm.Dataflow.Block import GHC.Cmm.Dominators import GHC.Cmm.Dataflow.Graph hiding (addBlock) import GHC.Cmm.Dataflow.Label import GHC.Data.Graph.Collapse import GHC.Data.Graph.Inductive.Graph import GHC.Data.Graph.Inductive.PatriciaTree import GHC.Types.Unique.Supply import GHC.Utils.Panic -- | Represents the result of a reducibility analysis. data Reducibility = Reducible | Irreducible deriving (Eq, Show) -- | Given a graph, say whether the graph is reducible. The graph must -- be bundled with a dominator analysis and a reverse postorder -- numbering, as these results are needed to perform the test. reducibility :: NonLocal node => GraphWithDominators node -> Reducibility reducibility gwd = if all goodBlock blockmap then Reducible else Irreducible where goodBlock b = all (goodEdge (entryLabel b)) (successors b) goodEdge from to = rpnum to > rpnum from || to `dominates` from rpnum = gwdRPNumber gwd blockmap = graphMap $ gwd_graph gwd dominators = gwdDominatorsOf gwd dominates lbl blockname = lbl == blockname || dominatorsMember lbl (dominators blockname) -- | Given a graph, return an equivalent reducible graph, by -- "splitting" (copying) nodes if necessary. The input -- graph must be bundled with a dominator analysis and a reverse -- postorder numbering. The computation is monadic because when a -- node is split, the new copy needs a fresh label. -- -- Use this function whenever a downstream algorithm needs a reducible -- control-flow graph. asReducible :: GraphWithDominators CmmNode -> UniqSM (GraphWithDominators CmmNode) asReducible gwd = case reducibility gwd of Reducible -> return gwd Irreducible -> assertReducible <$> nodeSplit gwd assertReducible :: GraphWithDominators CmmNode -> GraphWithDominators CmmNode assertReducible gwd = case reducibility gwd of Reducible -> gwd Irreducible -> panic "result not reducible" ---------------------------------------------------------------- -- | Split one or more nodes of the given graph, which must be -- irreducible. nodeSplit :: GraphWithDominators CmmNode -> UniqSM (GraphWithDominators CmmNode) nodeSplit gwd = graphWithDominators <$> inflate (g_entry g) <$> runNullCollapse collapsed where g = gwd_graph gwd collapsed :: NullCollapseViz (Gr CmmSuper ()) collapsed = collapseInductiveGraph (cgraphOfCmm g) type CGraph = Gr CmmSuper () -- | Turn a collapsed supernode back into a control-flow graph inflate :: Label -> CGraph -> CmmGraph inflate entry cg = CmmGraph entry graph where graph = GMany NothingO body NothingO body :: LabelMap CmmBlock body = foldl (\map block -> mapInsert (entryLabel block) block map) mapEmpty $ blocks super super = case labNodes cg of [(_, s)] -> s _ -> panic "graph given to `inflate` is not singleton" -- | Convert a `CmmGraph` into an inductive graph. -- (The function coalesces duplicate edges into a single edge.) cgraphOfCmm :: CmmGraph -> CGraph cgraphOfCmm g = foldl' addSuccEdges (mkGraph cnodes []) blocks where blocks = zip [0..] $ revPostorderFrom (graphMap g) (g_entry g) cnodes = [(k, super block) | (k, block) <- blocks] where super block = Nodes (entryLabel block) (Seq.singleton block) labelNumber = \lbl -> fromJust $ mapLookup lbl numbers where numbers :: LabelMap Int numbers = mapFromList $ map swap blocks swap (k, block) = (entryLabel block, k) addSuccEdges :: CGraph -> (Node, CmmBlock) -> CGraph addSuccEdges graph (k, block) = insEdges [(k, labelNumber lbl, ()) | lbl <- nub $ successors block] graph {- Note [Reducibility resources] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ *Flow Analysis of Computer Programs.* Matthew S. Hecht North Holland, 1977. Available to borrow from archive.org. Matthew S. Hecht and Jeffrey D. Ullman (1972). Flow Graph Reducibility. SIAM J. Comput., 1(2), 188–202. https://doi.org/10.1137/0201014 Johan Janssen and Henk Corporaal. 1997. Making graphs reducible with controlled node splitting. ACM TOPLAS 19, 6 (Nov. 1997), 1031–1052. DOI:https://doi.org/10.1145/267959.269971 Sebastian Unger and Frank Mueller. 2002. Handling irreducible loops: optimized node splitting versus DJ-graphs. ACM TOPLAS 24, 4 (July 2002), 299–333. https://doi.org/10.1145/567097.567098. (This one contains the most detailed account of how the Hecht/Ullman algorithm is used to modify an actual control-flow graph. But still not much detail.) https://rgrig.blogspot.com/2009/10/dtfloatleftclearleft-summary-of-some.html (Nice summary of useful facts) -} type Seq = Seq.Seq -- | A "supernode" contains a single-entry, multiple-exit, reducible subgraph. -- The entry point is the given label, and the block with that label -- dominates all the other blocks in the supernode. When an entire -- graph is collapsed into a single supernode, the graph is reducible. -- More detail can be found in "GHC.Data.Graph.Collapse". data CmmSuper = Nodes { label :: Label , blocks :: Seq CmmBlock } instance Semigroup CmmSuper where s <> s' = Nodes (label s) (blocks s <> blocks s') instance PureSupernode CmmSuper where superLabel = label mapLabels = changeLabels instance Supernode CmmSuper NullCollapseViz where freshen s = liftUniqSM $ relabel s -- | Return all labels defined within a supernode. definedLabels :: CmmSuper -> Seq Label definedLabels = fmap entryLabel . blocks -- | Map the given function over every use and definition of a label -- in the given supernode. changeLabels :: (Label -> Label) -> (CmmSuper -> CmmSuper) changeLabels f (Nodes l blocks) = Nodes (f l) (fmap (changeBlockLabels f) blocks) -- | Map the given function over every use and definition of a label -- in the given block. changeBlockLabels :: (Label -> Label) -> CmmBlock -> CmmBlock changeBlockLabels f block = blockJoin entry' middle exit' where (entry, middle, exit) = blockSplit block entry' = let CmmEntry l scope = entry in CmmEntry (f l) scope exit' = case exit of -- unclear why mapSuccessors doesn't touch these CmmCall { cml_cont = Just l } -> exit { cml_cont = Just (f l) } CmmForeignCall { succ = l } -> exit { succ = f l } _ -> mapSuccessors f exit -- | Within the given supernode, replace every defined label (and all -- of its uses) with a fresh label. relabel :: CmmSuper -> UniqSM CmmSuper relabel node = do finite_map <- foldM addPair mapEmpty $ definedLabels node return $ changeLabels (labelChanger finite_map) node where addPair :: LabelMap Label -> Label -> UniqSM (LabelMap Label) addPair map old = do new <- newBlockId return $ mapInsert old new map labelChanger :: LabelMap Label -> (Label -> Label) labelChanger mapping = \lbl -> mapFindWithDefault lbl lbl mapping