{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE KindSignatures        #-}
{-# LANGUAGE LambdaCase            #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE MultiWayIf            #-}
{-# LANGUAGE OverloadedStrings     #-}
{-# LANGUAGE ScopedTypeVariables   #-}
{-# LANGUAGE TupleSections         #-}

-- | This module provides a generic framework for forward data flow analysis
-- on C code, represented by the 'Language.Cimple.Ast'. It includes tools
-- for building a control flow graph (CFG) from a function definition and
-- a fixpoint solver to compute data flow facts.
--
-- The core components are:
--
-- * 'CFG': A control flow graph representation, where nodes contain basic
--   blocks of statements.
-- * 'DataFlow': A type class that defines the specific analysis to be
--   performed (e.g., reaching definitions, liveness analysis).
-- * 'buildCFG': A function to construct a 'CFG' from a 'C.FunctionDefn'.
-- * 'fixpoint': A generic solver that iteratively computes data flow facts
--   until a stable state (fixpoint) is reached.
--
-- To use this module, you need to:
--
-- 1. Define a data type for your data flow facts.
-- 2. Create an instance of the 'DataFlow' type class for your data type,
--    implementing 'emptyFacts', 'transfer', and 'join'.
-- 3. Build the CFG for a function using 'buildCFG'.
-- 4. Run the 'fixpoint' solver on the generated CFG.
-- 5. Extract and use the computed 'cfgInFacts' and 'cfgOutFacts' from the
--    resulting CFG.
module Tokstyle.Analysis.DataFlow
    ( CFGNode (..)
    , CFG
    , DataFlow (..)
    , fixpoint
    , buildCFG
    ) where

import           Control.Monad              (foldM, forM, forM_)
import           Control.Monad.State.Strict (State, get, modify, put, runState)
import           Data.Fix                   (Fix (Fix, unFix))
import           Data.Foldable              (foldl')
import           Data.Kind                  (Type)
import           Data.List                  (find)
import           Data.Map.Strict            (Map)
import qualified Data.Map.Strict            as Map
import           Data.Maybe                 (fromMaybe, mapMaybe)
import           Data.Set                   (Set)
import qualified Data.Set                   as Set
import qualified Data.Text                  as T
import           Debug.Trace                (trace)
import           Language.Cimple            (NodeF (..))
import qualified Language.Cimple            as C
import           Language.Cimple.Pretty     (showNodePlain)
import           Prettyprinter              (Pretty (..))
import           Text.Groom                 (groom)
import           Tokstyle.Analysis.Types    (lookupOrError)
import           Tokstyle.Worklist

debugging :: Bool
debugging :: Bool
debugging = Bool
False

dtrace :: String -> a -> a
dtrace :: String -> a -> a
dtrace String
msg a
x = if Bool
debugging then String -> a -> a
forall a. String -> a -> a
trace String
msg a
x else a
x

-- | A node in the control flow graph. Each node represents a basic block
-- of statements.
data CFGNode l a = CFGNode
    { CFGNode l a -> Int
cfgNodeId   :: Int -- ^ A unique identifier for the node.
    , CFGNode l a -> [Int]
cfgPreds    :: [Int] -- ^ A list of predecessor node IDs.
    , CFGNode l a -> [Int]
cfgSuccs    :: [Int] -- ^ A list of successor node IDs.
    , CFGNode l a -> [Node (Lexeme l)]
cfgStmts    :: [C.Node (C.Lexeme l)] -- ^ The statements in this basic block.
    , CFGNode l a -> a
cfgInFacts  :: a -- ^ The data flow facts at the entry of this node.
    , CFGNode l a -> a
cfgOutFacts :: a -- ^ The data flow facts at the exit of this node.
    }
    deriving (Int -> CFGNode l a -> ShowS
[CFGNode l a] -> ShowS
CFGNode l a -> String
(Int -> CFGNode l a -> ShowS)
-> (CFGNode l a -> String)
-> ([CFGNode l a] -> ShowS)
-> Show (CFGNode l a)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall l a. (Show l, Show a) => Int -> CFGNode l a -> ShowS
forall l a. (Show l, Show a) => [CFGNode l a] -> ShowS
forall l a. (Show l, Show a) => CFGNode l a -> String
showList :: [CFGNode l a] -> ShowS
$cshowList :: forall l a. (Show l, Show a) => [CFGNode l a] -> ShowS
show :: CFGNode l a -> String
$cshow :: forall l a. (Show l, Show a) => CFGNode l a -> String
showsPrec :: Int -> CFGNode l a -> ShowS
$cshowsPrec :: forall l a. (Show l, Show a) => Int -> CFGNode l a -> ShowS
Show, CFGNode l a -> CFGNode l a -> Bool
(CFGNode l a -> CFGNode l a -> Bool)
-> (CFGNode l a -> CFGNode l a -> Bool) -> Eq (CFGNode l a)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall l a. (Eq l, Eq a) => CFGNode l a -> CFGNode l a -> Bool
/= :: CFGNode l a -> CFGNode l a -> Bool
$c/= :: forall l a. (Eq l, Eq a) => CFGNode l a -> CFGNode l a -> Bool
== :: CFGNode l a -> CFGNode l a -> Bool
$c== :: forall l a. (Eq l, Eq a) => CFGNode l a -> CFGNode l a -> Bool
Eq)

-- | The Control Flow Graph is a map from node IDs to 'CFGNode's.
type CFG l a = Map Int (CFGNode l a)

-- | A type class for data flow analysis. Users of this framework must
-- provide an instance of this class for their specific analysis.
class (Eq a, Show a) => DataFlow (c :: Type -> Type) l a where
    -- | The facts for an empty basic block.
    emptyFacts :: c l -> a
    -- | The transfer function defines how a single statement affects the
    -- data flow facts. It takes the facts before the statement and
    -- returns the facts after the statement, plus any new work discovered.
    transfer :: c l -> l -> a -> C.Node (C.Lexeme l) -> (a, Set (l, [Int]))
    -- | The join operator combines facts from multiple predecessor nodes.
    -- This is used at control flow merge points (e.g., after an if-statement
    -- or at the start of a loop).
    join :: c l -> a -> a -> a

-- | A generic fixpoint solver for forward data flow analysis. This function
-- iteratively applies the transfer function to each node in the CFG until
-- the data flow facts no longer change. It uses a worklist algorithm for
-- efficiency, and returns the final CFG along with any new work discovered.
fixpoint :: forall c l a. (DataFlow c l a, Show l, Ord l) => c l -> l -> CFG l a -> (CFG l a, Set (l, [Int]))
fixpoint :: c l -> l -> CFG l a -> (CFG l a, Set (l, [Int]))
fixpoint c l
ctx l
funcName CFG l a
cfg =
    let
        worklist :: Worklist Int
worklist = [Int] -> Worklist Int
forall a. [a] -> Worklist a
fromList (CFG l a -> [Int]
forall k a. Map k a -> [k]
Map.keys CFG l a
cfg)
    in
        Worklist Int
-> CFG l a -> Set (l, [Int]) -> (CFG l a, Set (l, [Int]))
go Worklist Int
worklist CFG l a
cfg Set (l, [Int])
forall a. Set a
Set.empty
    where
        go :: Worklist Int -> CFG l a -> Set (l, [Int]) -> (CFG l a, Set (l, [Int]))
        go :: Worklist Int
-> CFG l a -> Set (l, [Int]) -> (CFG l a, Set (l, [Int]))
go Worklist Int
worklist CFG l a
cfg' Set (l, [Int])
accumulatedWork
            | Just (Int
currentId, Worklist Int
worklist') <- Worklist Int -> Maybe (Int, Worklist Int)
forall a. Worklist a -> Maybe (a, Worklist a)
pop Worklist Int
worklist =
                let
                    node :: CFGNode l a
node = String -> CFG l a -> Int -> CFGNode l a
forall k a. (Ord k, Show k) => String -> Map k a -> k -> a
lookupOrError String
"fixpoint" CFG l a
cfg' Int
currentId
                    predNodes :: [CFGNode l a]
predNodes = (Int -> Maybe (CFGNode l a)) -> [Int] -> [CFGNode l a]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Int -> CFG l a -> Maybe (CFGNode l a)
forall k a. Ord k => k -> Map k a -> Maybe a
`Map.lookup` CFG l a
cfg') (CFGNode l a -> [Int]
forall l a. CFGNode l a -> [Int]
cfgPreds CFGNode l a
node)
                    inFacts' :: a
inFacts' = if [CFGNode l a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [CFGNode l a]
predNodes
                                  then CFGNode l a -> a
forall l a. CFGNode l a -> a
cfgInFacts CFGNode l a
node
                                  else (a -> a -> a) -> [a] -> a
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 (c l -> a -> a -> a
forall (c :: * -> *) l a. DataFlow c l a => c l -> a -> a -> a
join c l
ctx) ((CFGNode l a -> a) -> [CFGNode l a] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map CFGNode l a -> a
forall l a. CFGNode l a -> a
cfgOutFacts [CFGNode l a]
predNodes)

                    (a
outFacts', Set (l, [Int])
blockWork) =
                        ((a, Set (l, [Int])) -> Node (Lexeme l) -> (a, Set (l, [Int])))
-> (a, Set (l, [Int])) -> [Node (Lexeme l)] -> (a, Set (l, [Int]))
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl'
                            (\(a
accFacts, Set (l, [Int])
accWork) Node (Lexeme l)
stmt ->
                                let (a
newFacts, Set (l, [Int])
newWork) = c l -> l -> a -> Node (Lexeme l) -> (a, Set (l, [Int]))
forall (c :: * -> *) l a.
DataFlow c l a =>
c l -> l -> a -> Node (Lexeme l) -> (a, Set (l, [Int]))
transfer c l
ctx l
funcName (String -> a -> a
forall a. String -> a -> a
dtrace (String
"fixpoint fold: accFacts=" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> a -> String
forall a. Show a => a -> String
show a
accFacts) a
accFacts) Node (Lexeme l)
stmt
                                in (a
newFacts, Set (l, [Int]) -> Set (l, [Int]) -> Set (l, [Int])
forall a. Ord a => Set a -> Set a -> Set a
Set.union Set (l, [Int])
accWork Set (l, [Int])
newWork))
                            (a
inFacts', Set (l, [Int])
forall a. Set a
Set.empty)
                            (CFGNode l a -> [Node (Lexeme l)]
forall l a. CFGNode l a -> [Node (Lexeme l)]
cfgStmts CFGNode l a
node)

                    outFactsChanged :: Bool
outFactsChanged = a
outFacts' a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= CFGNode l a -> a
forall l a. CFGNode l a -> a
cfgOutFacts CFGNode l a
node
                    cfg'' :: CFG l a
cfg'' = String -> CFG l a -> CFG l a
forall a. String -> a -> a
dtrace ([String] -> String
unlines [ String
"fixpoint (" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> l -> String
forall a. Show a => a -> String
show l
funcName String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
", node " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
currentId String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"):"
                                            , String
"  inFacts': " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> a -> String
forall a. Show a => a -> String
groom a
inFacts'
                                            , String
"  outFacts': " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> a -> String
forall a. Show a => a -> String
groom a
outFacts'
                                            , String
"  old outFacts: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> a -> String
forall a. Show a => a -> String
groom (CFGNode l a -> a
forall l a. CFGNode l a -> a
cfgOutFacts CFGNode l a
node)
                                            , String
"  outFactsChanged: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Bool -> String
forall a. Show a => a -> String
show Bool
outFactsChanged
                                            ]) (CFG l a -> CFG l a) -> CFG l a -> CFG l a
forall a b. (a -> b) -> a -> b
$ Int -> CFGNode l a -> CFG l a -> CFG l a
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Int
currentId (CFGNode l a
node { cfgInFacts :: a
cfgInFacts = a
inFacts', cfgOutFacts :: a
cfgOutFacts = a
outFacts' }) CFG l a
cfg'
                    worklist'' :: Worklist Int
worklist'' = if Bool
outFactsChanged
                        then [Int] -> Worklist Int -> Worklist Int
forall a. [a] -> Worklist a -> Worklist a
pushList (CFGNode l a -> [Int]
forall l a. CFGNode l a -> [Int]
cfgSuccs CFGNode l a
node) Worklist Int
worklist'
                        else Worklist Int
worklist'
                    accumulatedWork' :: Set (l, [Int])
accumulatedWork' = Set (l, [Int]) -> Set (l, [Int]) -> Set (l, [Int])
forall a. Ord a => Set a -> Set a -> Set a
Set.union Set (l, [Int])
accumulatedWork Set (l, [Int])
blockWork
                in
                    Worklist Int
-> CFG l a -> Set (l, [Int]) -> (CFG l a, Set (l, [Int]))
go Worklist Int
worklist'' CFG l a
cfg'' Set (l, [Int])
accumulatedWork'
            | Bool
otherwise = (CFG l a
cfg', Set (l, [Int])
accumulatedWork)

data BuilderState c l a = BuilderState
    { BuilderState c l a -> c l
bsCtx        :: c l
    , BuilderState c l a -> [Node (Lexeme l)]
bsStmts      :: [C.Node (C.Lexeme l)]
    , BuilderState c l a -> CFG l a
bsCfg        :: CFG l a
    , BuilderState c l a -> Map l Int
bsLabels     :: Map l Int
    , BuilderState c l a -> Int
bsNextNodeId :: Int
    , BuilderState c l a -> Int
bsExitNodeId :: Int
    , BuilderState c l a -> [Int]
bsBreaks     :: [Int]
    , BuilderState c l a -> [Int]
bsContinues  :: [Int]
    }

-- | Build a control flow graph for a function definition. This is the main
-- entry point for constructing a CFG from a Cimple AST.
buildCFG :: forall c l a. (DataFlow c l a, Pretty l, Ord l, Show l) => c l -> C.Node (C.Lexeme l) -> a -> CFG l a
buildCFG :: c l -> Node (Lexeme l) -> a -> CFG l a
buildCFG c l
ctx (Fix (C.FunctionDefn Scope
_ (Fix (C.FunctionPrototype Node (Lexeme l)
_ (C.L AlexPosn
_ LexemeClass
_ l
funcName) [Node (Lexeme l)]
_)) Node (Lexeme l)
body)) a
facts =
    c l -> l -> Node (Lexeme l) -> a -> CFG l a
forall (c :: * -> *) l a.
(DataFlow c l a, Pretty l, Ord l, Show l) =>
c l -> l -> Node (Lexeme l) -> a -> CFG l a
buildCFG' c l
ctx l
funcName Node (Lexeme l)
body a
facts
buildCFG c l
_ Node (Lexeme l)
_ a
_ = CFG l a
forall k a. Map k a
Map.empty

buildCFG' :: forall c l a. (DataFlow c l a, Pretty l, Ord l, Show l) => c l -> l -> C.Node (C.Lexeme l) -> a -> CFG l a
buildCFG' :: c l -> l -> Node (Lexeme l) -> a -> CFG l a
buildCFG' c l
ctx l
funcName (Fix (C.CompoundStmt [Node (Lexeme l)]
stmts)) a
facts =
    let
        (Map l Int
labelMap, Int
maxNodeId) = [Node (Lexeme l)] -> Int -> (Map l Int, Int)
forall t. Ord t => [Node (Lexeme t)] -> Int -> (Map t Int, Int)
buildLabelMap [Node (Lexeme l)]
stmts Int
1
        exitNodeId :: Int
exitNodeId = Int
maxNodeId Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2
        exitNode :: CFGNode l a
exitNode = Int -> [Int] -> [Int] -> [Node (Lexeme l)] -> a -> a -> CFGNode l a
forall l a.
Int -> [Int] -> [Int] -> [Node (Lexeme l)] -> a -> a -> CFGNode l a
CFGNode Int
exitNodeId [] [] [] (c l -> a
forall (c :: * -> *) l a. DataFlow c l a => c l -> a
emptyFacts c l
ctx) (c l -> a
forall (c :: * -> *) l a. DataFlow c l a => c l -> a
emptyFacts c l
ctx)
        labelNodes :: Map Int (CFGNode l a)
labelNodes = [(Int, CFGNode l a)] -> Map Int (CFGNode l a)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(Int, CFGNode l a)] -> Map Int (CFGNode l a))
-> [(Int, CFGNode l a)] -> Map Int (CFGNode l a)
forall a b. (a -> b) -> a -> b
$ ((l, Int) -> (Int, CFGNode l a))
-> [(l, Int)] -> [(Int, CFGNode l a)]
forall a b. (a -> b) -> [a] -> [b]
map (\(l
_, Int
nodeId) -> (Int
nodeId, Int -> [Int] -> [Int] -> [Node (Lexeme l)] -> a -> a -> CFGNode l a
forall l a.
Int -> [Int] -> [Int] -> [Node (Lexeme l)] -> a -> a -> CFGNode l a
CFGNode Int
nodeId [] [] [] (c l -> a
forall (c :: * -> *) l a. DataFlow c l a => c l -> a
emptyFacts c l
ctx) (c l -> a
forall (c :: * -> *) l a. DataFlow c l a => c l -> a
emptyFacts c l
ctx))) ([(l, Int)] -> [(Int, CFGNode l a)])
-> [(l, Int)] -> [(Int, CFGNode l a)]
forall a b. (a -> b) -> a -> b
$ Map l Int -> [(l, Int)]
forall k a. Map k a -> [(k, a)]
Map.toList Map l Int
labelMap
        (a
outFacts, Set Any
_) = ((a, Set Any) -> Node (Lexeme l) -> (a, Set Any))
-> (a, Set Any) -> [Node (Lexeme l)] -> (a, Set Any)
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl'
            (\(a
accFacts, Set Any
_) Node (Lexeme l)
stmt ->
                let (a
newFacts, Set (l, [Int])
_) = c l -> l -> a -> Node (Lexeme l) -> (a, Set (l, [Int]))
forall (c :: * -> *) l a.
DataFlow c l a =>
c l -> l -> a -> Node (Lexeme l) -> (a, Set (l, [Int]))
transfer c l
ctx l
funcName a
accFacts Node (Lexeme l)
stmt
                in (a
newFacts, Set Any
forall a. Set a
Set.empty))
            (a
facts, Set Any
forall a. Set a
Set.empty)
            []
        initialCfg :: Map Int (CFGNode l a)
initialCfg = Int
-> CFGNode l a -> Map Int (CFGNode l a) -> Map Int (CFGNode l a)
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Int
exitNodeId CFGNode l a
forall l. CFGNode l a
exitNode (Map Int (CFGNode l a) -> Map Int (CFGNode l a))
-> Map Int (CFGNode l a) -> Map Int (CFGNode l a)
forall a b. (a -> b) -> a -> b
$ Map Int (CFGNode l a)
-> Map Int (CFGNode l a) -> Map Int (CFGNode l a)
forall k a. Ord k => Map k a -> Map k a -> Map k a
Map.union Map Int (CFGNode l a)
forall l. Map Int (CFGNode l a)
labelNodes (Map Int (CFGNode l a) -> Map Int (CFGNode l a))
-> Map Int (CFGNode l a) -> Map Int (CFGNode l a)
forall a b. (a -> b) -> a -> b
$ Int -> CFGNode l a -> Map Int (CFGNode l a)
forall k a. k -> a -> Map k a
Map.singleton Int
0 (Int -> [Int] -> [Int] -> [Node (Lexeme l)] -> a -> a -> CFGNode l a
forall l a.
Int -> [Int] -> [Int] -> [Node (Lexeme l)] -> a -> a -> CFGNode l a
CFGNode Int
0 [] [] [] a
facts a
outFacts)
        initialState :: BuilderState c l a
initialState = BuilderState :: forall (c :: * -> *) l a.
c l
-> [Node (Lexeme l)]
-> CFG l a
-> Map l Int
-> Int
-> Int
-> [Int]
-> [Int]
-> BuilderState c l a
BuilderState
            { bsCtx :: c l
bsCtx = c l
ctx
            , bsStmts :: [Node (Lexeme l)]
bsStmts = []
            , bsCfg :: CFG l a
bsCfg = CFG l a
forall l. Map Int (CFGNode l a)
initialCfg
            , bsLabels :: Map l Int
bsLabels = Map l Int
labelMap
            , bsNextNodeId :: Int
bsNextNodeId = Int
exitNodeId Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
            , bsExitNodeId :: Int
bsExitNodeId = Int
exitNodeId
            , bsBreaks :: [Int]
bsBreaks = []
            , bsContinues :: [Int]
bsContinues = []
            }
        (Int
lastNodeId, BuilderState c l a
finalState) = State (BuilderState c l a) Int
-> BuilderState c l a -> (Int, BuilderState c l a)
forall s a. State s a -> s -> (a, s)
runState ([Node (Lexeme l)] -> Int -> State (BuilderState c l a) Int
forall (c :: * -> *) l a.
(DataFlow c l a, Pretty l, Ord l, Show l) =>
[Node (Lexeme l)] -> Int -> State (BuilderState c l a) Int
buildStmts [Node (Lexeme l)]
stmts Int
0) BuilderState c l a
initialState
        cfg :: CFG l a
cfg = BuilderState c l a -> CFG l a
forall (c :: * -> *) l a. BuilderState c l a -> CFG l a
bsCfg BuilderState c l a
finalState

        -- Connect the last node to the exit node if it's a fallthrough.
        lastNode :: CFGNode l a
lastNode = String -> CFG l a -> Int -> CFGNode l a
forall k a. (Ord k, Show k) => String -> Map k a -> k -> a
lookupOrError String
"buildCFG" CFG l a
cfg Int
lastNodeId
        intermediateCfg :: CFG l a
intermediateCfg = if [Int] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (CFGNode l a -> [Int]
forall l a. CFGNode l a -> [Int]
cfgSuccs CFGNode l a
lastNode) Bool -> Bool -> Bool
&& (CFGNode l a -> Int
forall l a. CFGNode l a -> Int
cfgNodeId CFGNode l a
lastNode Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 Bool -> Bool -> Bool
|| Bool -> Bool
not ([Int] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (CFGNode l a -> [Int]
forall l a. CFGNode l a -> [Int]
cfgPreds CFGNode l a
lastNode))) Bool -> Bool -> Bool
&& CFGNode l a -> Int
forall l a. CFGNode l a -> Int
cfgNodeId CFGNode l a
lastNode Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= BuilderState c l a -> Int
forall (c :: * -> *) l a. BuilderState c l a -> Int
bsExitNodeId BuilderState c l a
finalState then
            (CFGNode l a -> CFGNode l a) -> Int -> CFG l a -> CFG l a
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
Map.adjust (\CFGNode l a
n -> CFGNode l a
n { cfgSuccs :: [Int]
cfgSuccs = [BuilderState c l a -> Int
forall (c :: * -> *) l a. BuilderState c l a -> Int
bsExitNodeId BuilderState c l a
finalState] }) Int
lastNodeId (CFG l a -> CFG l a) -> CFG l a -> CFG l a
forall a b. (a -> b) -> a -> b
$
            (CFGNode l a -> CFGNode l a) -> Int -> CFG l a -> CFG l a
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
Map.adjust (\CFGNode l a
n -> CFGNode l a
n { cfgPreds :: [Int]
cfgPreds = CFGNode l a -> [Int]
forall l a. CFGNode l a -> [Int]
cfgPreds CFGNode l a
n [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ [Int
lastNodeId] }) (BuilderState c l a -> Int
forall (c :: * -> *) l a. BuilderState c l a -> Int
bsExitNodeId BuilderState c l a
finalState) CFG l a
cfg
        else
            CFG l a
cfg

        -- Prune unreachable nodes
        reachable :: Set Int
reachable = Set Int -> [Int] -> Set Int
go (Int -> Set Int
forall a. a -> Set a
Set.singleton Int
0) [Int
0]
          where
            go :: Set Int -> [Int] -> Set Int
go Set Int
visited [] = Set Int
visited
            go Set Int
visited (Int
curr:[Int]
rest) =
                let
                    node :: CFGNode l a
node = String -> CFG l a -> Int -> CFGNode l a
forall k a. (Ord k, Show k) => String -> Map k a -> k -> a
lookupOrError String
"buildCFG" CFG l a
intermediateCfg Int
curr
                    newSuccs :: [Int]
newSuccs = (Int -> Bool) -> [Int] -> [Int]
forall a. (a -> Bool) -> [a] -> [a]
filter (Int -> Set Int -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.notMember` Set Int
visited) (CFGNode l a -> [Int]
forall l a. CFGNode l a -> [Int]
cfgSuccs CFGNode l a
node)
                in
                    Set Int -> [Int] -> Set Int
go (Set Int -> Set Int -> Set Int
forall a. Ord a => Set a -> Set a -> Set a
Set.union Set Int
visited ([Int] -> Set Int
forall a. Ord a => [a] -> Set a
Set.fromList [Int]
newSuccs)) ([Int]
rest [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ [Int]
newSuccs)

        finalCfg :: CFG l a
finalCfg = (Int -> CFGNode l a -> Bool) -> CFG l a -> CFG l a
forall k a. (k -> a -> Bool) -> Map k a -> Map k a
Map.filterWithKey (\Int
k CFGNode l a
_ -> Int
k Int -> Set Int -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set Int
reachable) CFG l a
intermediateCfg
    in
        String -> CFG l a -> CFG l a
forall a. String -> a -> a
dtrace (String
"\n--- CFG for " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> l -> String
forall a. Show a => a -> String
show l
funcName String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" ---\n" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Map Int (Int, [Int], [Int], [Text]) -> String
forall a. Show a => a -> String
show ((CFGNode l a -> (Int, [Int], [Int], [Text]))
-> CFG l a -> Map Int (Int, [Int], [Int], [Text])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\CFGNode l a
n -> (CFGNode l a -> Int
forall l a. CFGNode l a -> Int
cfgNodeId CFGNode l a
n, CFGNode l a -> [Int]
forall l a. CFGNode l a -> [Int]
cfgPreds CFGNode l a
n, CFGNode l a -> [Int]
forall l a. CFGNode l a -> [Int]
cfgSuccs CFGNode l a
n, (Node (Lexeme l) -> Text) -> [Node (Lexeme l)] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Node (Lexeme l) -> Text
forall a. Pretty a => Node (Lexeme a) -> Text
showNodePlain (CFGNode l a -> [Node (Lexeme l)]
forall l a. CFGNode l a -> [Node (Lexeme l)]
cfgStmts CFGNode l a
n))) CFG l a
finalCfg)) CFG l a
finalCfg
buildCFG' c l
_ l
_ Node (Lexeme l)
_ a
_ = CFG l a
forall k a. Map k a
Map.empty



getCompoundStmts :: C.Node (C.Lexeme l) -> [C.Node (C.Lexeme l)]
getCompoundStmts :: Node (Lexeme l) -> [Node (Lexeme l)]
getCompoundStmts (Fix (C.CompoundStmt [Node (Lexeme l)]
stmts)) = [Node (Lexeme l)]
stmts
getCompoundStmts Node (Lexeme l)
stmt                         = [Node (Lexeme l)
stmt]

buildLabelMap :: Ord t => [C.Node (C.Lexeme t)] -> Int -> (Map t Int, Int)
buildLabelMap :: [Node (Lexeme t)] -> Int -> (Map t Int, Int)
buildLabelMap [Node (Lexeme t)]
stmts Int
startId =
    ((Map t Int, Int) -> Node (Lexeme t) -> (Map t Int, Int))
-> (Map t Int, Int) -> [Node (Lexeme t)] -> (Map t Int, Int)
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (Map t Int, Int) -> Node (Lexeme t) -> (Map t Int, Int)
forall k.
Ord k =>
(Map k Int, Int) -> Fix (NodeF (Lexeme k)) -> (Map k Int, Int)
go (Map t Int
forall k a. Map k a
Map.empty, Int
startId) [Node (Lexeme t)]
stmts
    where
        go :: (Map k Int, Int) -> Fix (NodeF (Lexeme k)) -> (Map k Int, Int)
go (Map k Int
acc, Int
nodeId) (Fix (C.Label (C.L AlexPosn
_ LexemeClass
_ k
label) Fix (NodeF (Lexeme k))
_)) = (k -> Int -> Map k Int -> Map k Int
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert k
label Int
nodeId Map k Int
acc, Int
nodeId Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
        go (Map k Int
acc, Int
nodeId) (Fix (C.IfStmt Fix (NodeF (Lexeme k))
_ Fix (NodeF (Lexeme k))
thenB Maybe (Fix (NodeF (Lexeme k)))
mElseB)) =
            let (Map k Int
acc', Int
nextId') = (Map k Int, Int) -> Fix (NodeF (Lexeme k)) -> (Map k Int, Int)
go (Map k Int
acc, Int
nodeId Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Fix (NodeF (Lexeme k))
thenB
                (Map k Int
acc'', Int
nextId'') = case Maybe (Fix (NodeF (Lexeme k)))
mElseB of
                    Just Fix (NodeF (Lexeme k))
elseB -> (Map k Int, Int) -> Fix (NodeF (Lexeme k)) -> (Map k Int, Int)
go (Map k Int
acc', Int
nextId' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Fix (NodeF (Lexeme k))
elseB
                    Maybe (Fix (NodeF (Lexeme k)))
Nothing    -> (Map k Int
acc', Int
nextId')
            in (Map k Int
acc'', Int
nextId'' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
        go (Map k Int
acc, Int
nodeId) (Fix (C.WhileStmt Fix (NodeF (Lexeme k))
_ Fix (NodeF (Lexeme k))
body)) =
            let (Map k Int
acc', Int
nextId') = (Map k Int, Int) -> Fix (NodeF (Lexeme k)) -> (Map k Int, Int)
go (Map k Int
acc, Int
nodeId Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Fix (NodeF (Lexeme k))
body
            in (Map k Int
acc', Int
nextId' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
        go (Map k Int
acc, Int
nodeId) (Fix (C.ForStmt Fix (NodeF (Lexeme k))
_ Fix (NodeF (Lexeme k))
_ Fix (NodeF (Lexeme k))
_ Fix (NodeF (Lexeme k))
body)) =
            let (Map k Int
acc', Int
nextId') = (Map k Int, Int) -> Fix (NodeF (Lexeme k)) -> (Map k Int, Int)
go (Map k Int
acc, Int
nodeId Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Fix (NodeF (Lexeme k))
body
            in (Map k Int
acc', Int
nextId' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
        go (Map k Int
acc, Int
nodeId) (Fix (C.DoWhileStmt Fix (NodeF (Lexeme k))
body Fix (NodeF (Lexeme k))
_)) =
            let (Map k Int
acc', Int
nextId') = (Map k Int, Int) -> Fix (NodeF (Lexeme k)) -> (Map k Int, Int)
go (Map k Int
acc, Int
nodeId Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Fix (NodeF (Lexeme k))
body
            in (Map k Int
acc', Int
nextId' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
        go (Map k Int
acc, Int
nodeId) (Fix (C.SwitchStmt Fix (NodeF (Lexeme k))
_ [Fix (NodeF (Lexeme k))]
body)) =
            let (Map k Int
acc', Int
nextId') = ((Map k Int, Int) -> Fix (NodeF (Lexeme k)) -> (Map k Int, Int))
-> (Map k Int, Int) -> [Fix (NodeF (Lexeme k))] -> (Map k Int, Int)
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\(Map k Int
a, Int
n) Fix (NodeF (Lexeme k))
s -> (Map k Int, Int) -> Fix (NodeF (Lexeme k)) -> (Map k Int, Int)
go (Map k Int
a, Int
n) Fix (NodeF (Lexeme k))
s) (Map k Int
acc, Int
nodeId Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) [Fix (NodeF (Lexeme k))]
body
            in (Map k Int
acc', Int
nextId' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [Fix (NodeF (Lexeme k))] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Fix (NodeF (Lexeme k))]
body Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
        go (Map k Int
acc, Int
nodeId) (Fix (C.CompoundStmt [Fix (NodeF (Lexeme k))]
stmts')) =
            ((Map k Int, Int) -> Fix (NodeF (Lexeme k)) -> (Map k Int, Int))
-> (Map k Int, Int) -> [Fix (NodeF (Lexeme k))] -> (Map k Int, Int)
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (Map k Int, Int) -> Fix (NodeF (Lexeme k)) -> (Map k Int, Int)
go (Map k Int
acc, Int
nodeId) [Fix (NodeF (Lexeme k))]
stmts'
        go (Map k Int
acc, Int
nodeId) Fix (NodeF (Lexeme k))
_ = (Map k Int
acc, Int
nodeId)

buildStmts :: (DataFlow c l a, Pretty l, Ord l, Show l) => [C.Node (C.Lexeme l)] -> Int -> State (BuilderState c l a) Int
buildStmts :: [Node (Lexeme l)] -> Int -> State (BuilderState c l a) Int
buildStmts [Node (Lexeme l)]
stmts Int
currNodeId = (Int -> Node (Lexeme l) -> State (BuilderState c l a) Int)
-> Int -> [Node (Lexeme l)] -> State (BuilderState c l a) Int
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM Int -> Node (Lexeme l) -> State (BuilderState c l a) Int
forall (c :: * -> *) l a.
(DataFlow c l a, Pretty l, Ord l, Show l) =>
Int -> Node (Lexeme l) -> State (BuilderState c l a) Int
buildStmt Int
currNodeId [Node (Lexeme l)]
stmts

newDisconnectedNode :: (DataFlow c l a) => State (BuilderState c l a) Int
newDisconnectedNode :: State (BuilderState c l a) Int
newDisconnectedNode = do
    BuilderState c l a
st <- StateT (BuilderState c l a) Identity (BuilderState c l a)
forall s (m :: * -> *). MonadState s m => m s
get
    let newNodeId :: Int
newNodeId = BuilderState c l a -> Int
forall (c :: * -> *) l a. BuilderState c l a -> Int
bsNextNodeId BuilderState c l a
st
    let newNode :: CFGNode l a
newNode = Int -> [Int] -> [Int] -> [Node (Lexeme l)] -> a -> a -> CFGNode l a
forall l a.
Int -> [Int] -> [Int] -> [Node (Lexeme l)] -> a -> a -> CFGNode l a
CFGNode Int
newNodeId [] [] [] (c l -> a
forall (c :: * -> *) l a. DataFlow c l a => c l -> a
emptyFacts (BuilderState c l a -> c l
forall (c :: * -> *) l a. BuilderState c l a -> c l
bsCtx BuilderState c l a
st)) (c l -> a
forall (c :: * -> *) l a. DataFlow c l a => c l -> a
emptyFacts (BuilderState c l a -> c l
forall (c :: * -> *) l a. BuilderState c l a -> c l
bsCtx BuilderState c l a
st))
    BuilderState c l a -> StateT (BuilderState c l a) Identity ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (BuilderState c l a -> StateT (BuilderState c l a) Identity ())
-> BuilderState c l a -> StateT (BuilderState c l a) Identity ()
forall a b. (a -> b) -> a -> b
$ BuilderState c l a
st { bsCfg :: CFG l a
bsCfg = Int -> CFGNode l a -> CFG l a -> CFG l a
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Int
newNodeId CFGNode l a
forall l. CFGNode l a
newNode (BuilderState c l a -> CFG l a
forall (c :: * -> *) l a. BuilderState c l a -> CFG l a
bsCfg BuilderState c l a
st), bsNextNodeId :: Int
bsNextNodeId = Int
newNodeId Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 }
    Int -> State (BuilderState c l a) Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
newNodeId

buildStmt :: forall c l a. (DataFlow c l a, Pretty l, Ord l, Show l) => Int -> C.Node (C.Lexeme l) -> State (BuilderState c l a) Int
buildStmt :: Int -> Node (Lexeme l) -> State (BuilderState c l a) Int
buildStmt Int
currNodeId stmt :: Node (Lexeme l)
stmt@(Fix NodeF (Lexeme l) (Node (Lexeme l))
s') = String
-> State (BuilderState c l a) Int -> State (BuilderState c l a) Int
forall a. String -> a -> a
dtrace (String
"buildStmt processing: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack (Node (Lexeme l) -> Text
forall a. Pretty a => Node (Lexeme a) -> Text
showNodePlain Node (Lexeme l)
stmt)) (State (BuilderState c l a) Int -> State (BuilderState c l a) Int)
-> State (BuilderState c l a) Int -> State (BuilderState c l a) Int
forall a b. (a -> b) -> a -> b
$ case NodeF (Lexeme l) (Node (Lexeme l))
s' of
    C.CompoundStmt [Node (Lexeme l)]
stmts' -> [Node (Lexeme l)] -> Int -> State (BuilderState c l a) Int
forall (c :: * -> *) l a.
(DataFlow c l a, Pretty l, Ord l, Show l) =>
[Node (Lexeme l)] -> Int -> State (BuilderState c l a) Int
buildStmts [Node (Lexeme l)]
stmts' Int
currNodeId
    C.Label (C.L AlexPosn
_ LexemeClass
_ l
label) Node (Lexeme l)
innerStmt -> do
        BuilderState c l a
st <- StateT (BuilderState c l a) Identity (BuilderState c l a)
forall s (m :: * -> *). MonadState s m => m s
get
        let labelNodeId :: Int
labelNodeId = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe (String -> Int
forall a. HasCallStack => String -> a
error (String -> Int) -> String -> Int
forall a b. (a -> b) -> a -> b
$ String
"Label not found: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ l -> String
forall a. Show a => a -> String
show l
label) (l -> Map l Int -> Maybe Int
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup l
label (BuilderState c l a -> Map l Int
forall (c :: * -> *) l a. BuilderState c l a -> Map l Int
bsLabels BuilderState c l a
st))
        let currentNode :: CFGNode l a
currentNode = String -> Map Int (CFGNode l a) -> Int -> CFGNode l a
forall k a. (Ord k, Show k) => String -> Map k a -> k -> a
lookupOrError String
"buildStmt Label" (BuilderState c l a -> Map Int (CFGNode l a)
forall (c :: * -> *) l a. BuilderState c l a -> CFG l a
bsCfg BuilderState c l a
st) Int
currNodeId
        if (Bool -> Bool
not ([Int] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (CFGNode l a -> [Int]
forall l a. CFGNode l a -> [Int]
cfgPreds CFGNode l a
currentNode)) Bool -> Bool -> Bool
|| Int
currNodeId Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0) Bool -> Bool -> Bool
&& [Int] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (CFGNode l a -> [Int]
forall l a. CFGNode l a -> [Int]
cfgSuccs CFGNode l a
currentNode) then do
            let cfg' :: Map Int (CFGNode l a)
cfg' = (CFGNode l a -> CFGNode l a)
-> Int -> Map Int (CFGNode l a) -> Map Int (CFGNode l a)
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
Map.adjust (\CFGNode l a
n -> CFGNode l a
n { cfgSuccs :: [Int]
cfgSuccs = CFGNode l a -> [Int]
forall l a. CFGNode l a -> [Int]
cfgSuccs CFGNode l a
n [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ [Int
labelNodeId] }) Int
currNodeId (BuilderState c l a -> Map Int (CFGNode l a)
forall (c :: * -> *) l a. BuilderState c l a -> CFG l a
bsCfg BuilderState c l a
st)
            let cfg'' :: Map Int (CFGNode l a)
cfg'' = (CFGNode l a -> CFGNode l a)
-> Int -> Map Int (CFGNode l a) -> Map Int (CFGNode l a)
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
Map.adjust (\CFGNode l a
n -> CFGNode l a
n { cfgPreds :: [Int]
cfgPreds = CFGNode l a -> [Int]
forall l a. CFGNode l a -> [Int]
cfgPreds CFGNode l a
n [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ [Int
currNodeId] }) Int
labelNodeId Map Int (CFGNode l a)
cfg'
            BuilderState c l a -> StateT (BuilderState c l a) Identity ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (BuilderState c l a -> StateT (BuilderState c l a) Identity ())
-> BuilderState c l a -> StateT (BuilderState c l a) Identity ()
forall a b. (a -> b) -> a -> b
$ BuilderState c l a
st { bsCfg :: Map Int (CFGNode l a)
bsCfg = Map Int (CFGNode l a)
cfg'' }
        else
            () -> StateT (BuilderState c l a) Identity ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        Int -> Node (Lexeme l) -> State (BuilderState c l a) Int
forall (c :: * -> *) l a.
(DataFlow c l a, Pretty l, Ord l, Show l) =>
Int -> Node (Lexeme l) -> State (BuilderState c l a) Int
buildStmt Int
labelNodeId Node (Lexeme l)
innerStmt
    C.Goto (C.L AlexPosn
_ LexemeClass
_ l
label) -> do
        BuilderState c l a
st <- StateT (BuilderState c l a) Identity (BuilderState c l a)
forall s (m :: * -> *). MonadState s m => m s
get
        let labelNodeId :: Int
labelNodeId = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe (String -> Int
forall a. HasCallStack => String -> a
error (String -> Int) -> String -> Int
forall a b. (a -> b) -> a -> b
$ String
"Label not found: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ l -> String
forall a. Show a => a -> String
show l
label) (l -> Map l Int -> Maybe Int
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup l
label (BuilderState c l a -> Map l Int
forall (c :: * -> *) l a. BuilderState c l a -> Map l Int
bsLabels BuilderState c l a
st))
        let updatedCfg :: Map Int (CFGNode l a)
updatedCfg = (CFGNode l a -> CFGNode l a)
-> Int -> Map Int (CFGNode l a) -> Map Int (CFGNode l a)
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
Map.adjust (\CFGNode l a
n -> CFGNode l a
n { cfgSuccs :: [Int]
cfgSuccs = [Int
labelNodeId] }) Int
currNodeId (BuilderState c l a -> Map Int (CFGNode l a)
forall (c :: * -> *) l a. BuilderState c l a -> CFG l a
bsCfg BuilderState c l a
st)
        let cfgWithPred :: Map Int (CFGNode l a)
cfgWithPred = (CFGNode l a -> CFGNode l a)
-> Int -> Map Int (CFGNode l a) -> Map Int (CFGNode l a)
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
Map.adjust (\CFGNode l a
n -> CFGNode l a
n { cfgPreds :: [Int]
cfgPreds = CFGNode l a -> [Int]
forall l a. CFGNode l a -> [Int]
cfgPreds CFGNode l a
n [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ [Int
currNodeId] }) Int
labelNodeId Map Int (CFGNode l a)
updatedCfg
        BuilderState c l a -> StateT (BuilderState c l a) Identity ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (BuilderState c l a -> StateT (BuilderState c l a) Identity ())
-> BuilderState c l a -> StateT (BuilderState c l a) Identity ()
forall a b. (a -> b) -> a -> b
$ BuilderState c l a
st { bsCfg :: Map Int (CFGNode l a)
bsCfg = Map Int (CFGNode l a)
cfgWithPred }
        State (BuilderState c l a) Int
forall (c :: * -> *) l a.
DataFlow c l a =>
State (BuilderState c l a) Int
newDisconnectedNode
    C.IfStmt Node (Lexeme l)
cond Node (Lexeme l)
thenB Maybe (Node (Lexeme l))
mElseB -> do
        (BuilderState c l a -> BuilderState c l a)
-> StateT (BuilderState c l a) Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((BuilderState c l a -> BuilderState c l a)
 -> StateT (BuilderState c l a) Identity ())
-> (BuilderState c l a -> BuilderState c l a)
-> StateT (BuilderState c l a) Identity ()
forall a b. (a -> b) -> a -> b
$ \BuilderState c l a
st -> BuilderState c l a
st { bsCfg :: Map Int (CFGNode l a)
bsCfg = (CFGNode l a -> CFGNode l a)
-> Int -> Map Int (CFGNode l a) -> Map Int (CFGNode l a)
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
Map.adjust (\CFGNode l a
n -> CFGNode l a
n { cfgStmts :: [Node (Lexeme l)]
cfgStmts = CFGNode l a -> [Node (Lexeme l)]
forall l a. CFGNode l a -> [Node (Lexeme l)]
cfgStmts CFGNode l a
n [Node (Lexeme l)] -> [Node (Lexeme l)] -> [Node (Lexeme l)]
forall a. [a] -> [a] -> [a]
++ [Node (Lexeme l)
cond] }) Int
currNodeId (BuilderState c l a -> Map Int (CFGNode l a)
forall (c :: * -> *) l a. BuilderState c l a -> CFG l a
bsCfg BuilderState c l a
st) }
        BuilderState c l a
st <- StateT (BuilderState c l a) Identity (BuilderState c l a)
forall s (m :: * -> *). MonadState s m => m s
get
        let thenNodeId :: Int
thenNodeId = BuilderState c l a -> Int
forall (c :: * -> *) l a. BuilderState c l a -> Int
bsNextNodeId BuilderState c l a
st
        case Maybe (Node (Lexeme l))
mElseB of
            Just Node (Lexeme l)
elseB -> do
                let elseNodeId :: Int
elseNodeId = Int
thenNodeId Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
                let mergeNodeId :: Int
mergeNodeId = Int
elseNodeId Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
                let thenNode :: CFGNode l a
thenNode = Int -> [Int] -> [Int] -> [Node (Lexeme l)] -> a -> a -> CFGNode l a
forall l a.
Int -> [Int] -> [Int] -> [Node (Lexeme l)] -> a -> a -> CFGNode l a
CFGNode Int
thenNodeId [Int
currNodeId] [] [] (c l -> a
forall (c :: * -> *) l a. DataFlow c l a => c l -> a
emptyFacts (BuilderState c l a -> c l
forall (c :: * -> *) l a. BuilderState c l a -> c l
bsCtx BuilderState c l a
st)) (c l -> a
forall (c :: * -> *) l a. DataFlow c l a => c l -> a
emptyFacts (BuilderState c l a -> c l
forall (c :: * -> *) l a. BuilderState c l a -> c l
bsCtx BuilderState c l a
st))
                let elseNode :: CFGNode l a
elseNode = Int -> [Int] -> [Int] -> [Node (Lexeme l)] -> a -> a -> CFGNode l a
forall l a.
Int -> [Int] -> [Int] -> [Node (Lexeme l)] -> a -> a -> CFGNode l a
CFGNode Int
elseNodeId [Int
currNodeId] [] [] (c l -> a
forall (c :: * -> *) l a. DataFlow c l a => c l -> a
emptyFacts (BuilderState c l a -> c l
forall (c :: * -> *) l a. BuilderState c l a -> c l
bsCtx BuilderState c l a
st)) (c l -> a
forall (c :: * -> *) l a. DataFlow c l a => c l -> a
emptyFacts (BuilderState c l a -> c l
forall (c :: * -> *) l a. BuilderState c l a -> c l
bsCtx BuilderState c l a
st))
                let mergeNode :: CFGNode l a
mergeNode = Int -> [Int] -> [Int] -> [Node (Lexeme l)] -> a -> a -> CFGNode l a
forall l a.
Int -> [Int] -> [Int] -> [Node (Lexeme l)] -> a -> a -> CFGNode l a
CFGNode Int
mergeNodeId [] [] [] (c l -> a
forall (c :: * -> *) l a. DataFlow c l a => c l -> a
emptyFacts (BuilderState c l a -> c l
forall (c :: * -> *) l a. BuilderState c l a -> c l
bsCtx BuilderState c l a
st)) (c l -> a
forall (c :: * -> *) l a. DataFlow c l a => c l -> a
emptyFacts (BuilderState c l a -> c l
forall (c :: * -> *) l a. BuilderState c l a -> c l
bsCtx BuilderState c l a
st))
                let updatedCfg :: Map Int (CFGNode l a)
updatedCfg = Int
-> CFGNode l a -> Map Int (CFGNode l a) -> Map Int (CFGNode l a)
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Int
thenNodeId CFGNode l a
forall l. CFGNode l a
thenNode (Map Int (CFGNode l a) -> Map Int (CFGNode l a))
-> Map Int (CFGNode l a) -> Map Int (CFGNode l a)
forall a b. (a -> b) -> a -> b
$ Int
-> CFGNode l a -> Map Int (CFGNode l a) -> Map Int (CFGNode l a)
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Int
elseNodeId CFGNode l a
forall l. CFGNode l a
elseNode (Map Int (CFGNode l a) -> Map Int (CFGNode l a))
-> Map Int (CFGNode l a) -> Map Int (CFGNode l a)
forall a b. (a -> b) -> a -> b
$ Int
-> CFGNode l a -> Map Int (CFGNode l a) -> Map Int (CFGNode l a)
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Int
mergeNodeId CFGNode l a
forall l. CFGNode l a
mergeNode (BuilderState c l a -> Map Int (CFGNode l a)
forall (c :: * -> *) l a. BuilderState c l a -> CFG l a
bsCfg BuilderState c l a
st)
                let cfgWithSuccs :: Map Int (CFGNode l a)
cfgWithSuccs = (CFGNode l a -> CFGNode l a)
-> Int -> Map Int (CFGNode l a) -> Map Int (CFGNode l a)
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
Map.adjust (\CFGNode l a
n -> CFGNode l a
n { cfgSuccs :: [Int]
cfgSuccs = [Int
thenNodeId, Int
elseNodeId] }) Int
currNodeId Map Int (CFGNode l a)
updatedCfg
                BuilderState c l a -> StateT (BuilderState c l a) Identity ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (BuilderState c l a -> StateT (BuilderState c l a) Identity ())
-> BuilderState c l a -> StateT (BuilderState c l a) Identity ()
forall a b. (a -> b) -> a -> b
$ BuilderState c l a
st { bsCfg :: Map Int (CFGNode l a)
bsCfg = Map Int (CFGNode l a)
cfgWithSuccs, bsNextNodeId :: Int
bsNextNodeId = Int
mergeNodeId Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 }
                Int
lastThenNodeId <- [Node (Lexeme l)] -> Int -> State (BuilderState c l a) Int
forall (c :: * -> *) l a.
(DataFlow c l a, Pretty l, Ord l, Show l) =>
[Node (Lexeme l)] -> Int -> State (BuilderState c l a) Int
buildStmts (Node (Lexeme l) -> [Node (Lexeme l)]
forall l. Node (Lexeme l) -> [Node (Lexeme l)]
getCompoundStmts Node (Lexeme l)
thenB) Int
thenNodeId
                Int
lastElseNodeId <- [Node (Lexeme l)] -> Int -> State (BuilderState c l a) Int
forall (c :: * -> *) l a.
(DataFlow c l a, Pretty l, Ord l, Show l) =>
[Node (Lexeme l)] -> Int -> State (BuilderState c l a) Int
buildStmts (Node (Lexeme l) -> [Node (Lexeme l)]
forall l. Node (Lexeme l) -> [Node (Lexeme l)]
getCompoundStmts Node (Lexeme l)
elseB) Int
elseNodeId
                BuilderState c l a
st' <- StateT (BuilderState c l a) Identity (BuilderState c l a)
forall s (m :: * -> *). MonadState s m => m s
get
                let lastThenNode :: CFGNode l a
lastThenNode = String -> Map Int (CFGNode l a) -> Int -> CFGNode l a
forall k a. (Ord k, Show k) => String -> Map k a -> k -> a
lookupOrError String
"buildStmt IfStmt" (BuilderState c l a -> Map Int (CFGNode l a)
forall (c :: * -> *) l a. BuilderState c l a -> CFG l a
bsCfg BuilderState c l a
st') Int
lastThenNodeId
                let lastElseNode :: CFGNode l a
lastElseNode = String -> Map Int (CFGNode l a) -> Int -> CFGNode l a
forall k a. (Ord k, Show k) => String -> Map k a -> k -> a
lookupOrError String
"buildStmt IfStmt" (BuilderState c l a -> Map Int (CFGNode l a)
forall (c :: * -> *) l a. BuilderState c l a -> CFG l a
bsCfg BuilderState c l a
st') Int
lastElseNodeId
                let cfgWithThen :: Map Int (CFGNode l a)
cfgWithThen = if [Int] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (CFGNode l a -> [Int]
forall l a. CFGNode l a -> [Int]
cfgSuccs CFGNode l a
lastThenNode)
                                  then (CFGNode l a -> CFGNode l a)
-> Int -> Map Int (CFGNode l a) -> Map Int (CFGNode l a)
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
Map.adjust (\CFGNode l a
n -> CFGNode l a
n { cfgSuccs :: [Int]
cfgSuccs = [Int
mergeNodeId] }) Int
lastThenNodeId (BuilderState c l a -> Map Int (CFGNode l a)
forall (c :: * -> *) l a. BuilderState c l a -> CFG l a
bsCfg BuilderState c l a
st')
                                  else BuilderState c l a -> Map Int (CFGNode l a)
forall (c :: * -> *) l a. BuilderState c l a -> CFG l a
bsCfg BuilderState c l a
st'
                let cfgWithElse :: Map Int (CFGNode l a)
cfgWithElse = if [Int] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (CFGNode l a -> [Int]
forall l a. CFGNode l a -> [Int]
cfgSuccs CFGNode l a
lastElseNode)
                                  then (CFGNode l a -> CFGNode l a)
-> Int -> Map Int (CFGNode l a) -> Map Int (CFGNode l a)
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
Map.adjust (\CFGNode l a
n -> CFGNode l a
n { cfgSuccs :: [Int]
cfgSuccs = [Int
mergeNodeId] }) Int
lastElseNodeId Map Int (CFGNode l a)
cfgWithThen
                                  else Map Int (CFGNode l a)
cfgWithThen
                let predNodes :: [Int]
predNodes = (if [Int] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (CFGNode l a -> [Int]
forall l a. CFGNode l a -> [Int]
cfgSuccs CFGNode l a
lastThenNode) then [Int
lastThenNodeId] else []) [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++
                                (if [Int] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (CFGNode l a -> [Int]
forall l a. CFGNode l a -> [Int]
cfgSuccs CFGNode l a
lastElseNode) then [Int
lastElseNodeId] else [])
                let finalCfg :: Map Int (CFGNode l a)
finalCfg = (CFGNode l a -> CFGNode l a)
-> Int -> Map Int (CFGNode l a) -> Map Int (CFGNode l a)
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
Map.adjust (\CFGNode l a
n -> CFGNode l a
n { cfgPreds :: [Int]
cfgPreds = [Int]
predNodes }) Int
mergeNodeId Map Int (CFGNode l a)
cfgWithElse
                BuilderState c l a -> StateT (BuilderState c l a) Identity ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (BuilderState c l a -> StateT (BuilderState c l a) Identity ())
-> BuilderState c l a -> StateT (BuilderState c l a) Identity ()
forall a b. (a -> b) -> a -> b
$ BuilderState c l a
st' { bsCfg :: Map Int (CFGNode l a)
bsCfg = Map Int (CFGNode l a)
finalCfg }
                Int -> State (BuilderState c l a) Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
mergeNodeId
            Maybe (Node (Lexeme l))
Nothing -> do
                let mergeNodeId :: Int
mergeNodeId = Int
thenNodeId Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
                let thenNode :: CFGNode l a
thenNode = Int -> [Int] -> [Int] -> [Node (Lexeme l)] -> a -> a -> CFGNode l a
forall l a.
Int -> [Int] -> [Int] -> [Node (Lexeme l)] -> a -> a -> CFGNode l a
CFGNode Int
thenNodeId [Int
currNodeId] [] [] (c l -> a
forall (c :: * -> *) l a. DataFlow c l a => c l -> a
emptyFacts (BuilderState c l a -> c l
forall (c :: * -> *) l a. BuilderState c l a -> c l
bsCtx BuilderState c l a
st)) (c l -> a
forall (c :: * -> *) l a. DataFlow c l a => c l -> a
emptyFacts (BuilderState c l a -> c l
forall (c :: * -> *) l a. BuilderState c l a -> c l
bsCtx BuilderState c l a
st))
                let mergeNode :: CFGNode l a
mergeNode = Int -> [Int] -> [Int] -> [Node (Lexeme l)] -> a -> a -> CFGNode l a
forall l a.
Int -> [Int] -> [Int] -> [Node (Lexeme l)] -> a -> a -> CFGNode l a
CFGNode Int
mergeNodeId [Int
currNodeId] [] [] (c l -> a
forall (c :: * -> *) l a. DataFlow c l a => c l -> a
emptyFacts (BuilderState c l a -> c l
forall (c :: * -> *) l a. BuilderState c l a -> c l
bsCtx BuilderState c l a
st)) (c l -> a
forall (c :: * -> *) l a. DataFlow c l a => c l -> a
emptyFacts (BuilderState c l a -> c l
forall (c :: * -> *) l a. BuilderState c l a -> c l
bsCtx BuilderState c l a
st))
                let updatedCfg :: Map Int (CFGNode l a)
updatedCfg = Int
-> CFGNode l a -> Map Int (CFGNode l a) -> Map Int (CFGNode l a)
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Int
thenNodeId CFGNode l a
forall l. CFGNode l a
thenNode (Map Int (CFGNode l a) -> Map Int (CFGNode l a))
-> Map Int (CFGNode l a) -> Map Int (CFGNode l a)
forall a b. (a -> b) -> a -> b
$ Int
-> CFGNode l a -> Map Int (CFGNode l a) -> Map Int (CFGNode l a)
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Int
mergeNodeId CFGNode l a
forall l. CFGNode l a
mergeNode (BuilderState c l a -> Map Int (CFGNode l a)
forall (c :: * -> *) l a. BuilderState c l a -> CFG l a
bsCfg BuilderState c l a
st)
                let cfgWithSuccs :: Map Int (CFGNode l a)
cfgWithSuccs = (CFGNode l a -> CFGNode l a)
-> Int -> Map Int (CFGNode l a) -> Map Int (CFGNode l a)
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
Map.adjust (\CFGNode l a
n -> CFGNode l a
n { cfgSuccs :: [Int]
cfgSuccs = [Int
thenNodeId, Int
mergeNodeId] }) Int
currNodeId Map Int (CFGNode l a)
updatedCfg
                BuilderState c l a -> StateT (BuilderState c l a) Identity ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (BuilderState c l a -> StateT (BuilderState c l a) Identity ())
-> BuilderState c l a -> StateT (BuilderState c l a) Identity ()
forall a b. (a -> b) -> a -> b
$ BuilderState c l a
st { bsCfg :: Map Int (CFGNode l a)
bsCfg = Map Int (CFGNode l a)
cfgWithSuccs, bsNextNodeId :: Int
bsNextNodeId = Int
mergeNodeId Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 }
                Int
lastThenNodeId <- [Node (Lexeme l)] -> Int -> State (BuilderState c l a) Int
forall (c :: * -> *) l a.
(DataFlow c l a, Pretty l, Ord l, Show l) =>
[Node (Lexeme l)] -> Int -> State (BuilderState c l a) Int
buildStmts (Node (Lexeme l) -> [Node (Lexeme l)]
forall l. Node (Lexeme l) -> [Node (Lexeme l)]
getCompoundStmts Node (Lexeme l)
thenB) Int
thenNodeId
                BuilderState c l a
st' <- StateT (BuilderState c l a) Identity (BuilderState c l a)
forall s (m :: * -> *). MonadState s m => m s
get
                let lastThenNode :: CFGNode l a
lastThenNode = String -> Map Int (CFGNode l a) -> Int -> CFGNode l a
forall k a. (Ord k, Show k) => String -> Map k a -> k -> a
lookupOrError String
"buildStmt IfStmt" (BuilderState c l a -> Map Int (CFGNode l a)
forall (c :: * -> *) l a. BuilderState c l a -> CFG l a
bsCfg BuilderState c l a
st') Int
lastThenNodeId
                let finalCfg :: Map Int (CFGNode l a)
finalCfg = if [Int] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (CFGNode l a -> [Int]
forall l a. CFGNode l a -> [Int]
cfgSuccs CFGNode l a
lastThenNode)
                               then (CFGNode l a -> CFGNode l a)
-> Int -> Map Int (CFGNode l a) -> Map Int (CFGNode l a)
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
Map.adjust (\CFGNode l a
n -> CFGNode l a
n { cfgSuccs :: [Int]
cfgSuccs = [Int
mergeNodeId] }) Int
lastThenNodeId (Map Int (CFGNode l a) -> Map Int (CFGNode l a))
-> Map Int (CFGNode l a) -> Map Int (CFGNode l a)
forall a b. (a -> b) -> a -> b
$ (CFGNode l a -> CFGNode l a)
-> Int -> Map Int (CFGNode l a) -> Map Int (CFGNode l a)
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
Map.adjust (\CFGNode l a
n -> CFGNode l a
n { cfgPreds :: [Int]
cfgPreds = CFGNode l a -> [Int]
forall l a. CFGNode l a -> [Int]
cfgPreds CFGNode l a
n [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ [Int
lastThenNodeId] }) Int
mergeNodeId (BuilderState c l a -> Map Int (CFGNode l a)
forall (c :: * -> *) l a. BuilderState c l a -> CFG l a
bsCfg BuilderState c l a
st')
                               else BuilderState c l a -> Map Int (CFGNode l a)
forall (c :: * -> *) l a. BuilderState c l a -> CFG l a
bsCfg BuilderState c l a
st'
                BuilderState c l a -> StateT (BuilderState c l a) Identity ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (BuilderState c l a -> StateT (BuilderState c l a) Identity ())
-> BuilderState c l a -> StateT (BuilderState c l a) Identity ()
forall a b. (a -> b) -> a -> b
$ BuilderState c l a
st' { bsCfg :: Map Int (CFGNode l a)
bsCfg = Map Int (CFGNode l a)
finalCfg }
                Int -> State (BuilderState c l a) Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
mergeNodeId
    C.PreprocIfdef Lexeme l
_ [Node (Lexeme l)]
thenStmts (Fix (C.PreprocElse [Node (Lexeme l)]
elseStmts)) -> do
        BuilderState c l a
st <- StateT (BuilderState c l a) Identity (BuilderState c l a)
forall s (m :: * -> *). MonadState s m => m s
get
        let thenNodeId :: Int
thenNodeId = BuilderState c l a -> Int
forall (c :: * -> *) l a. BuilderState c l a -> Int
bsNextNodeId BuilderState c l a
st
        let elseNodeId :: Int
elseNodeId = Int
thenNodeId Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
        let mergeNodeId :: Int
mergeNodeId = Int
elseNodeId Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
        let thenNode :: CFGNode l a
thenNode = Int -> [Int] -> [Int] -> [Node (Lexeme l)] -> a -> a -> CFGNode l a
forall l a.
Int -> [Int] -> [Int] -> [Node (Lexeme l)] -> a -> a -> CFGNode l a
CFGNode Int
thenNodeId [Int
currNodeId] [] [] (c l -> a
forall (c :: * -> *) l a. DataFlow c l a => c l -> a
emptyFacts (BuilderState c l a -> c l
forall (c :: * -> *) l a. BuilderState c l a -> c l
bsCtx BuilderState c l a
st)) (c l -> a
forall (c :: * -> *) l a. DataFlow c l a => c l -> a
emptyFacts (BuilderState c l a -> c l
forall (c :: * -> *) l a. BuilderState c l a -> c l
bsCtx BuilderState c l a
st))
        let elseNode :: CFGNode l a
elseNode = Int -> [Int] -> [Int] -> [Node (Lexeme l)] -> a -> a -> CFGNode l a
forall l a.
Int -> [Int] -> [Int] -> [Node (Lexeme l)] -> a -> a -> CFGNode l a
CFGNode Int
elseNodeId [Int
currNodeId] [] [] (c l -> a
forall (c :: * -> *) l a. DataFlow c l a => c l -> a
emptyFacts (BuilderState c l a -> c l
forall (c :: * -> *) l a. BuilderState c l a -> c l
bsCtx BuilderState c l a
st)) (c l -> a
forall (c :: * -> *) l a. DataFlow c l a => c l -> a
emptyFacts (BuilderState c l a -> c l
forall (c :: * -> *) l a. BuilderState c l a -> c l
bsCtx BuilderState c l a
st))
        let mergeNode :: CFGNode l a
mergeNode = Int -> [Int] -> [Int] -> [Node (Lexeme l)] -> a -> a -> CFGNode l a
forall l a.
Int -> [Int] -> [Int] -> [Node (Lexeme l)] -> a -> a -> CFGNode l a
CFGNode Int
mergeNodeId [] [] [] (c l -> a
forall (c :: * -> *) l a. DataFlow c l a => c l -> a
emptyFacts (BuilderState c l a -> c l
forall (c :: * -> *) l a. BuilderState c l a -> c l
bsCtx BuilderState c l a
st)) (c l -> a
forall (c :: * -> *) l a. DataFlow c l a => c l -> a
emptyFacts (BuilderState c l a -> c l
forall (c :: * -> *) l a. BuilderState c l a -> c l
bsCtx BuilderState c l a
st))
        let updatedCfg :: Map Int (CFGNode l a)
updatedCfg = Int
-> CFGNode l a -> Map Int (CFGNode l a) -> Map Int (CFGNode l a)
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Int
thenNodeId CFGNode l a
forall l. CFGNode l a
thenNode (Map Int (CFGNode l a) -> Map Int (CFGNode l a))
-> Map Int (CFGNode l a) -> Map Int (CFGNode l a)
forall a b. (a -> b) -> a -> b
$ Int
-> CFGNode l a -> Map Int (CFGNode l a) -> Map Int (CFGNode l a)
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Int
elseNodeId CFGNode l a
forall l. CFGNode l a
elseNode (Map Int (CFGNode l a) -> Map Int (CFGNode l a))
-> Map Int (CFGNode l a) -> Map Int (CFGNode l a)
forall a b. (a -> b) -> a -> b
$ Int
-> CFGNode l a -> Map Int (CFGNode l a) -> Map Int (CFGNode l a)
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Int
mergeNodeId CFGNode l a
forall l. CFGNode l a
mergeNode (BuilderState c l a -> Map Int (CFGNode l a)
forall (c :: * -> *) l a. BuilderState c l a -> CFG l a
bsCfg BuilderState c l a
st)
        let cfgWithSuccs :: Map Int (CFGNode l a)
cfgWithSuccs = (CFGNode l a -> CFGNode l a)
-> Int -> Map Int (CFGNode l a) -> Map Int (CFGNode l a)
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
Map.adjust (\CFGNode l a
n -> CFGNode l a
n { cfgSuccs :: [Int]
cfgSuccs = [Int
thenNodeId, Int
elseNodeId] }) Int
currNodeId Map Int (CFGNode l a)
updatedCfg
        BuilderState c l a -> StateT (BuilderState c l a) Identity ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (BuilderState c l a -> StateT (BuilderState c l a) Identity ())
-> BuilderState c l a -> StateT (BuilderState c l a) Identity ()
forall a b. (a -> b) -> a -> b
$ BuilderState c l a
st { bsCfg :: Map Int (CFGNode l a)
bsCfg = Map Int (CFGNode l a)
cfgWithSuccs, bsNextNodeId :: Int
bsNextNodeId = Int
mergeNodeId Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 }
        Int
lastThenNodeId <- [Node (Lexeme l)] -> Int -> State (BuilderState c l a) Int
forall (c :: * -> *) l a.
(DataFlow c l a, Pretty l, Ord l, Show l) =>
[Node (Lexeme l)] -> Int -> State (BuilderState c l a) Int
buildStmts [Node (Lexeme l)]
thenStmts Int
thenNodeId
        Int
lastElseNodeId <- [Node (Lexeme l)] -> Int -> State (BuilderState c l a) Int
forall (c :: * -> *) l a.
(DataFlow c l a, Pretty l, Ord l, Show l) =>
[Node (Lexeme l)] -> Int -> State (BuilderState c l a) Int
buildStmts [Node (Lexeme l)]
elseStmts Int
elseNodeId
        BuilderState c l a
st' <- StateT (BuilderState c l a) Identity (BuilderState c l a)
forall s (m :: * -> *). MonadState s m => m s
get
        let lastThenNode :: CFGNode l a
lastThenNode = String -> Map Int (CFGNode l a) -> Int -> CFGNode l a
forall k a. (Ord k, Show k) => String -> Map k a -> k -> a
lookupOrError String
"buildStmt PreprocIfdef" (BuilderState c l a -> Map Int (CFGNode l a)
forall (c :: * -> *) l a. BuilderState c l a -> CFG l a
bsCfg BuilderState c l a
st') Int
lastThenNodeId
        let lastElseNode :: CFGNode l a
lastElseNode = String -> Map Int (CFGNode l a) -> Int -> CFGNode l a
forall k a. (Ord k, Show k) => String -> Map k a -> k -> a
lookupOrError String
"buildStmt PreprocIfdef" (BuilderState c l a -> Map Int (CFGNode l a)
forall (c :: * -> *) l a. BuilderState c l a -> CFG l a
bsCfg BuilderState c l a
st') Int
lastElseNodeId
        let cfgWithThen :: Map Int (CFGNode l a)
cfgWithThen = if [Int] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (CFGNode l a -> [Int]
forall l a. CFGNode l a -> [Int]
cfgSuccs CFGNode l a
lastThenNode)
                          then (CFGNode l a -> CFGNode l a)
-> Int -> Map Int (CFGNode l a) -> Map Int (CFGNode l a)
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
Map.adjust (\CFGNode l a
n -> CFGNode l a
n { cfgSuccs :: [Int]
cfgSuccs = [Int
mergeNodeId] }) Int
lastThenNodeId (BuilderState c l a -> Map Int (CFGNode l a)
forall (c :: * -> *) l a. BuilderState c l a -> CFG l a
bsCfg BuilderState c l a
st')
                          else BuilderState c l a -> Map Int (CFGNode l a)
forall (c :: * -> *) l a. BuilderState c l a -> CFG l a
bsCfg BuilderState c l a
st'
        let cfgWithElse :: Map Int (CFGNode l a)
cfgWithElse = if [Int] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (CFGNode l a -> [Int]
forall l a. CFGNode l a -> [Int]
cfgSuccs CFGNode l a
lastElseNode)
                          then (CFGNode l a -> CFGNode l a)
-> Int -> Map Int (CFGNode l a) -> Map Int (CFGNode l a)
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
Map.adjust (\CFGNode l a
n -> CFGNode l a
n { cfgSuccs :: [Int]
cfgSuccs = [Int
mergeNodeId] }) Int
lastElseNodeId Map Int (CFGNode l a)
cfgWithThen
                          else Map Int (CFGNode l a)
cfgWithThen
        let predNodes :: [Int]
predNodes = (if [Int] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (CFGNode l a -> [Int]
forall l a. CFGNode l a -> [Int]
cfgSuccs CFGNode l a
lastThenNode) then [Int
lastThenNodeId] else []) [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++
                        (if [Int] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (CFGNode l a -> [Int]
forall l a. CFGNode l a -> [Int]
cfgSuccs CFGNode l a
lastElseNode) then [Int
lastElseNodeId] else [])
        let finalCfg :: Map Int (CFGNode l a)
finalCfg = (CFGNode l a -> CFGNode l a)
-> Int -> Map Int (CFGNode l a) -> Map Int (CFGNode l a)
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
Map.adjust (\CFGNode l a
n -> CFGNode l a
n { cfgPreds :: [Int]
cfgPreds = [Int]
predNodes }) Int
mergeNodeId Map Int (CFGNode l a)
cfgWithElse
        BuilderState c l a -> StateT (BuilderState c l a) Identity ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (BuilderState c l a -> StateT (BuilderState c l a) Identity ())
-> BuilderState c l a -> StateT (BuilderState c l a) Identity ()
forall a b. (a -> b) -> a -> b
$ BuilderState c l a
st' { bsCfg :: Map Int (CFGNode l a)
bsCfg = Map Int (CFGNode l a)
finalCfg }
        Int -> State (BuilderState c l a) Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
mergeNodeId
    C.WhileStmt Node (Lexeme l)
cond Node (Lexeme l)
body -> do
        BuilderState c l a
st <- StateT (BuilderState c l a) Identity (BuilderState c l a)
forall s (m :: * -> *). MonadState s m => m s
get
        let condNodeId :: Int
condNodeId = BuilderState c l a -> Int
forall (c :: * -> *) l a. BuilderState c l a -> Int
bsNextNodeId BuilderState c l a
st
        let bodyNodeId :: Int
bodyNodeId = Int
condNodeId Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
        let loopExitNodeId :: Int
loopExitNodeId = Int
bodyNodeId Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1

        let condNode :: CFGNode l a
condNode = Int -> [Int] -> [Int] -> [Node (Lexeme l)] -> a -> a -> CFGNode l a
forall l a.
Int -> [Int] -> [Int] -> [Node (Lexeme l)] -> a -> a -> CFGNode l a
CFGNode Int
condNodeId [] [Int
bodyNodeId, Int
loopExitNodeId] [Node (Lexeme l)
cond] (c l -> a
forall (c :: * -> *) l a. DataFlow c l a => c l -> a
emptyFacts (BuilderState c l a -> c l
forall (c :: * -> *) l a. BuilderState c l a -> c l
bsCtx BuilderState c l a
st)) (c l -> a
forall (c :: * -> *) l a. DataFlow c l a => c l -> a
emptyFacts (BuilderState c l a -> c l
forall (c :: * -> *) l a. BuilderState c l a -> c l
bsCtx BuilderState c l a
st))
        let bodyNode :: CFGNode l a
bodyNode = Int -> [Int] -> [Int] -> [Node (Lexeme l)] -> a -> a -> CFGNode l a
forall l a.
Int -> [Int] -> [Int] -> [Node (Lexeme l)] -> a -> a -> CFGNode l a
CFGNode Int
bodyNodeId [Int
condNodeId] [] [] (c l -> a
forall (c :: * -> *) l a. DataFlow c l a => c l -> a
emptyFacts (BuilderState c l a -> c l
forall (c :: * -> *) l a. BuilderState c l a -> c l
bsCtx BuilderState c l a
st)) (c l -> a
forall (c :: * -> *) l a. DataFlow c l a => c l -> a
emptyFacts (BuilderState c l a -> c l
forall (c :: * -> *) l a. BuilderState c l a -> c l
bsCtx BuilderState c l a
st))
        let loopExitNode :: CFGNode l a
loopExitNode = Int -> [Int] -> [Int] -> [Node (Lexeme l)] -> a -> a -> CFGNode l a
forall l a.
Int -> [Int] -> [Int] -> [Node (Lexeme l)] -> a -> a -> CFGNode l a
CFGNode Int
loopExitNodeId [Int
condNodeId] [] [] (c l -> a
forall (c :: * -> *) l a. DataFlow c l a => c l -> a
emptyFacts (BuilderState c l a -> c l
forall (c :: * -> *) l a. BuilderState c l a -> c l
bsCtx BuilderState c l a
st)) (c l -> a
forall (c :: * -> *) l a. DataFlow c l a => c l -> a
emptyFacts (BuilderState c l a -> c l
forall (c :: * -> *) l a. BuilderState c l a -> c l
bsCtx BuilderState c l a
st))

        let updatedCfg :: Map Int (CFGNode l a)
updatedCfg = Int
-> CFGNode l a -> Map Int (CFGNode l a) -> Map Int (CFGNode l a)
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Int
condNodeId CFGNode l a
condNode (Map Int (CFGNode l a) -> Map Int (CFGNode l a))
-> Map Int (CFGNode l a) -> Map Int (CFGNode l a)
forall a b. (a -> b) -> a -> b
$ Int
-> CFGNode l a -> Map Int (CFGNode l a) -> Map Int (CFGNode l a)
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Int
bodyNodeId CFGNode l a
forall l. CFGNode l a
bodyNode (Map Int (CFGNode l a) -> Map Int (CFGNode l a))
-> Map Int (CFGNode l a) -> Map Int (CFGNode l a)
forall a b. (a -> b) -> a -> b
$ Int
-> CFGNode l a -> Map Int (CFGNode l a) -> Map Int (CFGNode l a)
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Int
loopExitNodeId CFGNode l a
forall l. CFGNode l a
loopExitNode (BuilderState c l a -> Map Int (CFGNode l a)
forall (c :: * -> *) l a. BuilderState c l a -> CFG l a
bsCfg BuilderState c l a
st)
        let cfgWithSuccs :: Map Int (CFGNode l a)
cfgWithSuccs = (CFGNode l a -> CFGNode l a)
-> Int -> Map Int (CFGNode l a) -> Map Int (CFGNode l a)
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
Map.adjust (\CFGNode l a
n -> CFGNode l a
n { cfgSuccs :: [Int]
cfgSuccs = CFGNode l a -> [Int]
forall l a. CFGNode l a -> [Int]
cfgSuccs CFGNode l a
n [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ [Int
condNodeId] }) Int
currNodeId Map Int (CFGNode l a)
updatedCfg
        let cfgWithPreds :: Map Int (CFGNode l a)
cfgWithPreds = (CFGNode l a -> CFGNode l a)
-> Int -> Map Int (CFGNode l a) -> Map Int (CFGNode l a)
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
Map.adjust (\CFGNode l a
n -> CFGNode l a
n { cfgPreds :: [Int]
cfgPreds = CFGNode l a -> [Int]
forall l a. CFGNode l a -> [Int]
cfgPreds CFGNode l a
n [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ [Int
currNodeId] }) Int
condNodeId Map Int (CFGNode l a)
cfgWithSuccs

        BuilderState c l a -> StateT (BuilderState c l a) Identity ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (BuilderState c l a -> StateT (BuilderState c l a) Identity ())
-> BuilderState c l a -> StateT (BuilderState c l a) Identity ()
forall a b. (a -> b) -> a -> b
$ BuilderState c l a
st { bsCfg :: Map Int (CFGNode l a)
bsCfg = Map Int (CFGNode l a)
cfgWithPreds, bsNextNodeId :: Int
bsNextNodeId = Int
loopExitNodeId Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1, bsBreaks :: [Int]
bsBreaks = Int
loopExitNodeId Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: BuilderState c l a -> [Int]
forall (c :: * -> *) l a. BuilderState c l a -> [Int]
bsBreaks BuilderState c l a
st, bsContinues :: [Int]
bsContinues = Int
condNodeId Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: BuilderState c l a -> [Int]
forall (c :: * -> *) l a. BuilderState c l a -> [Int]
bsContinues BuilderState c l a
st }

        Int
lastBodyNodeId <- [Node (Lexeme l)] -> Int -> State (BuilderState c l a) Int
forall (c :: * -> *) l a.
(DataFlow c l a, Pretty l, Ord l, Show l) =>
[Node (Lexeme l)] -> Int -> State (BuilderState c l a) Int
buildStmts (Node (Lexeme l) -> [Node (Lexeme l)]
forall l. Node (Lexeme l) -> [Node (Lexeme l)]
getCompoundStmts Node (Lexeme l)
body) Int
bodyNodeId

        BuilderState c l a
st' <- StateT (BuilderState c l a) Identity (BuilderState c l a)
forall s (m :: * -> *). MonadState s m => m s
get

        let lastBodyNode :: CFGNode l a
lastBodyNode = String -> Map Int (CFGNode l a) -> Int -> CFGNode l a
forall k a. (Ord k, Show k) => String -> Map k a -> k -> a
lookupOrError String
"buildStmt WhileStmt" (BuilderState c l a -> Map Int (CFGNode l a)
forall (c :: * -> *) l a. BuilderState c l a -> CFG l a
bsCfg BuilderState c l a
st') Int
lastBodyNodeId
        let finalCfg :: Map Int (CFGNode l a)
finalCfg = if [Int] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (CFGNode l a -> [Int]
forall l a. CFGNode l a -> [Int]
cfgSuccs CFGNode l a
lastBodyNode) then
                         (CFGNode l a -> CFGNode l a)
-> Int -> Map Int (CFGNode l a) -> Map Int (CFGNode l a)
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
Map.adjust (\CFGNode l a
n -> CFGNode l a
n { cfgSuccs :: [Int]
cfgSuccs = [Int
condNodeId] }) Int
lastBodyNodeId (Map Int (CFGNode l a) -> Map Int (CFGNode l a))
-> Map Int (CFGNode l a) -> Map Int (CFGNode l a)
forall a b. (a -> b) -> a -> b
$
                         (CFGNode l a -> CFGNode l a)
-> Int -> Map Int (CFGNode l a) -> Map Int (CFGNode l a)
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
Map.adjust (\CFGNode l a
n -> CFGNode l a
n { cfgPreds :: [Int]
cfgPreds = CFGNode l a -> [Int]
forall l a. CFGNode l a -> [Int]
cfgPreds CFGNode l a
n [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ [Int
lastBodyNodeId] }) Int
condNodeId (BuilderState c l a -> Map Int (CFGNode l a)
forall (c :: * -> *) l a. BuilderState c l a -> CFG l a
bsCfg BuilderState c l a
st')
                       else
                         BuilderState c l a -> Map Int (CFGNode l a)
forall (c :: * -> *) l a. BuilderState c l a -> CFG l a
bsCfg BuilderState c l a
st'
        BuilderState c l a -> StateT (BuilderState c l a) Identity ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (BuilderState c l a -> StateT (BuilderState c l a) Identity ())
-> BuilderState c l a -> StateT (BuilderState c l a) Identity ()
forall a b. (a -> b) -> a -> b
$ BuilderState c l a
st' { bsCfg :: Map Int (CFGNode l a)
bsCfg = Map Int (CFGNode l a)
finalCfg, bsBreaks :: [Int]
bsBreaks = BuilderState c l a -> [Int]
forall (c :: * -> *) l a. BuilderState c l a -> [Int]
bsBreaks BuilderState c l a
st, bsContinues :: [Int]
bsContinues = BuilderState c l a -> [Int]
forall (c :: * -> *) l a. BuilderState c l a -> [Int]
bsContinues BuilderState c l a
st }
        Int -> State (BuilderState c l a) Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
loopExitNodeId
    C.ForStmt Node (Lexeme l)
init' Node (Lexeme l)
cond Node (Lexeme l)
inc Node (Lexeme l)
body -> do
        Int
initNodeId <- Int -> Node (Lexeme l) -> State (BuilderState c l a) Int
forall (c :: * -> *) l a.
(DataFlow c l a, Pretty l, Ord l, Show l) =>
Int -> Node (Lexeme l) -> State (BuilderState c l a) Int
buildStmt Int
currNodeId Node (Lexeme l)
init'
        BuilderState c l a
st <- StateT (BuilderState c l a) Identity (BuilderState c l a)
forall s (m :: * -> *). MonadState s m => m s
get
        let condNodeId :: Int
condNodeId = BuilderState c l a -> Int
forall (c :: * -> *) l a. BuilderState c l a -> Int
bsNextNodeId BuilderState c l a
st
        let bodyNodeId :: Int
bodyNodeId = Int
condNodeId Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
        let incNodeId :: Int
incNodeId = Int
bodyNodeId Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
        let exitNodeId' :: Int
exitNodeId' = Int
incNodeId Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1

        let condNode :: CFGNode l a
condNode = Int -> [Int] -> [Int] -> [Node (Lexeme l)] -> a -> a -> CFGNode l a
forall l a.
Int -> [Int] -> [Int] -> [Node (Lexeme l)] -> a -> a -> CFGNode l a
CFGNode Int
condNodeId [] [Int
bodyNodeId, Int
exitNodeId'] [Node (Lexeme l)
cond] (c l -> a
forall (c :: * -> *) l a. DataFlow c l a => c l -> a
emptyFacts (BuilderState c l a -> c l
forall (c :: * -> *) l a. BuilderState c l a -> c l
bsCtx BuilderState c l a
st)) (c l -> a
forall (c :: * -> *) l a. DataFlow c l a => c l -> a
emptyFacts (BuilderState c l a -> c l
forall (c :: * -> *) l a. BuilderState c l a -> c l
bsCtx BuilderState c l a
st))
        let bodyNode :: CFGNode l a
bodyNode = Int -> [Int] -> [Int] -> [Node (Lexeme l)] -> a -> a -> CFGNode l a
forall l a.
Int -> [Int] -> [Int] -> [Node (Lexeme l)] -> a -> a -> CFGNode l a
CFGNode Int
bodyNodeId [Int
condNodeId] [Int
incNodeId] [] (c l -> a
forall (c :: * -> *) l a. DataFlow c l a => c l -> a
emptyFacts (BuilderState c l a -> c l
forall (c :: * -> *) l a. BuilderState c l a -> c l
bsCtx BuilderState c l a
st)) (c l -> a
forall (c :: * -> *) l a. DataFlow c l a => c l -> a
emptyFacts (BuilderState c l a -> c l
forall (c :: * -> *) l a. BuilderState c l a -> c l
bsCtx BuilderState c l a
st))
        let incNode :: CFGNode l a
incNode = Int -> [Int] -> [Int] -> [Node (Lexeme l)] -> a -> a -> CFGNode l a
forall l a.
Int -> [Int] -> [Int] -> [Node (Lexeme l)] -> a -> a -> CFGNode l a
CFGNode Int
incNodeId [Int
bodyNodeId] [Int
condNodeId] [Node (Lexeme l)
inc] (c l -> a
forall (c :: * -> *) l a. DataFlow c l a => c l -> a
emptyFacts (BuilderState c l a -> c l
forall (c :: * -> *) l a. BuilderState c l a -> c l
bsCtx BuilderState c l a
st)) (c l -> a
forall (c :: * -> *) l a. DataFlow c l a => c l -> a
emptyFacts (BuilderState c l a -> c l
forall (c :: * -> *) l a. BuilderState c l a -> c l
bsCtx BuilderState c l a
st))
        let exitNode' :: CFGNode l a
exitNode' = Int -> [Int] -> [Int] -> [Node (Lexeme l)] -> a -> a -> CFGNode l a
forall l a.
Int -> [Int] -> [Int] -> [Node (Lexeme l)] -> a -> a -> CFGNode l a
CFGNode Int
exitNodeId' [Int
condNodeId] [] [] (c l -> a
forall (c :: * -> *) l a. DataFlow c l a => c l -> a
emptyFacts (BuilderState c l a -> c l
forall (c :: * -> *) l a. BuilderState c l a -> c l
bsCtx BuilderState c l a
st)) (c l -> a
forall (c :: * -> *) l a. DataFlow c l a => c l -> a
emptyFacts (BuilderState c l a -> c l
forall (c :: * -> *) l a. BuilderState c l a -> c l
bsCtx BuilderState c l a
st))

        let updatedCfg :: Map Int (CFGNode l a)
updatedCfg = Int
-> CFGNode l a -> Map Int (CFGNode l a) -> Map Int (CFGNode l a)
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Int
condNodeId CFGNode l a
condNode (Map Int (CFGNode l a) -> Map Int (CFGNode l a))
-> Map Int (CFGNode l a) -> Map Int (CFGNode l a)
forall a b. (a -> b) -> a -> b
$
                         Int
-> CFGNode l a -> Map Int (CFGNode l a) -> Map Int (CFGNode l a)
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Int
bodyNodeId CFGNode l a
forall l. CFGNode l a
bodyNode (Map Int (CFGNode l a) -> Map Int (CFGNode l a))
-> Map Int (CFGNode l a) -> Map Int (CFGNode l a)
forall a b. (a -> b) -> a -> b
$
                         Int
-> CFGNode l a -> Map Int (CFGNode l a) -> Map Int (CFGNode l a)
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Int
incNodeId CFGNode l a
incNode (Map Int (CFGNode l a) -> Map Int (CFGNode l a))
-> Map Int (CFGNode l a) -> Map Int (CFGNode l a)
forall a b. (a -> b) -> a -> b
$
                         Int
-> CFGNode l a -> Map Int (CFGNode l a) -> Map Int (CFGNode l a)
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Int
exitNodeId' CFGNode l a
forall l. CFGNode l a
exitNode' (BuilderState c l a -> Map Int (CFGNode l a)
forall (c :: * -> *) l a. BuilderState c l a -> CFG l a
bsCfg BuilderState c l a
st)

        let cfgWithSuccs :: Map Int (CFGNode l a)
cfgWithSuccs = (CFGNode l a -> CFGNode l a)
-> Int -> Map Int (CFGNode l a) -> Map Int (CFGNode l a)
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
Map.adjust (\CFGNode l a
n -> CFGNode l a
n { cfgSuccs :: [Int]
cfgSuccs = CFGNode l a -> [Int]
forall l a. CFGNode l a -> [Int]
cfgSuccs CFGNode l a
n [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ [Int
condNodeId] }) Int
initNodeId Map Int (CFGNode l a)
updatedCfg
        let cfgWithPreds :: Map Int (CFGNode l a)
cfgWithPreds = (CFGNode l a -> CFGNode l a)
-> Int -> Map Int (CFGNode l a) -> Map Int (CFGNode l a)
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
Map.adjust (\CFGNode l a
n -> CFGNode l a
n { cfgPreds :: [Int]
cfgPreds = CFGNode l a -> [Int]
forall l a. CFGNode l a -> [Int]
cfgPreds CFGNode l a
n [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ [Int
initNodeId, Int
incNodeId] }) Int
condNodeId Map Int (CFGNode l a)
cfgWithSuccs

        BuilderState c l a -> StateT (BuilderState c l a) Identity ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (BuilderState c l a -> StateT (BuilderState c l a) Identity ())
-> BuilderState c l a -> StateT (BuilderState c l a) Identity ()
forall a b. (a -> b) -> a -> b
$ BuilderState c l a
st { bsCfg :: Map Int (CFGNode l a)
bsCfg = Map Int (CFGNode l a)
cfgWithPreds, bsNextNodeId :: Int
bsNextNodeId = Int
exitNodeId' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1, bsBreaks :: [Int]
bsBreaks = Int
exitNodeId' Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: BuilderState c l a -> [Int]
forall (c :: * -> *) l a. BuilderState c l a -> [Int]
bsBreaks BuilderState c l a
st, bsContinues :: [Int]
bsContinues = Int
incNodeId Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: BuilderState c l a -> [Int]
forall (c :: * -> *) l a. BuilderState c l a -> [Int]
bsContinues BuilderState c l a
st }

        Int
lastBodyNodeId <- [Node (Lexeme l)] -> Int -> State (BuilderState c l a) Int
forall (c :: * -> *) l a.
(DataFlow c l a, Pretty l, Ord l, Show l) =>
[Node (Lexeme l)] -> Int -> State (BuilderState c l a) Int
buildStmts (Node (Lexeme l) -> [Node (Lexeme l)]
forall l. Node (Lexeme l) -> [Node (Lexeme l)]
getCompoundStmts Node (Lexeme l)
body) Int
bodyNodeId

        BuilderState c l a
st' <- StateT (BuilderState c l a) Identity (BuilderState c l a)
forall s (m :: * -> *). MonadState s m => m s
get
        let lastBodyNode :: CFGNode l a
lastBodyNode = String -> Map Int (CFGNode l a) -> Int -> CFGNode l a
forall k a. (Ord k, Show k) => String -> Map k a -> k -> a
lookupOrError String
"buildStmt ForStmt" (BuilderState c l a -> Map Int (CFGNode l a)
forall (c :: * -> *) l a. BuilderState c l a -> CFG l a
bsCfg BuilderState c l a
st') Int
lastBodyNodeId
        let finalCfg :: Map Int (CFGNode l a)
finalCfg = if [Int] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (CFGNode l a -> [Int]
forall l a. CFGNode l a -> [Int]
cfgSuccs CFGNode l a
lastBodyNode) then
                         (CFGNode l a -> CFGNode l a)
-> Int -> Map Int (CFGNode l a) -> Map Int (CFGNode l a)
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
Map.adjust (\CFGNode l a
n -> CFGNode l a
n { cfgSuccs :: [Int]
cfgSuccs = [Int
incNodeId] }) Int
lastBodyNodeId (Map Int (CFGNode l a) -> Map Int (CFGNode l a))
-> Map Int (CFGNode l a) -> Map Int (CFGNode l a)
forall a b. (a -> b) -> a -> b
$
                         (CFGNode l a -> CFGNode l a)
-> Int -> Map Int (CFGNode l a) -> Map Int (CFGNode l a)
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
Map.adjust (\CFGNode l a
n -> CFGNode l a
n { cfgPreds :: [Int]
cfgPreds = CFGNode l a -> [Int]
forall l a. CFGNode l a -> [Int]
cfgPreds CFGNode l a
n [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ [Int
lastBodyNodeId] }) Int
incNodeId (BuilderState c l a -> Map Int (CFGNode l a)
forall (c :: * -> *) l a. BuilderState c l a -> CFG l a
bsCfg BuilderState c l a
st')
                       else
                         BuilderState c l a -> Map Int (CFGNode l a)
forall (c :: * -> *) l a. BuilderState c l a -> CFG l a
bsCfg BuilderState c l a
st'

        BuilderState c l a -> StateT (BuilderState c l a) Identity ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (BuilderState c l a -> StateT (BuilderState c l a) Identity ())
-> BuilderState c l a -> StateT (BuilderState c l a) Identity ()
forall a b. (a -> b) -> a -> b
$ BuilderState c l a
st' { bsCfg :: Map Int (CFGNode l a)
bsCfg = Map Int (CFGNode l a)
finalCfg, bsBreaks :: [Int]
bsBreaks = BuilderState c l a -> [Int]
forall (c :: * -> *) l a. BuilderState c l a -> [Int]
bsBreaks BuilderState c l a
st, bsContinues :: [Int]
bsContinues = BuilderState c l a -> [Int]
forall (c :: * -> *) l a. BuilderState c l a -> [Int]
bsContinues BuilderState c l a
st }
        Int -> State (BuilderState c l a) Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
exitNodeId'
    C.DoWhileStmt Node (Lexeme l)
body Node (Lexeme l)
cond -> do
        BuilderState c l a
st <- StateT (BuilderState c l a) Identity (BuilderState c l a)
forall s (m :: * -> *). MonadState s m => m s
get
        let bodyNodeId :: Int
bodyNodeId = BuilderState c l a -> Int
forall (c :: * -> *) l a. BuilderState c l a -> Int
bsNextNodeId BuilderState c l a
st
        let condNodeId :: Int
condNodeId = Int
bodyNodeId Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
        let exitNodeId' :: Int
exitNodeId' = Int
condNodeId Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1

        let bodyNode :: CFGNode l a
bodyNode = Int -> [Int] -> [Int] -> [Node (Lexeme l)] -> a -> a -> CFGNode l a
forall l a.
Int -> [Int] -> [Int] -> [Node (Lexeme l)] -> a -> a -> CFGNode l a
CFGNode Int
bodyNodeId [] [Int
condNodeId] [] (c l -> a
forall (c :: * -> *) l a. DataFlow c l a => c l -> a
emptyFacts (BuilderState c l a -> c l
forall (c :: * -> *) l a. BuilderState c l a -> c l
bsCtx BuilderState c l a
st)) (c l -> a
forall (c :: * -> *) l a. DataFlow c l a => c l -> a
emptyFacts (BuilderState c l a -> c l
forall (c :: * -> *) l a. BuilderState c l a -> c l
bsCtx BuilderState c l a
st))
        let condNode :: CFGNode l a
condNode = Int -> [Int] -> [Int] -> [Node (Lexeme l)] -> a -> a -> CFGNode l a
forall l a.
Int -> [Int] -> [Int] -> [Node (Lexeme l)] -> a -> a -> CFGNode l a
CFGNode Int
condNodeId [Int
bodyNodeId] [Int
bodyNodeId, Int
exitNodeId'] [Node (Lexeme l)
cond] (c l -> a
forall (c :: * -> *) l a. DataFlow c l a => c l -> a
emptyFacts (BuilderState c l a -> c l
forall (c :: * -> *) l a. BuilderState c l a -> c l
bsCtx BuilderState c l a
st)) (c l -> a
forall (c :: * -> *) l a. DataFlow c l a => c l -> a
emptyFacts (BuilderState c l a -> c l
forall (c :: * -> *) l a. BuilderState c l a -> c l
bsCtx BuilderState c l a
st))
        let exitNode :: CFGNode l a
exitNode = Int -> [Int] -> [Int] -> [Node (Lexeme l)] -> a -> a -> CFGNode l a
forall l a.
Int -> [Int] -> [Int] -> [Node (Lexeme l)] -> a -> a -> CFGNode l a
CFGNode Int
exitNodeId' [Int
condNodeId] [] [] (c l -> a
forall (c :: * -> *) l a. DataFlow c l a => c l -> a
emptyFacts (BuilderState c l a -> c l
forall (c :: * -> *) l a. BuilderState c l a -> c l
bsCtx BuilderState c l a
st)) (c l -> a
forall (c :: * -> *) l a. DataFlow c l a => c l -> a
emptyFacts (BuilderState c l a -> c l
forall (c :: * -> *) l a. BuilderState c l a -> c l
bsCtx BuilderState c l a
st))

        let updatedCfg :: Map Int (CFGNode l a)
updatedCfg = Int
-> CFGNode l a -> Map Int (CFGNode l a) -> Map Int (CFGNode l a)
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Int
bodyNodeId CFGNode l a
forall l. CFGNode l a
bodyNode (Map Int (CFGNode l a) -> Map Int (CFGNode l a))
-> Map Int (CFGNode l a) -> Map Int (CFGNode l a)
forall a b. (a -> b) -> a -> b
$ Int
-> CFGNode l a -> Map Int (CFGNode l a) -> Map Int (CFGNode l a)
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Int
condNodeId CFGNode l a
condNode (Map Int (CFGNode l a) -> Map Int (CFGNode l a))
-> Map Int (CFGNode l a) -> Map Int (CFGNode l a)
forall a b. (a -> b) -> a -> b
$ Int
-> CFGNode l a -> Map Int (CFGNode l a) -> Map Int (CFGNode l a)
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Int
exitNodeId' CFGNode l a
forall l. CFGNode l a
exitNode (BuilderState c l a -> Map Int (CFGNode l a)
forall (c :: * -> *) l a. BuilderState c l a -> CFG l a
bsCfg BuilderState c l a
st)
        let cfgWithSuccs :: Map Int (CFGNode l a)
cfgWithSuccs = (CFGNode l a -> CFGNode l a)
-> Int -> Map Int (CFGNode l a) -> Map Int (CFGNode l a)
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
Map.adjust (\CFGNode l a
n -> CFGNode l a
n { cfgSuccs :: [Int]
cfgSuccs = [Int
bodyNodeId] }) Int
currNodeId Map Int (CFGNode l a)
updatedCfg
        let cfgWithPreds :: Map Int (CFGNode l a)
cfgWithPreds = (CFGNode l a -> CFGNode l a)
-> Int -> Map Int (CFGNode l a) -> Map Int (CFGNode l a)
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
Map.adjust (\CFGNode l a
n -> CFGNode l a
n { cfgPreds :: [Int]
cfgPreds = CFGNode l a -> [Int]
forall l a. CFGNode l a -> [Int]
cfgPreds CFGNode l a
n [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ [Int
currNodeId, Int
condNodeId] }) Int
bodyNodeId Map Int (CFGNode l a)
cfgWithSuccs
        BuilderState c l a -> StateT (BuilderState c l a) Identity ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (BuilderState c l a -> StateT (BuilderState c l a) Identity ())
-> BuilderState c l a -> StateT (BuilderState c l a) Identity ()
forall a b. (a -> b) -> a -> b
$ BuilderState c l a
st { bsCfg :: Map Int (CFGNode l a)
bsCfg = Map Int (CFGNode l a)
cfgWithPreds, bsNextNodeId :: Int
bsNextNodeId = Int
exitNodeId' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1, bsBreaks :: [Int]
bsBreaks = Int
exitNodeId' Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: BuilderState c l a -> [Int]
forall (c :: * -> *) l a. BuilderState c l a -> [Int]
bsBreaks BuilderState c l a
st, bsContinues :: [Int]
bsContinues = Int
condNodeId Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: BuilderState c l a -> [Int]
forall (c :: * -> *) l a. BuilderState c l a -> [Int]
bsContinues BuilderState c l a
st }

        Int
lastBodyNodeId <- [Node (Lexeme l)] -> Int -> State (BuilderState c l a) Int
forall (c :: * -> *) l a.
(DataFlow c l a, Pretty l, Ord l, Show l) =>
[Node (Lexeme l)] -> Int -> State (BuilderState c l a) Int
buildStmts (Node (Lexeme l) -> [Node (Lexeme l)]
forall l. Node (Lexeme l) -> [Node (Lexeme l)]
getCompoundStmts Node (Lexeme l)
body) Int
bodyNodeId

        BuilderState c l a
st' <- StateT (BuilderState c l a) Identity (BuilderState c l a)
forall s (m :: * -> *). MonadState s m => m s
get
        let lastBodyNode :: CFGNode l a
lastBodyNode = String -> Map Int (CFGNode l a) -> Int -> CFGNode l a
forall k a. (Ord k, Show k) => String -> Map k a -> k -> a
lookupOrError String
"buildStmt DoWhileStmt" (BuilderState c l a -> Map Int (CFGNode l a)
forall (c :: * -> *) l a. BuilderState c l a -> CFG l a
bsCfg BuilderState c l a
st') Int
lastBodyNodeId
        let finalCfg :: Map Int (CFGNode l a)
finalCfg = if [Int] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (CFGNode l a -> [Int]
forall l a. CFGNode l a -> [Int]
cfgSuccs CFGNode l a
lastBodyNode) then
                         (CFGNode l a -> CFGNode l a)
-> Int -> Map Int (CFGNode l a) -> Map Int (CFGNode l a)
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
Map.adjust (\CFGNode l a
n -> CFGNode l a
n { cfgSuccs :: [Int]
cfgSuccs = [Int
condNodeId] }) Int
lastBodyNodeId (Map Int (CFGNode l a) -> Map Int (CFGNode l a))
-> Map Int (CFGNode l a) -> Map Int (CFGNode l a)
forall a b. (a -> b) -> a -> b
$
                         (CFGNode l a -> CFGNode l a)
-> Int -> Map Int (CFGNode l a) -> Map Int (CFGNode l a)
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
Map.adjust (\CFGNode l a
n -> CFGNode l a
n { cfgPreds :: [Int]
cfgPreds = CFGNode l a -> [Int]
forall l a. CFGNode l a -> [Int]
cfgPreds CFGNode l a
n [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ [Int
lastBodyNodeId] }) Int
condNodeId (BuilderState c l a -> Map Int (CFGNode l a)
forall (c :: * -> *) l a. BuilderState c l a -> CFG l a
bsCfg BuilderState c l a
st')
                       else
                         BuilderState c l a -> Map Int (CFGNode l a)
forall (c :: * -> *) l a. BuilderState c l a -> CFG l a
bsCfg BuilderState c l a
st'

        BuilderState c l a -> StateT (BuilderState c l a) Identity ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (BuilderState c l a -> StateT (BuilderState c l a) Identity ())
-> BuilderState c l a -> StateT (BuilderState c l a) Identity ()
forall a b. (a -> b) -> a -> b
$ BuilderState c l a
st' { bsCfg :: Map Int (CFGNode l a)
bsCfg = Map Int (CFGNode l a)
finalCfg, bsBreaks :: [Int]
bsBreaks = BuilderState c l a -> [Int]
forall (c :: * -> *) l a. BuilderState c l a -> [Int]
bsBreaks BuilderState c l a
st, bsContinues :: [Int]
bsContinues = BuilderState c l a -> [Int]
forall (c :: * -> *) l a. BuilderState c l a -> [Int]
bsContinues BuilderState c l a
st }
        Int -> State (BuilderState c l a) Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
exitNodeId'
    C.SwitchStmt Node (Lexeme l)
cond [Node (Lexeme l)]
body -> do
        BuilderState c l a
st <- StateT (BuilderState c l a) Identity (BuilderState c l a)
forall s (m :: * -> *). MonadState s m => m s
get
        let switchExitNodeId :: Int
switchExitNodeId = BuilderState c l a -> Int
forall (c :: * -> *) l a. BuilderState c l a -> Int
bsNextNodeId BuilderState c l a
st
        let switchExitNode :: CFGNode l a
switchExitNode = Int -> [Int] -> [Int] -> [Node (Lexeme l)] -> a -> a -> CFGNode l a
forall l a.
Int -> [Int] -> [Int] -> [Node (Lexeme l)] -> a -> a -> CFGNode l a
CFGNode Int
switchExitNodeId [] [] [] (c l -> a
forall (c :: * -> *) l a. DataFlow c l a => c l -> a
emptyFacts (BuilderState c l a -> c l
forall (c :: * -> *) l a. BuilderState c l a -> c l
bsCtx BuilderState c l a
st)) (c l -> a
forall (c :: * -> *) l a. DataFlow c l a => c l -> a
emptyFacts (BuilderState c l a -> c l
forall (c :: * -> *) l a. BuilderState c l a -> c l
bsCtx BuilderState c l a
st))
        let cfg' :: Map Int (CFGNode l a)
cfg' = Int
-> CFGNode l a -> Map Int (CFGNode l a) -> Map Int (CFGNode l a)
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Int
switchExitNodeId CFGNode l a
forall l. CFGNode l a
switchExitNode (BuilderState c l a -> Map Int (CFGNode l a)
forall (c :: * -> *) l a. BuilderState c l a -> CFG l a
bsCfg BuilderState c l a
st)
        BuilderState c l a -> StateT (BuilderState c l a) Identity ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (BuilderState c l a -> StateT (BuilderState c l a) Identity ())
-> BuilderState c l a -> StateT (BuilderState c l a) Identity ()
forall a b. (a -> b) -> a -> b
$ BuilderState c l a
st { bsCfg :: Map Int (CFGNode l a)
bsCfg = Map Int (CFGNode l a)
cfg', bsNextNodeId :: Int
bsNextNodeId = Int
switchExitNodeId Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1, bsBreaks :: [Int]
bsBreaks = Int
switchExitNodeId Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: BuilderState c l a -> [Int]
forall (c :: * -> *) l a. BuilderState c l a -> [Int]
bsBreaks BuilderState c l a
st }

        let flattenCases :: [Fix (NodeF lexeme)]
-> [(Maybe (Fix (NodeF lexeme)), [Fix (NodeF lexeme)])]
flattenCases [Fix (NodeF lexeme)]
stmts = (Fix (NodeF lexeme)
 -> [(Maybe (Fix (NodeF lexeme)), [Fix (NodeF lexeme)])])
-> [Fix (NodeF lexeme)]
-> [(Maybe (Fix (NodeF lexeme)), [Fix (NodeF lexeme)])]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\case
                (Fix (C.Case Fix (NodeF lexeme)
caseCond (Fix (C.CompoundStmt [Fix (NodeF lexeme)]
bodyStmts)))) -> [(Fix (NodeF lexeme) -> Maybe (Fix (NodeF lexeme))
forall a. a -> Maybe a
Just Fix (NodeF lexeme)
caseCond, [Fix (NodeF lexeme)]
bodyStmts)]
                (Fix (C.Case Fix (NodeF lexeme)
_ Fix (NodeF lexeme)
stmt')) -> [Fix (NodeF lexeme)]
-> [(Maybe (Fix (NodeF lexeme)), [Fix (NodeF lexeme)])]
flattenCases [Fix (NodeF lexeme)
stmt']
                (Fix (C.Default (Fix (C.CompoundStmt [Fix (NodeF lexeme)]
bodyStmts)))) -> [(Maybe (Fix (NodeF lexeme))
forall a. Maybe a
Nothing, [Fix (NodeF lexeme)]
bodyStmts)]
                (Fix (C.Default Fix (NodeF lexeme)
stmt')) -> [Fix (NodeF lexeme)]
-> [(Maybe (Fix (NodeF lexeme)), [Fix (NodeF lexeme)])]
flattenCases [Fix (NodeF lexeme)
stmt']
                Fix (NodeF lexeme)
_ -> []) [Fix (NodeF lexeme)]
stmts

        let caseBlocks :: [(Maybe (Node (Lexeme l)), [Node (Lexeme l)])]
caseBlocks = [Node (Lexeme l)] -> [(Maybe (Node (Lexeme l)), [Node (Lexeme l)])]
forall lexeme.
[Fix (NodeF lexeme)]
-> [(Maybe (Fix (NodeF lexeme)), [Fix (NodeF lexeme)])]
flattenCases [Node (Lexeme l)]
body

        ([Int]
caseNodeIds, [[Node (Lexeme l)]]
stmts') <- ([(Int, [Node (Lexeme l)])] -> ([Int], [[Node (Lexeme l)]]))
-> StateT (BuilderState c l a) Identity [(Int, [Node (Lexeme l)])]
-> StateT
     (BuilderState c l a) Identity ([Int], [[Node (Lexeme l)]])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [(Int, [Node (Lexeme l)])] -> ([Int], [[Node (Lexeme l)]])
forall a b. [(a, b)] -> ([a], [b])
unzip (StateT (BuilderState c l a) Identity [(Int, [Node (Lexeme l)])]
 -> StateT
      (BuilderState c l a) Identity ([Int], [[Node (Lexeme l)]]))
-> StateT (BuilderState c l a) Identity [(Int, [Node (Lexeme l)])]
-> StateT
     (BuilderState c l a) Identity ([Int], [[Node (Lexeme l)]])
forall a b. (a -> b) -> a -> b
$ [(Maybe (Node (Lexeme l)), [Node (Lexeme l)])]
-> ((Maybe (Node (Lexeme l)), [Node (Lexeme l)])
    -> StateT (BuilderState c l a) Identity (Int, [Node (Lexeme l)]))
-> StateT (BuilderState c l a) Identity [(Int, [Node (Lexeme l)])]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [(Maybe (Node (Lexeme l)), [Node (Lexeme l)])]
caseBlocks (((Maybe (Node (Lexeme l)), [Node (Lexeme l)])
  -> StateT (BuilderState c l a) Identity (Int, [Node (Lexeme l)]))
 -> StateT (BuilderState c l a) Identity [(Int, [Node (Lexeme l)])])
-> ((Maybe (Node (Lexeme l)), [Node (Lexeme l)])
    -> StateT (BuilderState c l a) Identity (Int, [Node (Lexeme l)]))
-> StateT (BuilderState c l a) Identity [(Int, [Node (Lexeme l)])]
forall a b. (a -> b) -> a -> b
$ \(Maybe (Node (Lexeme l))
_, [Node (Lexeme l)]
stmts) -> do
            BuilderState c l a
st_b <- StateT (BuilderState c l a) Identity (BuilderState c l a)
forall s (m :: * -> *). MonadState s m => m s
get
            let caseId :: Int
caseId = BuilderState c l a -> Int
forall (c :: * -> *) l a. BuilderState c l a -> Int
bsNextNodeId BuilderState c l a
st_b
            let node :: CFGNode l a
node = Int -> [Int] -> [Int] -> [Node (Lexeme l)] -> a -> a -> CFGNode l a
forall l a.
Int -> [Int] -> [Int] -> [Node (Lexeme l)] -> a -> a -> CFGNode l a
CFGNode Int
caseId [] [] [] (c l -> a
forall (c :: * -> *) l a. DataFlow c l a => c l -> a
emptyFacts (BuilderState c l a -> c l
forall (c :: * -> *) l a. BuilderState c l a -> c l
bsCtx BuilderState c l a
st_b)) (c l -> a
forall (c :: * -> *) l a. DataFlow c l a => c l -> a
emptyFacts (BuilderState c l a -> c l
forall (c :: * -> *) l a. BuilderState c l a -> c l
bsCtx BuilderState c l a
st_b))
            BuilderState c l a -> StateT (BuilderState c l a) Identity ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (BuilderState c l a -> StateT (BuilderState c l a) Identity ())
-> BuilderState c l a -> StateT (BuilderState c l a) Identity ()
forall a b. (a -> b) -> a -> b
$ BuilderState c l a
st_b { bsCfg :: Map Int (CFGNode l a)
bsCfg = Int
-> CFGNode l a -> Map Int (CFGNode l a) -> Map Int (CFGNode l a)
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Int
caseId CFGNode l a
forall l. CFGNode l a
node (BuilderState c l a -> Map Int (CFGNode l a)
forall (c :: * -> *) l a. BuilderState c l a -> CFG l a
bsCfg BuilderState c l a
st_b), bsNextNodeId :: Int
bsNextNodeId = BuilderState c l a -> Int
forall (c :: * -> *) l a. BuilderState c l a -> Int
bsNextNodeId BuilderState c l a
st_b Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 }
            (Int, [Node (Lexeme l)])
-> StateT (BuilderState c l a) Identity (Int, [Node (Lexeme l)])
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
caseId, [Node (Lexeme l)]
stmts)

        -- The switch node is a predecessor to all cases.
        BuilderState c l a
st_c <- StateT (BuilderState c l a) Identity (BuilderState c l a)
forall s (m :: * -> *). MonadState s m => m s
get
        let cfg_c' :: Map Int (CFGNode l a)
cfg_c' = (CFGNode l a -> CFGNode l a)
-> Int -> Map Int (CFGNode l a) -> Map Int (CFGNode l a)
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
Map.adjust (\CFGNode l a
n -> CFGNode l a
n { cfgSuccs :: [Int]
cfgSuccs = CFGNode l a -> [Int]
forall l a. CFGNode l a -> [Int]
cfgSuccs CFGNode l a
n [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ [Int]
caseNodeIds, cfgStmts :: [Node (Lexeme l)]
cfgStmts = CFGNode l a -> [Node (Lexeme l)]
forall l a. CFGNode l a -> [Node (Lexeme l)]
cfgStmts CFGNode l a
n [Node (Lexeme l)] -> [Node (Lexeme l)] -> [Node (Lexeme l)]
forall a. [a] -> [a] -> [a]
++ [Node (Lexeme l)
cond] }) Int
currNodeId (BuilderState c l a -> Map Int (CFGNode l a)
forall (c :: * -> *) l a. BuilderState c l a -> CFG l a
bsCfg BuilderState c l a
st_c)
        let cfg_c'' :: Map Int (CFGNode l a)
cfg_c'' = (Map Int (CFGNode l a) -> Int -> Map Int (CFGNode l a))
-> Map Int (CFGNode l a) -> [Int] -> Map Int (CFGNode l a)
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\Map Int (CFGNode l a)
c Int
i -> (CFGNode l a -> CFGNode l a)
-> Int -> Map Int (CFGNode l a) -> Map Int (CFGNode l a)
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
Map.adjust (\CFGNode l a
n -> CFGNode l a
n { cfgPreds :: [Int]
cfgPreds = CFGNode l a -> [Int]
forall l a. CFGNode l a -> [Int]
cfgPreds CFGNode l a
n [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ [Int
currNodeId] }) Int
i Map Int (CFGNode l a)
c) Map Int (CFGNode l a)
cfg_c' [Int]
caseNodeIds
        BuilderState c l a -> StateT (BuilderState c l a) Identity ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (BuilderState c l a -> StateT (BuilderState c l a) Identity ())
-> BuilderState c l a -> StateT (BuilderState c l a) Identity ()
forall a b. (a -> b) -> a -> b
$ BuilderState c l a
st_c { bsCfg :: Map Int (CFGNode l a)
bsCfg = Map Int (CFGNode l a)
cfg_c'' }

        -- Process each case.
        let cases :: [(Int, [Node (Lexeme l)])]
cases = [Int] -> [[Node (Lexeme l)]] -> [(Int, [Node (Lexeme l)])]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int]
caseNodeIds [[Node (Lexeme l)]]
stmts'
        let casesWithFallthrough :: [((Int, [Node (Lexeme l)]), Maybe Int)]
casesWithFallthrough = [(Int, [Node (Lexeme l)])]
-> [Maybe Int] -> [((Int, [Node (Lexeme l)]), Maybe Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip [(Int, [Node (Lexeme l)])]
cases ([Maybe Int] -> [Maybe Int]
forall a. [a] -> [a]
tail (((Int, [Node (Lexeme l)]) -> Maybe Int)
-> [(Int, [Node (Lexeme l)])] -> [Maybe Int]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> Maybe Int)
-> ((Int, [Node (Lexeme l)]) -> Int)
-> (Int, [Node (Lexeme l)])
-> Maybe Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, [Node (Lexeme l)]) -> Int
forall a b. (a, b) -> a
fst) [(Int, [Node (Lexeme l)])]
cases) [Maybe Int] -> [Maybe Int] -> [Maybe Int]
forall a. [a] -> [a] -> [a]
++ [Maybe Int
forall a. Maybe a
Nothing])
        [Int]
unbrokenEndNodes <- ([[Int]] -> [Int])
-> StateT (BuilderState c l a) Identity [[Int]]
-> StateT (BuilderState c l a) Identity [Int]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [[Int]] -> [Int]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (StateT (BuilderState c l a) Identity [[Int]]
 -> StateT (BuilderState c l a) Identity [Int])
-> StateT (BuilderState c l a) Identity [[Int]]
-> StateT (BuilderState c l a) Identity [Int]
forall a b. (a -> b) -> a -> b
$ [((Int, [Node (Lexeme l)]), Maybe Int)]
-> (((Int, [Node (Lexeme l)]), Maybe Int)
    -> StateT (BuilderState c l a) Identity [Int])
-> StateT (BuilderState c l a) Identity [[Int]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [((Int, [Node (Lexeme l)]), Maybe Int)]
casesWithFallthrough ((((Int, [Node (Lexeme l)]), Maybe Int)
  -> StateT (BuilderState c l a) Identity [Int])
 -> StateT (BuilderState c l a) Identity [[Int]])
-> (((Int, [Node (Lexeme l)]), Maybe Int)
    -> StateT (BuilderState c l a) Identity [Int])
-> StateT (BuilderState c l a) Identity [[Int]]
forall a b. (a -> b) -> a -> b
$ \((Int
caseNodeId, [Node (Lexeme l)]
caseStmts), Maybe Int
mNextCaseId) -> do
            Int
endNodeId <- [Node (Lexeme l)] -> Int -> State (BuilderState c l a) Int
forall (c :: * -> *) l a.
(DataFlow c l a, Pretty l, Ord l, Show l) =>
[Node (Lexeme l)] -> Int -> State (BuilderState c l a) Int
buildStmts [Node (Lexeme l)]
caseStmts Int
caseNodeId
            BuilderState c l a
st_after <- StateT (BuilderState c l a) Identity (BuilderState c l a)
forall s (m :: * -> *). MonadState s m => m s
get
            let endNode :: CFGNode l a
endNode = String -> Map Int (CFGNode l a) -> Int -> CFGNode l a
forall k a. (Ord k, Show k) => String -> Map k a -> k -> a
lookupOrError String
"buildStmt SwitchStmt" (BuilderState c l a -> Map Int (CFGNode l a)
forall (c :: * -> *) l a. BuilderState c l a -> CFG l a
bsCfg BuilderState c l a
st_after) Int
endNodeId

            if [Int] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (CFGNode l a -> [Int]
forall l a. CFGNode l a -> [Int]
cfgSuccs CFGNode l a
endNode) then
                case Maybe Int
mNextCaseId of
                    Just Int
nextId -> do
                        BuilderState c l a
st_f <- StateT (BuilderState c l a) Identity (BuilderState c l a)
forall s (m :: * -> *). MonadState s m => m s
get
                        let cfg_f' :: Map Int (CFGNode l a)
cfg_f' = (CFGNode l a -> CFGNode l a)
-> Int -> Map Int (CFGNode l a) -> Map Int (CFGNode l a)
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
Map.adjust (\CFGNode l a
n -> CFGNode l a
n { cfgSuccs :: [Int]
cfgSuccs = [Int
nextId] }) Int
endNodeId (BuilderState c l a -> Map Int (CFGNode l a)
forall (c :: * -> *) l a. BuilderState c l a -> CFG l a
bsCfg BuilderState c l a
st_f)
                        let cfg_f'' :: Map Int (CFGNode l a)
cfg_f'' = (CFGNode l a -> CFGNode l a)
-> Int -> Map Int (CFGNode l a) -> Map Int (CFGNode l a)
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
Map.adjust (\CFGNode l a
n -> CFGNode l a
n { cfgPreds :: [Int]
cfgPreds = CFGNode l a -> [Int]
forall l a. CFGNode l a -> [Int]
cfgPreds CFGNode l a
n [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ [Int
endNodeId] }) Int
nextId Map Int (CFGNode l a)
cfg_f'
                        BuilderState c l a -> StateT (BuilderState c l a) Identity ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (BuilderState c l a -> StateT (BuilderState c l a) Identity ())
-> BuilderState c l a -> StateT (BuilderState c l a) Identity ()
forall a b. (a -> b) -> a -> b
$ BuilderState c l a
st_f { bsCfg :: Map Int (CFGNode l a)
bsCfg = Map Int (CFGNode l a)
cfg_f'' }
                        [Int] -> StateT (BuilderState c l a) Identity [Int]
forall (m :: * -> *) a. Monad m => a -> m a
return []
                    Maybe Int
Nothing -> [Int] -> StateT (BuilderState c l a) Identity [Int]
forall (m :: * -> *) a. Monad m => a -> m a
return [Int
endNodeId]
            else [Int] -> StateT (BuilderState c l a) Identity [Int]
forall (m :: * -> *) a. Monad m => a -> m a
return []

        -- Connect unbroken ends to the exit node.
        BuilderState c l a
st_d <- StateT (BuilderState c l a) Identity (BuilderState c l a)
forall s (m :: * -> *). MonadState s m => m s
get
        let cfg_d' :: Map Int (CFGNode l a)
cfg_d' = (Map Int (CFGNode l a) -> Int -> Map Int (CFGNode l a))
-> Map Int (CFGNode l a) -> [Int] -> Map Int (CFGNode l a)
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\Map Int (CFGNode l a)
c Int
p -> (CFGNode l a -> CFGNode l a)
-> Int -> Map Int (CFGNode l a) -> Map Int (CFGNode l a)
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
Map.adjust (\CFGNode l a
n -> CFGNode l a
n { cfgSuccs :: [Int]
cfgSuccs = CFGNode l a -> [Int]
forall l a. CFGNode l a -> [Int]
cfgSuccs CFGNode l a
n [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ [Int
switchExitNodeId] }) Int
p Map Int (CFGNode l a)
c) (BuilderState c l a -> Map Int (CFGNode l a)
forall (c :: * -> *) l a. BuilderState c l a -> CFG l a
bsCfg BuilderState c l a
st_d) [Int]
unbrokenEndNodes
        let cfg_d'' :: Map Int (CFGNode l a)
cfg_d'' = (CFGNode l a -> CFGNode l a)
-> Int -> Map Int (CFGNode l a) -> Map Int (CFGNode l a)
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
Map.adjust (\CFGNode l a
n -> CFGNode l a
n { cfgPreds :: [Int]
cfgPreds = CFGNode l a -> [Int]
forall l a. CFGNode l a -> [Int]
cfgPreds CFGNode l a
n [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ [Int]
unbrokenEndNodes }) Int
switchExitNodeId Map Int (CFGNode l a)
cfg_d'

        -- Also connect switch to exit for default case not being present
        let hasDefault :: Bool
hasDefault = ((Maybe (Node (Lexeme l)), [Node (Lexeme l)]) -> Bool)
-> [(Maybe (Node (Lexeme l)), [Node (Lexeme l)])] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\case (Maybe (Node (Lexeme l))
Nothing, [Node (Lexeme l)]
_) -> Bool
True; (Maybe (Node (Lexeme l)), [Node (Lexeme l)])
_ -> Bool
False) [(Maybe (Node (Lexeme l)), [Node (Lexeme l)])]
caseBlocks
        let cfg_d''' :: Map Int (CFGNode l a)
cfg_d''' = if Bool
hasDefault
                       then Map Int (CFGNode l a)
cfg_d''
                       else (CFGNode l a -> CFGNode l a)
-> Int -> Map Int (CFGNode l a) -> Map Int (CFGNode l a)
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
Map.adjust (\CFGNode l a
n -> CFGNode l a
n { cfgSuccs :: [Int]
cfgSuccs = CFGNode l a -> [Int]
forall l a. CFGNode l a -> [Int]
cfgSuccs CFGNode l a
n [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ [Int
switchExitNodeId] }) Int
currNodeId Map Int (CFGNode l a)
cfg_d''
        let cfg_d'''' :: Map Int (CFGNode l a)
cfg_d'''' = if Bool
hasDefault
                        then Map Int (CFGNode l a)
cfg_d'''
                        else (CFGNode l a -> CFGNode l a)
-> Int -> Map Int (CFGNode l a) -> Map Int (CFGNode l a)
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
Map.adjust (\CFGNode l a
n -> CFGNode l a
n { cfgPreds :: [Int]
cfgPreds = CFGNode l a -> [Int]
forall l a. CFGNode l a -> [Int]
cfgPreds CFGNode l a
n [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ [Int
currNodeId] }) Int
switchExitNodeId Map Int (CFGNode l a)
cfg_d'''

        BuilderState c l a -> StateT (BuilderState c l a) Identity ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (BuilderState c l a -> StateT (BuilderState c l a) Identity ())
-> BuilderState c l a -> StateT (BuilderState c l a) Identity ()
forall a b. (a -> b) -> a -> b
$ BuilderState c l a
st_d { bsCfg :: Map Int (CFGNode l a)
bsCfg = Map Int (CFGNode l a)
cfg_d'''', bsBreaks :: [Int]
bsBreaks = BuilderState c l a -> [Int]
forall (c :: * -> *) l a. BuilderState c l a -> [Int]
bsBreaks BuilderState c l a
st, bsContinues :: [Int]
bsContinues = BuilderState c l a -> [Int]
forall (c :: * -> *) l a. BuilderState c l a -> [Int]
bsContinues BuilderState c l a
st }
        Int -> State (BuilderState c l a) Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
switchExitNodeId
    C.Return Maybe (Node (Lexeme l))
_ -> do
        BuilderState c l a
st <- StateT (BuilderState c l a) Identity (BuilderState c l a)
forall s (m :: * -> *). MonadState s m => m s
get
        let cfgWithStmt :: Map Int (CFGNode l a)
cfgWithStmt = (CFGNode l a -> CFGNode l a)
-> Int -> Map Int (CFGNode l a) -> Map Int (CFGNode l a)
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
Map.adjust (\CFGNode l a
n -> CFGNode l a
n { cfgStmts :: [Node (Lexeme l)]
cfgStmts = CFGNode l a -> [Node (Lexeme l)]
forall l a. CFGNode l a -> [Node (Lexeme l)]
cfgStmts CFGNode l a
n [Node (Lexeme l)] -> [Node (Lexeme l)] -> [Node (Lexeme l)]
forall a. [a] -> [a] -> [a]
++ [Node (Lexeme l)
stmt] }) Int
currNodeId (BuilderState c l a -> Map Int (CFGNode l a)
forall (c :: * -> *) l a. BuilderState c l a -> CFG l a
bsCfg BuilderState c l a
st)
        let updatedCfg :: Map Int (CFGNode l a)
updatedCfg = (CFGNode l a -> CFGNode l a)
-> Int -> Map Int (CFGNode l a) -> Map Int (CFGNode l a)
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
Map.adjust (\CFGNode l a
n -> CFGNode l a
n { cfgSuccs :: [Int]
cfgSuccs = [BuilderState c l a -> Int
forall (c :: * -> *) l a. BuilderState c l a -> Int
bsExitNodeId BuilderState c l a
st] }) Int
currNodeId Map Int (CFGNode l a)
cfgWithStmt
        let cfgWithPred :: Map Int (CFGNode l a)
cfgWithPred = (CFGNode l a -> CFGNode l a)
-> Int -> Map Int (CFGNode l a) -> Map Int (CFGNode l a)
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
Map.adjust (\CFGNode l a
n -> CFGNode l a
n { cfgPreds :: [Int]
cfgPreds = CFGNode l a -> [Int]
forall l a. CFGNode l a -> [Int]
cfgPreds CFGNode l a
n [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ [Int
currNodeId] }) (BuilderState c l a -> Int
forall (c :: * -> *) l a. BuilderState c l a -> Int
bsExitNodeId BuilderState c l a
st) Map Int (CFGNode l a)
updatedCfg
        BuilderState c l a -> StateT (BuilderState c l a) Identity ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (BuilderState c l a -> StateT (BuilderState c l a) Identity ())
-> BuilderState c l a -> StateT (BuilderState c l a) Identity ()
forall a b. (a -> b) -> a -> b
$ BuilderState c l a
st { bsCfg :: Map Int (CFGNode l a)
bsCfg = Map Int (CFGNode l a)
cfgWithPred }
        State (BuilderState c l a) Int
forall (c :: * -> *) l a.
DataFlow c l a =>
State (BuilderState c l a) Int
newDisconnectedNode
    NodeF (Lexeme l) (Node (Lexeme l))
C.Break -> do
        BuilderState c l a
st <- StateT (BuilderState c l a) Identity (BuilderState c l a)
forall s (m :: * -> *). MonadState s m => m s
get
        let target :: Int
target = [Int] -> Int
forall a. [a] -> a
head (BuilderState c l a -> [Int]
forall (c :: * -> *) l a. BuilderState c l a -> [Int]
bsBreaks BuilderState c l a
st)
        let cfgWithStmt :: Map Int (CFGNode l a)
cfgWithStmt = (CFGNode l a -> CFGNode l a)
-> Int -> Map Int (CFGNode l a) -> Map Int (CFGNode l a)
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
Map.adjust (\CFGNode l a
n -> CFGNode l a
n { cfgStmts :: [Node (Lexeme l)]
cfgStmts = CFGNode l a -> [Node (Lexeme l)]
forall l a. CFGNode l a -> [Node (Lexeme l)]
cfgStmts CFGNode l a
n [Node (Lexeme l)] -> [Node (Lexeme l)] -> [Node (Lexeme l)]
forall a. [a] -> [a] -> [a]
++ [Node (Lexeme l)
stmt] }) Int
currNodeId (BuilderState c l a -> Map Int (CFGNode l a)
forall (c :: * -> *) l a. BuilderState c l a -> CFG l a
bsCfg BuilderState c l a
st)
        let updatedCfg :: Map Int (CFGNode l a)
updatedCfg = (CFGNode l a -> CFGNode l a)
-> Int -> Map Int (CFGNode l a) -> Map Int (CFGNode l a)
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
Map.adjust (\CFGNode l a
n -> CFGNode l a
n { cfgSuccs :: [Int]
cfgSuccs = [Int
target] }) Int
currNodeId Map Int (CFGNode l a)
cfgWithStmt
        let cfgWithPred :: Map Int (CFGNode l a)
cfgWithPred = (CFGNode l a -> CFGNode l a)
-> Int -> Map Int (CFGNode l a) -> Map Int (CFGNode l a)
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
Map.adjust (\CFGNode l a
n -> CFGNode l a
n { cfgPreds :: [Int]
cfgPreds = CFGNode l a -> [Int]
forall l a. CFGNode l a -> [Int]
cfgPreds CFGNode l a
n [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ [Int
currNodeId] }) Int
target Map Int (CFGNode l a)
updatedCfg
        BuilderState c l a -> StateT (BuilderState c l a) Identity ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (BuilderState c l a -> StateT (BuilderState c l a) Identity ())
-> BuilderState c l a -> StateT (BuilderState c l a) Identity ()
forall a b. (a -> b) -> a -> b
$ BuilderState c l a
st { bsCfg :: Map Int (CFGNode l a)
bsCfg = Map Int (CFGNode l a)
cfgWithPred }
        State (BuilderState c l a) Int
forall (c :: * -> *) l a.
DataFlow c l a =>
State (BuilderState c l a) Int
newDisconnectedNode
    NodeF (Lexeme l) (Node (Lexeme l))
C.Continue -> do
        BuilderState c l a
st <- StateT (BuilderState c l a) Identity (BuilderState c l a)
forall s (m :: * -> *). MonadState s m => m s
get
        let target :: Int
target = [Int] -> Int
forall a. [a] -> a
head (BuilderState c l a -> [Int]
forall (c :: * -> *) l a. BuilderState c l a -> [Int]
bsContinues BuilderState c l a
st)
        let cfgWithStmt :: Map Int (CFGNode l a)
cfgWithStmt = (CFGNode l a -> CFGNode l a)
-> Int -> Map Int (CFGNode l a) -> Map Int (CFGNode l a)
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
Map.adjust (\CFGNode l a
n -> CFGNode l a
n { cfgStmts :: [Node (Lexeme l)]
cfgStmts = CFGNode l a -> [Node (Lexeme l)]
forall l a. CFGNode l a -> [Node (Lexeme l)]
cfgStmts CFGNode l a
n [Node (Lexeme l)] -> [Node (Lexeme l)] -> [Node (Lexeme l)]
forall a. [a] -> [a] -> [a]
++ [Node (Lexeme l)
stmt] }) Int
currNodeId (BuilderState c l a -> Map Int (CFGNode l a)
forall (c :: * -> *) l a. BuilderState c l a -> CFG l a
bsCfg BuilderState c l a
st)
        let updatedCfg :: Map Int (CFGNode l a)
updatedCfg = (CFGNode l a -> CFGNode l a)
-> Int -> Map Int (CFGNode l a) -> Map Int (CFGNode l a)
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
Map.adjust (\CFGNode l a
n -> CFGNode l a
n { cfgSuccs :: [Int]
cfgSuccs = [Int
target] }) Int
currNodeId Map Int (CFGNode l a)
cfgWithStmt
        let cfgWithPred :: Map Int (CFGNode l a)
cfgWithPred = (CFGNode l a -> CFGNode l a)
-> Int -> Map Int (CFGNode l a) -> Map Int (CFGNode l a)
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
Map.adjust (\CFGNode l a
n -> CFGNode l a
n { cfgPreds :: [Int]
cfgPreds = CFGNode l a -> [Int]
forall l a. CFGNode l a -> [Int]
cfgPreds CFGNode l a
n [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ [Int
currNodeId] }) Int
target Map Int (CFGNode l a)
updatedCfg
        BuilderState c l a -> StateT (BuilderState c l a) Identity ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (BuilderState c l a -> StateT (BuilderState c l a) Identity ())
-> BuilderState c l a -> StateT (BuilderState c l a) Identity ()
forall a b. (a -> b) -> a -> b
$ BuilderState c l a
st { bsCfg :: Map Int (CFGNode l a)
bsCfg = Map Int (CFGNode l a)
cfgWithPred }
        State (BuilderState c l a) Int
forall (c :: * -> *) l a.
DataFlow c l a =>
State (BuilderState c l a) Int
newDisconnectedNode
    C.PreprocDefineMacro {} -> do
        BuilderState c l a
st <- StateT (BuilderState c l a) Identity (BuilderState c l a)
forall s (m :: * -> *). MonadState s m => m s
get
        let updatedCfg :: Map Int (CFGNode l a)
updatedCfg = (CFGNode l a -> CFGNode l a)
-> Int -> Map Int (CFGNode l a) -> Map Int (CFGNode l a)
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
Map.adjust (\CFGNode l a
n -> CFGNode l a
n { cfgStmts :: [Node (Lexeme l)]
cfgStmts = CFGNode l a -> [Node (Lexeme l)]
forall l a. CFGNode l a -> [Node (Lexeme l)]
cfgStmts CFGNode l a
n [Node (Lexeme l)] -> [Node (Lexeme l)] -> [Node (Lexeme l)]
forall a. [a] -> [a] -> [a]
++ [Node (Lexeme l)
stmt] }) Int
currNodeId (BuilderState c l a -> Map Int (CFGNode l a)
forall (c :: * -> *) l a. BuilderState c l a -> CFG l a
bsCfg BuilderState c l a
st)
        BuilderState c l a -> StateT (BuilderState c l a) Identity ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (BuilderState c l a -> StateT (BuilderState c l a) Identity ())
-> BuilderState c l a -> StateT (BuilderState c l a) Identity ()
forall a b. (a -> b) -> a -> b
$ BuilderState c l a
st { bsCfg :: Map Int (CFGNode l a)
bsCfg = Map Int (CFGNode l a)
updatedCfg }
        Int -> State (BuilderState c l a) Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
currNodeId
    C.PreprocUndef {} -> do
        BuilderState c l a
st <- StateT (BuilderState c l a) Identity (BuilderState c l a)
forall s (m :: * -> *). MonadState s m => m s
get
        let updatedCfg :: Map Int (CFGNode l a)
updatedCfg = (CFGNode l a -> CFGNode l a)
-> Int -> Map Int (CFGNode l a) -> Map Int (CFGNode l a)
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
Map.adjust (\CFGNode l a
n -> CFGNode l a
n { cfgStmts :: [Node (Lexeme l)]
cfgStmts = CFGNode l a -> [Node (Lexeme l)]
forall l a. CFGNode l a -> [Node (Lexeme l)]
cfgStmts CFGNode l a
n [Node (Lexeme l)] -> [Node (Lexeme l)] -> [Node (Lexeme l)]
forall a. [a] -> [a] -> [a]
++ [Node (Lexeme l)
stmt] }) Int
currNodeId (BuilderState c l a -> Map Int (CFGNode l a)
forall (c :: * -> *) l a. BuilderState c l a -> CFG l a
bsCfg BuilderState c l a
st)
        BuilderState c l a -> StateT (BuilderState c l a) Identity ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (BuilderState c l a -> StateT (BuilderState c l a) Identity ())
-> BuilderState c l a -> StateT (BuilderState c l a) Identity ()
forall a b. (a -> b) -> a -> b
$ BuilderState c l a
st { bsCfg :: Map Int (CFGNode l a)
bsCfg = Map Int (CFGNode l a)
updatedCfg }
        Int -> State (BuilderState c l a) Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
currNodeId
    C.PreprocScopedDefine Node (Lexeme l)
def [Node (Lexeme l)]
stmts' Node (Lexeme l)
undef -> do
        Int
currNodeId' <- Int -> Node (Lexeme l) -> State (BuilderState c l a) Int
forall (c :: * -> *) l a.
(DataFlow c l a, Pretty l, Ord l, Show l) =>
Int -> Node (Lexeme l) -> State (BuilderState c l a) Int
buildStmt Int
currNodeId Node (Lexeme l)
def
        Int
currNodeId'' <- [Node (Lexeme l)] -> Int -> State (BuilderState c l a) Int
forall (c :: * -> *) l a.
(DataFlow c l a, Pretty l, Ord l, Show l) =>
[Node (Lexeme l)] -> Int -> State (BuilderState c l a) Int
buildStmts [Node (Lexeme l)]
stmts' Int
currNodeId'
        Int -> Node (Lexeme l) -> State (BuilderState c l a) Int
forall (c :: * -> *) l a.
(DataFlow c l a, Pretty l, Ord l, Show l) =>
Int -> Node (Lexeme l) -> State (BuilderState c l a) Int
buildStmt Int
currNodeId'' Node (Lexeme l)
undef
    NodeF (Lexeme l) (Node (Lexeme l))
_ -> do
        BuilderState c l a
st <- StateT (BuilderState c l a) Identity (BuilderState c l a)
forall s (m :: * -> *). MonadState s m => m s
get
        let updatedCfg :: Map Int (CFGNode l a)
updatedCfg = (CFGNode l a -> CFGNode l a)
-> Int -> Map Int (CFGNode l a) -> Map Int (CFGNode l a)
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
Map.adjust (\CFGNode l a
n -> CFGNode l a
n { cfgStmts :: [Node (Lexeme l)]
cfgStmts = CFGNode l a -> [Node (Lexeme l)]
forall l a. CFGNode l a -> [Node (Lexeme l)]
cfgStmts CFGNode l a
n [Node (Lexeme l)] -> [Node (Lexeme l)] -> [Node (Lexeme l)]
forall a. [a] -> [a] -> [a]
++ [Node (Lexeme l)
stmt] }) Int
currNodeId (BuilderState c l a -> Map Int (CFGNode l a)
forall (c :: * -> *) l a. BuilderState c l a -> CFG l a
bsCfg BuilderState c l a
st)
        BuilderState c l a -> StateT (BuilderState c l a) Identity ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (BuilderState c l a -> StateT (BuilderState c l a) Identity ())
-> BuilderState c l a -> StateT (BuilderState c l a) Identity ()
forall a b. (a -> b) -> a -> b
$ BuilderState c l a
st { bsCfg :: Map Int (CFGNode l a)
bsCfg = Map Int (CFGNode l a)
updatedCfg }
        Int -> State (BuilderState c l a) Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
currNodeId