module IR.CF ( rToInt, fToInt
             , mkControlFlow
             ) where

import           CF
-- seems to pretty clearly be faster
import           Control.Monad.State.Strict (State, gets, modify, runState, state)
import           Data.Bifunctor             (second)
import           Data.Functor               (($>))
import qualified Data.IntSet                as IS
import qualified Data.Map                   as M
import           Data.Tuple.Extra           (fst3, second3, snd3, thd3, third3)
import           IR

type N=Int

-- map of labels by node
type FreshM = State (Int, M.Map Label N, M.Map Label [N])

runFreshM :: FreshM a -> (a, Int)
runFreshM :: forall a. FreshM a -> (a, Int)
runFreshM = ((Int, Map Label Int, Map Label [Int]) -> Int)
-> (a, (Int, Map Label Int, Map Label [Int])) -> (a, Int)
forall b c a. (b -> c) -> (a, b) -> (a, c)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second (Int, Map Label Int, Map Label [Int]) -> Int
forall a b c. (a, b, c) -> a
fst3((a, (Int, Map Label Int, Map Label [Int])) -> (a, Int))
-> (FreshM a -> (a, (Int, Map Label Int, Map Label [Int])))
-> FreshM a
-> (a, Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(FreshM a
 -> (Int, Map Label Int, Map Label [Int])
 -> (a, (Int, Map Label Int, Map Label [Int])))
-> (Int, Map Label Int, Map Label [Int])
-> FreshM a
-> (a, (Int, Map Label Int, Map Label [Int]))
forall a b c. (a -> b -> c) -> b -> a -> c
flip FreshM a
-> (Int, Map Label Int, Map Label [Int])
-> (a, (Int, Map Label Int, Map Label [Int]))
forall s a. State s a -> s -> (a, s)
runState (Int
0, Map Label Int
forall a. Monoid a => a
mempty, Map Label [Int]
forall a. Monoid a => a
mempty)

mkControlFlow :: [Stmt] -> ([(Stmt, ControlAnn)], Int)
mkControlFlow :: [Stmt] -> ([(Stmt, ControlAnn)], Int)
mkControlFlow [Stmt]
instrs = FreshM [(Stmt, ControlAnn)] -> ([(Stmt, ControlAnn)], Int)
forall a. FreshM a -> (a, Int)
runFreshM ([Stmt] -> FreshM ()
brs [Stmt]
instrs FreshM ()
-> FreshM [(Stmt, ControlAnn)] -> FreshM [(Stmt, ControlAnn)]
forall a b.
StateT (Int, Map Label Int, Map Label [Int]) Identity a
-> StateT (Int, Map Label Int, Map Label [Int]) Identity b
-> StateT (Int, Map Label Int, Map Label [Int]) Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> [Stmt] -> FreshM [(Stmt, ControlAnn)]
addCF [Stmt]
instrs)

getFresh :: FreshM N
getFresh :: FreshM Int
getFresh = ((Int, Map Label Int, Map Label [Int])
 -> (Int, (Int, Map Label Int, Map Label [Int])))
-> FreshM Int
forall a.
((Int, Map Label Int, Map Label [Int])
 -> (a, (Int, Map Label Int, Map Label [Int])))
-> StateT (Int, Map Label Int, Map Label [Int]) Identity a
forall s (m :: * -> *) a. MonadState s m => (s -> (a, s)) -> m a
state (\(Int
i,Map Label Int
m0,Map Label [Int]
m1) -> (Int
i,(Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1,Map Label Int
m0,Map Label [Int]
m1)))

fm :: Label -> FreshM N
fm :: Label -> FreshM Int
fm Label
l = do {i <- FreshM Int
getFresh; br i l $> i}

ll :: Label -> FreshM N
ll :: Label -> FreshM Int
ll Label
l = ((Int, Map Label Int, Map Label [Int]) -> Int) -> FreshM Int
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (Int -> Label -> Map Label Int -> Int
forall k a. Ord k => a -> k -> Map k a -> a
M.findWithDefault ([Char] -> Int
forall a. HasCallStack => [Char] -> a
error [Char]
"Internal error in control-flow graph: node label not in map.") Label
l (Map Label Int -> Int)
-> ((Int, Map Label Int, Map Label [Int]) -> Map Label Int)
-> (Int, Map Label Int, Map Label [Int])
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, Map Label Int, Map Label [Int]) -> Map Label Int
forall a b c. (a, b, c) -> b
snd3)

lC :: Label -> FreshM [N]
lC :: Label -> FreshM [Int]
lC Label
l = ((Int, Map Label Int, Map Label [Int]) -> [Int]) -> FreshM [Int]
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ([Int] -> Label -> Map Label [Int] -> [Int]
forall k a. Ord k => a -> k -> Map k a -> a
M.findWithDefault ([Char] -> [Int]
forall a. HasCallStack => [Char] -> a
error [Char]
"Internal error in CF graph: node label not in map.") Label
l (Map Label [Int] -> [Int])
-> ((Int, Map Label Int, Map Label [Int]) -> Map Label [Int])
-> (Int, Map Label Int, Map Label [Int])
-> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, Map Label Int, Map Label [Int]) -> Map Label [Int]
forall a b c. (a, b, c) -> c
thd3)

br :: N -> Label -> FreshM ()
br :: Int -> Label -> FreshM ()
br Int
i Label
l = ((Int, Map Label Int, Map Label [Int])
 -> (Int, Map Label Int, Map Label [Int]))
-> FreshM ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((Map Label Int -> Map Label Int)
-> (Int, Map Label Int, Map Label [Int])
-> (Int, Map Label Int, Map Label [Int])
forall b b' a c. (b -> b') -> (a, b, c) -> (a, b', c)
second3 (Label -> Int -> Map Label Int -> Map Label Int
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Label
l Int
i))

b3 :: N -> Label -> FreshM ()
b3 :: Int -> Label -> FreshM ()
b3 Int
i Label
l = ((Int, Map Label Int, Map Label [Int])
 -> (Int, Map Label Int, Map Label [Int]))
-> FreshM ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((Map Label [Int] -> Map Label [Int])
-> (Int, Map Label Int, Map Label [Int])
-> (Int, Map Label Int, Map Label [Int])
forall c c' a b. (c -> c') -> (a, b, c) -> (a, b, c')
third3 ((Maybe [Int] -> Maybe [Int])
-> Label -> Map Label [Int] -> Map Label [Int]
forall k a.
Ord k =>
(Maybe a -> Maybe a) -> k -> Map k a -> Map k a
M.alter (\Maybe [Int]
k -> [Int] -> Maybe [Int]
forall a. a -> Maybe a
Just([Int] -> Maybe [Int]) -> [Int] -> Maybe [Int]
forall a b. (a -> b) -> a -> b
$case Maybe [Int]
k of {Maybe [Int]
Nothing -> [Int
i]; Just [Int]
is -> Int
iInt -> [Int] -> [Int]
forall a. a -> [a] -> [a]
:[Int]
is}) Label
l))

-- | Pair 'Stmt's with a unique node name and a list of all possible
-- destinations.
addCF :: [Stmt] -> FreshM [(Stmt, ControlAnn)]
addCF :: [Stmt] -> FreshM [(Stmt, ControlAnn)]
addCF [] = [(Stmt, ControlAnn)] -> FreshM [(Stmt, ControlAnn)]
forall a.
a -> StateT (Int, Map Label Int, Map Label [Int]) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
addCF ((L Label
l):[Stmt]
stmts) = do
    { i <- Label -> FreshM Int
ll Label
l
    ; (f, stmts') <- next stmts
    ; pure ((L l, ControlAnn i (f []) (UD IS.empty IS.empty IS.empty IS.empty)):stmts')
    }
addCF (J Label
l:[Stmt]
stmts) = do
    { i <- FreshM Int
getFresh
    ; ns <- addCF stmts
    ; l_i <- ll l
    ; pure ((J l, ControlAnn i [l_i] (UD IS.empty IS.empty IS.empty IS.empty)):ns)
    }
addCF (C Label
l:[Stmt]
stmts) = do
    { i <- FreshM Int
getFresh
    ; ns <- addCF stmts
    ; l_i <- ll l
    ; pure ((C l, ControlAnn i [l_i] (UD IS.empty IS.empty IS.empty IS.empty)):ns)
    }
addCF (R Label
l:[Stmt]
stmts) = do
    { i <- FreshM Int
getFresh
    ; ns <- addCF stmts
    ; l_is <- lC l
    ; pure ((R l, ControlAnn i l_is (UD IS.empty IS.empty IS.empty IS.empty)):ns)
    }
addCF (MJ Exp
e Label
l:[Stmt]
stmts) = do
    { i <- FreshM Int
getFresh
    ; (f, stmts') <- next stmts
    ; l_i <- ll l
    ; pure ((MJ e l, ControlAnn i (f [l_i]) (UD (uE e) IS.empty IS.empty IS.empty)):stmts')
    }
addCF (Stmt
stmt:[Stmt]
stmts) = do
    { i <- FreshM Int
getFresh
    ; (f, stmts') <- next stmts
    ; pure ((stmt, ControlAnn i (f []) (UD (uses stmt) (usesF stmt) (defs stmt) (defsF stmt))):stmts')
    }

rToInt :: Temp -> Int
rToInt :: Temp -> Int
rToInt (ITemp Int
i) = Int
i; rToInt (ATemp Int
i) = Int
i
rToInt Temp
C0 = -Int
1; rToInt Temp
C1 = -Int
2; rToInt Temp
C2 = -Int
3; rToInt Temp
C3 = -Int
4
rToInt Temp
C4 = -Int
5; rToInt Temp
C5 = -Int
6; rToInt Temp
CRet = -Int
7

fToInt :: FTemp -> Int
fToInt :: FTemp -> Int
fToInt (FTemp Int
i) = Int
i
fToInt FTemp
F0 = -Int
8; fToInt FTemp
F1 = -Int
9; fToInt FTemp
F2 = -Int
10; fToInt FTemp
F3 = -Int
11
fToInt FTemp
F4 = -Int
12; fToInt FTemp
F5 = -Int
13; fToInt FTemp
FRet = -Int
14; fToInt FTemp
FRet1 = -Int
15

singleton :: Temp -> IS.IntSet
singleton :: Temp -> IntSet
singleton = Int -> IntSet
IS.singleton (Int -> IntSet) -> (Temp -> Int) -> Temp -> IntSet
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Temp -> Int
rToInt

fsingleton :: FTemp -> IS.IntSet
fsingleton :: FTemp -> IntSet
fsingleton = Int -> IntSet
IS.singleton (Int -> IntSet) -> (FTemp -> Int) -> FTemp -> IntSet
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FTemp -> Int
fToInt

uE :: Exp -> IS.IntSet
uE :: Exp -> IntSet
uE (Reg Temp
r)        = Temp -> IntSet
singleton Temp
r
uE ConstI{}       = IntSet
IS.empty
uE (IB IBin
_ Exp
e0 Exp
e1)   = Exp -> IntSet
uE Exp
e0 IntSet -> IntSet -> IntSet
forall a. Semigroup a => a -> a -> a
<> Exp -> IntSet
uE Exp
e1
uE (IRel IRel
_ Exp
e0 Exp
e1) = Exp -> IntSet
uE Exp
e0 IntSet -> IntSet -> IntSet
forall a. Semigroup a => a -> a -> a
<> Exp -> IntSet
uE Exp
e1
uE (Is Temp
t)         = Temp -> IntSet
singleton Temp
t
uE (IU IUn
_ Exp
e)       = Exp -> IntSet
uE Exp
e
uE (BU BUn
_ Exp
e)       = Exp -> IntSet
uE Exp
e
uE LA{}           = IntSet
IS.empty
uE (IRFloor FExp
x)    = FExp -> IntSet
uFR FExp
x
uE (EAt AE
a)        = AE -> IntSet
uA AE
a
uE (BAt AE
a)        = AE -> IntSet
uA AE
a
uE (FRel FRel
_ FExp
x0 FExp
x1) = FExp -> IntSet
uFR FExp
x0IntSet -> IntSet -> IntSet
forall a. Semigroup a => a -> a -> a
<>FExp -> IntSet
uFR FExp
x1

uFF :: Exp -> IS.IntSet
uFF :: Exp -> IntSet
uFF (IRFloor FExp
e)    = FExp -> IntSet
uF FExp
e
uFF ConstI{}       = IntSet
IS.empty
uFF Reg{}          = IntSet
IS.empty
uFF (IB IBin
_ Exp
e0 Exp
e1)   = Exp -> IntSet
uFF Exp
e0IntSet -> IntSet -> IntSet
forall a. Semigroup a => a -> a -> a
<>Exp -> IntSet
uFF Exp
e1
uFF (IRel IRel
_ Exp
e0 Exp
e1) = Exp -> IntSet
uFF Exp
e0IntSet -> IntSet -> IntSet
forall a. Semigroup a => a -> a -> a
<>Exp -> IntSet
uFF Exp
e1
uFF (FRel FRel
_ FExp
e0 FExp
e1) = FExp -> IntSet
uF FExp
e0IntSet -> IntSet -> IntSet
forall a. Semigroup a => a -> a -> a
<>FExp -> IntSet
uF FExp
e1
uFF (IU IUn
_ Exp
e)       = Exp -> IntSet
uFF Exp
e
uFF (BU BUn
_ Exp
e)       = Exp -> IntSet
uFF Exp
e
uFF LA{}           = IntSet
IS.empty
uFF Is{}           = IntSet
IS.empty
uFF (EAt AE
e)        = AE -> IntSet
uAF AE
e
uFF (BAt AE
e)        = AE -> IntSet
uAF AE
e

uF :: FExp -> IS.IntSet
uF :: FExp -> IntSet
uF ConstF{}     = IntSet
IS.empty
uF (FB FBin
_ FExp
e0 FExp
e1) = FExp -> IntSet
uF FExp
e0 IntSet -> IntSet -> IntSet
forall a. Semigroup a => a -> a -> a
<> FExp -> IntSet
uF FExp
e1
uF (FConv Exp
e)    = Exp -> IntSet
uFF Exp
e
uF (FReg FTemp
t)     = FTemp -> IntSet
fsingleton FTemp
t
uF (FU FUn
_ FExp
e)     = FExp -> IntSet
uF FExp
e
uF (FAt AE
a)      = AE -> IntSet
uAF AE
a

uAF :: AE -> IS.IntSet
uAF :: AE -> IntSet
uAF (AP Temp
_ (Just Exp
e) Maybe AL
_) = Exp -> IntSet
uFF Exp
e
uAF AE
_                 = IntSet
IS.empty

uA :: AE -> IS.IntSet
uA :: AE -> IntSet
uA (AP Temp
t Maybe Exp
Nothing Maybe AL
_)  = Temp -> IntSet
singleton Temp
t
uA (AP Temp
t (Just Exp
e) Maybe AL
_) = Int -> IntSet -> IntSet
IS.insert (Temp -> Int
rToInt Temp
t) (Exp -> IntSet
uE Exp
e)

uFR :: FExp -> IS.IntSet
uFR :: FExp -> IntSet
uFR (FAt AE
a)      = AE -> IntSet
uA AE
a
uFR (FConv Exp
e)    = Exp -> IntSet
uE Exp
e
uFR (FB FBin
_ FExp
e0 FExp
e1) = FExp -> IntSet
uFR FExp
e0IntSet -> IntSet -> IntSet
forall a. Semigroup a => a -> a -> a
<>FExp -> IntSet
uFR FExp
e1
uFR FReg{}       = IntSet
IS.empty
uFR (FU FUn
_ FExp
e)     = FExp -> IntSet
uFR FExp
e
uFR ConstF{}     = IntSet
IS.empty

uses, defs :: Stmt -> IS.IntSet
uses :: Stmt -> IntSet
uses IRnd{}         = IntSet
IS.empty
uses FRnd{}         = IntSet
IS.empty
uses L{}            = IntSet
IS.empty
uses J{}            = IntSet
IS.empty
uses (MJ Exp
e Label
_)       = Exp -> IntSet
uE Exp
e
uses (MT Temp
_ Exp
e)       = Exp -> IntSet
uE Exp
e
uses (MX FTemp
_ FExp
e)       = FExp -> IntSet
uFR FExp
e
uses (Ma AL
_ Temp
_ Exp
e)     = Exp -> IntSet
uE Exp
e
uses (Free Temp
t)       = Temp -> IntSet
singleton Temp
t
uses RA{}           = IntSet
IS.empty
uses (Wr AE
a Exp
e)       = AE -> IntSet
uA AE
aIntSet -> IntSet -> IntSet
forall a. Semigroup a => a -> a -> a
<>Exp -> IntSet
uE Exp
e
uses (WrF AE
a FExp
e)      = AE -> IntSet
uA AE
aIntSet -> IntSet -> IntSet
forall a. Semigroup a => a -> a -> a
<>FExp -> IntSet
uFR FExp
e
uses (WrB AE
a Exp
e)      = AE -> IntSet
uA AE
aIntSet -> IntSet -> IntSet
forall a. Semigroup a => a -> a -> a
<>Exp -> IntSet
uE Exp
e
uses (Sa Temp
_ Exp
e)       = Exp -> IntSet
uE Exp
e
uses (Pop Exp
e)        = Exp -> IntSet
uE Exp
e
uses (Cmov Exp
e0 Temp
_ Exp
e1) = Exp -> IntSet
uE Exp
e0IntSet -> IntSet -> IntSet
forall a. Semigroup a => a -> a -> a
<>Exp -> IntSet
uE Exp
e1
uses (Fcmov Exp
e FTemp
_ FExp
x)  = Exp -> IntSet
uE Exp
eIntSet -> IntSet -> IntSet
forall a. Semigroup a => a -> a -> a
<>FExp -> IntSet
uFR FExp
x
uses R{}            = IntSet
IS.empty
uses C{}            = IntSet
IS.empty
uses (Cset Temp
_ Exp
e)     = Exp -> IntSet
uE Exp
e
uses (Cpy AE
a0 AE
a1 Exp
e)  = AE -> IntSet
uA AE
a0IntSet -> IntSet -> IntSet
forall a. Semigroup a => a -> a -> a
<>AE -> IntSet
uA AE
a1IntSet -> IntSet -> IntSet
forall a. Semigroup a => a -> a -> a
<>Exp -> IntSet
uE Exp
e
uses (Cpy1 AE
a0 AE
a1 Exp
e) = AE -> IntSet
uA AE
a0IntSet -> IntSet -> IntSet
forall a. Semigroup a => a -> a -> a
<>AE -> IntSet
uA AE
a1IntSet -> IntSet -> IntSet
forall a. Semigroup a => a -> a -> a
<>Exp -> IntSet
uE Exp
e

defs :: Stmt -> IntSet
defs (MT Temp
t Exp
_)     = Temp -> IntSet
singleton Temp
t
defs (IRnd Temp
t)     = Temp -> IntSet
singleton Temp
t
defs (Ma AL
_ Temp
t Exp
_)   = Temp -> IntSet
singleton Temp
t
defs (Cmov Exp
_ Temp
t Exp
_) = Temp -> IntSet
singleton Temp
t
defs (Sa Temp
t Exp
_)     = Temp -> IntSet
singleton Temp
t
defs (Cset Temp
t Exp
_)   = Temp -> IntSet
singleton Temp
t
defs Stmt
_            = IntSet
IS.empty

usesF, defsF :: Stmt -> IS.IntSet
usesF :: Stmt -> IntSet
usesF IRnd{}         = IntSet
IS.empty
usesF FRnd{}         = IntSet
IS.empty
usesF (MX FTemp
_ FExp
e)       = FExp -> IntSet
uF FExp
e
usesF L{}            = IntSet
IS.empty
usesF J{}            = IntSet
IS.empty
usesF MJ{}           = IntSet
IS.empty
usesF (MT Temp
_ Exp
e)       = Exp -> IntSet
uFF Exp
e
usesF (Ma AL
_ Temp
_ Exp
e)     = Exp -> IntSet
uFF Exp
e
usesF Free{}         = IntSet
IS.empty
usesF RA{}           = IntSet
IS.empty
usesF (Cmov Exp
e Temp
_ Exp
e')  = Exp -> IntSet
uFF Exp
eIntSet -> IntSet -> IntSet
forall a. Semigroup a => a -> a -> a
<>Exp -> IntSet
uFF Exp
e'
usesF (Fcmov Exp
e FTemp
_ FExp
x)  = Exp -> IntSet
uFF Exp
eIntSet -> IntSet -> IntSet
forall a. Semigroup a => a -> a -> a
<>FExp -> IntSet
uF FExp
x
usesF (Wr AE
a Exp
e)       = AE -> IntSet
uAF AE
aIntSet -> IntSet -> IntSet
forall a. Semigroup a => a -> a -> a
<>Exp -> IntSet
uFF Exp
e
usesF (WrF AE
a FExp
x)      = AE -> IntSet
uAF AE
aIntSet -> IntSet -> IntSet
forall a. Semigroup a => a -> a -> a
<>FExp -> IntSet
uF FExp
x
usesF (WrB AE
a Exp
e)      = AE -> IntSet
uAF AE
aIntSet -> IntSet -> IntSet
forall a. Semigroup a => a -> a -> a
<>Exp -> IntSet
uFF Exp
e
usesF (Cset Temp
_ Exp
e)     = Exp -> IntSet
uFF Exp
e
usesF (Sa Temp
_ Exp
e)       = Exp -> IntSet
uFF Exp
e
usesF (Pop Exp
e)        = Exp -> IntSet
uFF Exp
e
usesF C{}            = IntSet
IS.empty
usesF R{}            = IntSet
IS.empty
usesF (Cpy AE
a0 AE
a1 Exp
e)  = AE -> IntSet
uAF AE
a0IntSet -> IntSet -> IntSet
forall a. Semigroup a => a -> a -> a
<>AE -> IntSet
uAF AE
a1IntSet -> IntSet -> IntSet
forall a. Semigroup a => a -> a -> a
<>Exp -> IntSet
uFF Exp
e
usesF (Cpy1 AE
a0 AE
a1 Exp
e) = AE -> IntSet
uAF AE
a0IntSet -> IntSet -> IntSet
forall a. Semigroup a => a -> a -> a
<>AE -> IntSet
uAF AE
a1IntSet -> IntSet -> IntSet
forall a. Semigroup a => a -> a -> a
<>Exp -> IntSet
uFF Exp
e

defsF :: Stmt -> IntSet
defsF (MX FTemp
t FExp
_)      = FTemp -> IntSet
fsingleton FTemp
t
defsF (Fcmov Exp
_ FTemp
x FExp
_) = FTemp -> IntSet
fsingleton FTemp
x
defsF (FRnd FTemp
t)      = FTemp -> IntSet
fsingleton FTemp
t
defsF Stmt
_             = IntSet
IS.empty

next :: [Stmt] -> FreshM ([N] -> [N], [(Stmt, ControlAnn)])
next :: [Stmt] -> FreshM ([Int] -> [Int], [(Stmt, ControlAnn)])
next [Stmt]
stmts = do
    nextStmts <- [Stmt] -> FreshM [(Stmt, ControlAnn)]
addCF [Stmt]
stmts
    case nextStmts of
        []       -> ([Int] -> [Int], [(Stmt, ControlAnn)])
-> FreshM ([Int] -> [Int], [(Stmt, ControlAnn)])
forall a.
a -> StateT (Int, Map Label Int, Map Label [Int]) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Int] -> [Int]
forall a. a -> a
id, [])
        ((Stmt, ControlAnn)
stmt:[(Stmt, ControlAnn)]
_) -> ([Int] -> [Int], [(Stmt, ControlAnn)])
-> FreshM ([Int] -> [Int], [(Stmt, ControlAnn)])
forall a.
a -> StateT (Int, Map Label Int, Map Label [Int]) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((ControlAnn -> Int
node ((Stmt, ControlAnn) -> ControlAnn
forall a b. (a, b) -> b
snd (Stmt, ControlAnn)
stmt) Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
:), [(Stmt, ControlAnn)]
nextStmts)

-- | Construct map assigning labels to their node name.
brs :: [Stmt] -> FreshM ()
brs :: [Stmt] -> FreshM ()
brs []                     = () -> FreshM ()
forall a.
a -> StateT (Int, Map Label Int, Map Label [Int]) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
brs ((C Label
l):(L Label
retL):[Stmt]
stmts) = do {i <- Label -> FreshM Int
fm Label
retL; b3 i l; brs stmts}
brs ((L Label
l):[Stmt]
stmts)          = Label -> FreshM Int
fm Label
l FreshM Int -> FreshM () -> FreshM ()
forall a b.
StateT (Int, Map Label Int, Map Label [Int]) Identity a
-> StateT (Int, Map Label Int, Map Label [Int]) Identity b
-> StateT (Int, Map Label Int, Map Label [Int]) Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> [Stmt] -> FreshM ()
brs [Stmt]
stmts
brs (Stmt
_:[Stmt]
asms)               = [Stmt] -> FreshM ()
brs [Stmt]
asms