module Kempe.Asm.Arm.ControlFlow ( mkControlFlow
                                 , ControlAnn (..)
                                 ) where

import           Control.Monad.State.Strict (State, evalState, gets, modify)
import           Data.Bifunctor             (first, second)
import           Data.Functor               (($>))
import qualified Data.IntSet                as IS
import qualified Data.Map                   as M
import           Data.Semigroup             ((<>))
import           Kempe.Asm.Arm.Type
import           Kempe.Asm.Type

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

runFreshM :: FreshM a -> a
runFreshM :: FreshM a -> a
runFreshM = (FreshM a -> (Int, Map Label Int) -> a)
-> (Int, Map Label Int) -> FreshM a -> a
forall a b c. (a -> b -> c) -> b -> a -> c
flip FreshM a -> (Int, Map Label Int) -> a
forall s a. State s a -> s -> a
evalState (Int
0, Map Label Int
forall a. Monoid a => a
mempty)

mkControlFlow :: [Arm AbsReg ()] -> [Arm AbsReg ControlAnn]
mkControlFlow :: [Arm AbsReg ()] -> [Arm AbsReg ControlAnn]
mkControlFlow [Arm AbsReg ()]
instrs = FreshM [Arm AbsReg ControlAnn] -> [Arm AbsReg ControlAnn]
forall a. FreshM a -> a
runFreshM ([Arm AbsReg ()] -> FreshM [Arm AbsReg ()]
forall reg. [Arm reg ()] -> FreshM [Arm reg ()]
broadcasts [Arm AbsReg ()]
instrs FreshM [Arm AbsReg ()]
-> FreshM [Arm AbsReg ControlAnn] -> FreshM [Arm AbsReg ControlAnn]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> [Arm AbsReg ()] -> FreshM [Arm AbsReg ControlAnn]
addControlFlow [Arm AbsReg ()]
instrs)

getFresh :: FreshM Int
getFresh :: FreshM Int
getFresh = ((Int, Map Label Int) -> Int) -> FreshM Int
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (Int, Map Label Int) -> Int
forall a b. (a, b) -> a
fst FreshM Int -> StateT (Int, Map Label Int) Identity () -> FreshM Int
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ((Int, Map Label Int) -> (Int, Map Label Int))
-> StateT (Int, Map Label Int) Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((Int -> Int) -> (Int, Map Label Int) -> (Int, Map Label Int)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1))

lookupLabel :: Label -> FreshM Int
lookupLabel :: Label -> FreshM Int
lookupLabel Label
l = ((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)
-> (Int, Map Label Int)
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, Map Label Int) -> Map Label Int
forall a b. (a, b) -> b
snd)

broadcast :: Int -> Label -> FreshM ()
broadcast :: Int -> Label -> StateT (Int, Map Label Int) Identity ()
broadcast Int
i Label
l = ((Int, Map Label Int) -> (Int, Map Label Int))
-> StateT (Int, Map Label Int) Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((Map Label Int -> Map Label Int)
-> (Int, Map Label Int) -> (Int, Map Label Int)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second (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))

singleton :: AbsReg -> IS.IntSet
singleton :: AbsReg -> IntSet
singleton = IntSet -> (Int -> IntSet) -> Maybe Int -> IntSet
forall b a. b -> (a -> b) -> Maybe a -> b
maybe IntSet
IS.empty Int -> IntSet
IS.singleton (Maybe Int -> IntSet) -> (AbsReg -> Maybe Int) -> AbsReg -> IntSet
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AbsReg -> Maybe Int
toInt

-- | Can't be called on abstract registers i.e. 'DataPointer'
-- This is kinda sus but it allows us to use an 'IntSet' for liveness analysis.
toInt :: AbsReg -> Maybe Int
toInt :: AbsReg -> Maybe Int
toInt (AllocReg Int
i) = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
i
toInt AbsReg
_            = Maybe Int
forall a. Maybe a
Nothing

fromList :: [AbsReg] -> IS.IntSet
fromList :: [AbsReg] -> IntSet
fromList = (AbsReg -> IntSet) -> [AbsReg] -> IntSet
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap AbsReg -> IntSet
singleton

addrRegs :: Addr AbsReg -> IS.IntSet
addrRegs :: Addr AbsReg -> IntSet
addrRegs (Reg AbsReg
r)          = AbsReg -> IntSet
singleton AbsReg
r
addrRegs (AddRRPlus AbsReg
r AbsReg
r') = [AbsReg] -> IntSet
fromList [AbsReg
r, AbsReg
r']
addrRegs (AddRCPlus AbsReg
r Int64
_)  = AbsReg -> IntSet
singleton AbsReg
r

-- | Annotate instructions with a unique node name and a list of all possible
-- destinations.
addControlFlow :: [Arm AbsReg ()] -> FreshM [Arm AbsReg ControlAnn]
addControlFlow :: [Arm AbsReg ()] -> FreshM [Arm AbsReg ControlAnn]
addControlFlow [] = [Arm AbsReg ControlAnn] -> FreshM [Arm AbsReg ControlAnn]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
addControlFlow ((Label ()
_ Label
l):[Arm AbsReg ()]
asms) = do
    { Int
i <- Label -> FreshM Int
lookupLabel Label
l
    ; ([Int] -> [Int]
f, [Arm AbsReg ControlAnn]
asms') <- [Arm AbsReg ()] -> FreshM ([Int] -> [Int], [Arm AbsReg ControlAnn])
next [Arm AbsReg ()]
asms
    ; [Arm AbsReg ControlAnn] -> FreshM [Arm AbsReg ControlAnn]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ControlAnn -> Label -> Arm AbsReg ControlAnn
forall reg a. a -> Label -> Arm reg a
Label (Int -> [Int] -> IntSet -> IntSet -> ControlAnn
ControlAnn Int
i ([Int] -> [Int]
f []) IntSet
IS.empty IntSet
IS.empty) Label
l Arm AbsReg ControlAnn
-> [Arm AbsReg ControlAnn] -> [Arm AbsReg ControlAnn]
forall a. a -> [a] -> [a]
: [Arm AbsReg ControlAnn]
asms')
    }
addControlFlow ((BranchCond ()
_ Label
l Cond
c):[Arm AbsReg ()]
asms) = do
    { Int
i <- FreshM Int
getFresh
    ; ([Int] -> [Int]
f, [Arm AbsReg ControlAnn]
asms') <- [Arm AbsReg ()] -> FreshM ([Int] -> [Int], [Arm AbsReg ControlAnn])
next [Arm AbsReg ()]
asms
    ; Int
l_i <- Label -> FreshM Int
lookupLabel Label
l
    ; [Arm AbsReg ControlAnn] -> FreshM [Arm AbsReg ControlAnn]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ControlAnn -> Label -> Cond -> Arm AbsReg ControlAnn
forall reg a. a -> Label -> Cond -> Arm reg a
BranchCond (Int -> [Int] -> IntSet -> IntSet -> ControlAnn
ControlAnn Int
i ([Int] -> [Int]
f [Int
l_i]) IntSet
IS.empty IntSet
IS.empty) Label
l Cond
c Arm AbsReg ControlAnn
-> [Arm AbsReg ControlAnn] -> [Arm AbsReg ControlAnn]
forall a. a -> [a] -> [a]
: [Arm AbsReg ControlAnn]
asms')
    }
addControlFlow ((BranchZero ()
_ AbsReg
r Label
l):[Arm AbsReg ()]
asms) = do
    { Int
i <- FreshM Int
getFresh
    ; ([Int] -> [Int]
f, [Arm AbsReg ControlAnn]
asms') <- [Arm AbsReg ()] -> FreshM ([Int] -> [Int], [Arm AbsReg ControlAnn])
next [Arm AbsReg ()]
asms
    ; Int
l_i <- Label -> FreshM Int
lookupLabel Label
l
    ; [Arm AbsReg ControlAnn] -> FreshM [Arm AbsReg ControlAnn]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ControlAnn -> AbsReg -> Label -> Arm AbsReg ControlAnn
forall reg a. a -> reg -> Label -> Arm reg a
BranchZero (Int -> [Int] -> IntSet -> IntSet -> ControlAnn
ControlAnn Int
i ([Int] -> [Int]
f [Int
l_i]) (AbsReg -> IntSet
singleton AbsReg
r) IntSet
IS.empty) AbsReg
r Label
l Arm AbsReg ControlAnn
-> [Arm AbsReg ControlAnn] -> [Arm AbsReg ControlAnn]
forall a. a -> [a] -> [a]
: [Arm AbsReg ControlAnn]
asms')
    }
addControlFlow ((BranchNonzero ()
_ AbsReg
r Label
l):[Arm AbsReg ()]
asms) = do
    { Int
i <- FreshM Int
getFresh
    ; ([Int] -> [Int]
f, [Arm AbsReg ControlAnn]
asms') <- [Arm AbsReg ()] -> FreshM ([Int] -> [Int], [Arm AbsReg ControlAnn])
next [Arm AbsReg ()]
asms
    ; Int
l_i <- Label -> FreshM Int
lookupLabel Label
l
    ; [Arm AbsReg ControlAnn] -> FreshM [Arm AbsReg ControlAnn]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ControlAnn -> AbsReg -> Label -> Arm AbsReg ControlAnn
forall reg a. a -> reg -> Label -> Arm reg a
BranchNonzero (Int -> [Int] -> IntSet -> IntSet -> ControlAnn
ControlAnn Int
i ([Int] -> [Int]
f [Int
l_i]) (AbsReg -> IntSet
singleton AbsReg
r) IntSet
IS.empty) AbsReg
r Label
l Arm AbsReg ControlAnn
-> [Arm AbsReg ControlAnn] -> [Arm AbsReg ControlAnn]
forall a. a -> [a] -> [a]
: [Arm AbsReg ControlAnn]
asms')
    }
addControlFlow ((BranchLink ()
_ Label
l):[Arm AbsReg ()]
asms) = do
    { Int
i <- FreshM Int
getFresh
    ; [Arm AbsReg ControlAnn]
nextAsms <- [Arm AbsReg ()] -> FreshM [Arm AbsReg ControlAnn]
addControlFlow [Arm AbsReg ()]
asms
    ; Int
l_i <- Label -> FreshM Int
lookupLabel Label
l
    ; [Arm AbsReg ControlAnn] -> FreshM [Arm AbsReg ControlAnn]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ControlAnn -> Label -> Arm AbsReg ControlAnn
forall reg a. a -> Label -> Arm reg a
BranchLink (Int -> [Int] -> IntSet -> IntSet -> ControlAnn
ControlAnn Int
i [Int
l_i] IntSet
IS.empty IntSet
IS.empty) Label
l Arm AbsReg ControlAnn
-> [Arm AbsReg ControlAnn] -> [Arm AbsReg ControlAnn]
forall a. a -> [a] -> [a]
: [Arm AbsReg ControlAnn]
nextAsms)
    }
addControlFlow (Ret{}:[Arm AbsReg ()]
asms) = do
    { Int
i <- FreshM Int
getFresh
    ; [Arm AbsReg ControlAnn]
nextAsms <- [Arm AbsReg ()] -> FreshM [Arm AbsReg ControlAnn]
addControlFlow [Arm AbsReg ()]
asms
    ; [Arm AbsReg ControlAnn] -> FreshM [Arm AbsReg ControlAnn]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ControlAnn -> Arm AbsReg ControlAnn
forall reg a. a -> Arm reg a
Ret (Int -> [Int] -> IntSet -> IntSet -> ControlAnn
ControlAnn Int
i [] IntSet
IS.empty IntSet
IS.empty) Arm AbsReg ControlAnn
-> [Arm AbsReg ControlAnn] -> [Arm AbsReg ControlAnn]
forall a. a -> [a] -> [a]
: [Arm AbsReg ControlAnn]
nextAsms)
    }
addControlFlow (Arm AbsReg ()
asm:[Arm AbsReg ()]
asms) = do
    { Int
i <- FreshM Int
getFresh
    ; ([Int] -> [Int]
f, [Arm AbsReg ControlAnn]
asms') <- [Arm AbsReg ()] -> FreshM ([Int] -> [Int], [Arm AbsReg ControlAnn])
next [Arm AbsReg ()]
asms
    ; [Arm AbsReg ControlAnn] -> FreshM [Arm AbsReg ControlAnn]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Arm AbsReg ()
asm Arm AbsReg () -> ControlAnn -> Arm AbsReg ControlAnn
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Int -> [Int] -> IntSet -> IntSet -> ControlAnn
ControlAnn Int
i ([Int] -> [Int]
f []) (Arm AbsReg () -> IntSet
forall ann. Arm AbsReg ann -> IntSet
uses Arm AbsReg ()
asm) (Arm AbsReg () -> IntSet
forall ann. Arm AbsReg ann -> IntSet
defs Arm AbsReg ()
asm)) Arm AbsReg ControlAnn
-> [Arm AbsReg ControlAnn] -> [Arm AbsReg ControlAnn]
forall a. a -> [a] -> [a]
: [Arm AbsReg ControlAnn]
asms')
    }

uses :: Arm AbsReg ann -> IS.IntSet
uses :: Arm AbsReg ann -> IntSet
uses (MovRR ann
_ AbsReg
_ AbsReg
r)            = AbsReg -> IntSet
singleton AbsReg
r
uses (AddRR ann
_ AbsReg
_ AbsReg
r AbsReg
r')         = [AbsReg] -> IntSet
fromList [AbsReg
r, AbsReg
r']
uses (SubRR ann
_ AbsReg
_ AbsReg
r AbsReg
r')         = [AbsReg] -> IntSet
fromList [AbsReg
r, AbsReg
r']
uses (SubRC ann
_ AbsReg
_ AbsReg
r Int64
_)          = AbsReg -> IntSet
singleton AbsReg
r
uses (LShiftLRR ann
_ AbsReg
_ AbsReg
r AbsReg
r')     = [AbsReg] -> IntSet
fromList [AbsReg
r, AbsReg
r']
uses (LShiftRRR ann
_ AbsReg
_ AbsReg
r AbsReg
r')     = [AbsReg] -> IntSet
fromList [AbsReg
r, AbsReg
r']
uses (BranchZero ann
_ AbsReg
r Label
_)       = AbsReg -> IntSet
singleton AbsReg
r
uses (MovRK ann
_ AbsReg
r Word16
_ Int8
_)          = AbsReg -> IntSet
singleton AbsReg
r -- since MovRK only affects 16 bits, it depends on the previous r to be live!
uses (BranchNonzero ann
_ AbsReg
r Label
_)    = AbsReg -> IntSet
singleton AbsReg
r
uses (AddRC ann
_ AbsReg
_ AbsReg
r Int64
_)          = AbsReg -> IntSet
singleton AbsReg
r
uses (MulRR ann
_ AbsReg
_ AbsReg
r AbsReg
r')         = [AbsReg] -> IntSet
fromList [AbsReg
r, AbsReg
r']
uses (AndRR ann
_ AbsReg
_ AbsReg
r AbsReg
r')         = [AbsReg] -> IntSet
fromList [AbsReg
r, AbsReg
r']
uses (OrRR ann
_ AbsReg
_ AbsReg
r AbsReg
r')          = [AbsReg] -> IntSet
fromList [AbsReg
r, AbsReg
r']
uses (SignedDivRR ann
_ AbsReg
_ AbsReg
r AbsReg
r')   = [AbsReg] -> IntSet
fromList [AbsReg
r, AbsReg
r']
uses (UnsignedDivRR ann
_ AbsReg
_ AbsReg
r AbsReg
r') = [AbsReg] -> IntSet
fromList [AbsReg
r, AbsReg
r']
uses (CmpRR ann
_ AbsReg
r AbsReg
r')           = [AbsReg] -> IntSet
fromList [AbsReg
r, AbsReg
r']
uses (CmpRC ann
_ AbsReg
r Int64
_)            = AbsReg -> IntSet
singleton AbsReg
r
uses (Load ann
_ AbsReg
_ Addr AbsReg
a)             = Addr AbsReg -> IntSet
addrRegs Addr AbsReg
a
uses (LoadByte ann
_ AbsReg
_ Addr AbsReg
a)         = Addr AbsReg -> IntSet
addrRegs Addr AbsReg
a
uses (Neg ann
_ AbsReg
_ AbsReg
r)              = AbsReg -> IntSet
singleton AbsReg
r
uses (MulSubRRR ann
_ AbsReg
_ AbsReg
r AbsReg
r' AbsReg
r'') = [AbsReg] -> IntSet
fromList [AbsReg
r, AbsReg
r', AbsReg
r'']
uses (XorRR ann
_ AbsReg
_ AbsReg
r AbsReg
r')         = [AbsReg] -> IntSet
fromList [AbsReg
r, AbsReg
r']
uses (Store ann
_ AbsReg
r Addr AbsReg
a)            = AbsReg -> IntSet
singleton AbsReg
r IntSet -> IntSet -> IntSet
forall a. Semigroup a => a -> a -> a
<> Addr AbsReg -> IntSet
addrRegs Addr AbsReg
a
uses (StoreByte ann
_ AbsReg
r Addr AbsReg
a)        = AbsReg -> IntSet
singleton AbsReg
r IntSet -> IntSet -> IntSet
forall a. Semigroup a => a -> a -> a
<> Addr AbsReg -> IntSet
addrRegs Addr AbsReg
a
uses Arm AbsReg ann
_                        = IntSet
forall a. Monoid a => a
mempty

defs :: Arm AbsReg ann -> IS.IntSet
defs :: Arm AbsReg ann -> IntSet
defs (MovRR ann
_ AbsReg
r AbsReg
_)           = AbsReg -> IntSet
singleton AbsReg
r
defs (MovRC ann
_ AbsReg
r Int64
_)           = AbsReg -> IntSet
singleton AbsReg
r
defs (MovRWord ann
_ AbsReg
r Word16
_)        = AbsReg -> IntSet
singleton AbsReg
r
defs (MovRK ann
_ AbsReg
r Word16
_ Int8
_)         = AbsReg -> IntSet
singleton AbsReg
r
defs (AddRR ann
_ AbsReg
r AbsReg
_ AbsReg
_)         = AbsReg -> IntSet
singleton AbsReg
r
defs (SubRR ann
_ AbsReg
r AbsReg
_ AbsReg
_)         = AbsReg -> IntSet
singleton AbsReg
r
defs (AddRC ann
_ AbsReg
r AbsReg
_ Int64
_)         = AbsReg -> IntSet
singleton AbsReg
r
defs (SubRC ann
_ AbsReg
r AbsReg
_ Int64
_)         = AbsReg -> IntSet
singleton AbsReg
r
defs (LoadByte ann
_ AbsReg
r Addr AbsReg
_)        = AbsReg -> IntSet
singleton AbsReg
r
defs (LShiftRRR ann
_ AbsReg
r AbsReg
_ AbsReg
_)     = AbsReg -> IntSet
singleton AbsReg
r
defs (MulSubRRR ann
_ AbsReg
r AbsReg
_ AbsReg
_ AbsReg
_)   = AbsReg -> IntSet
singleton AbsReg
r
defs (LShiftLRR ann
_ AbsReg
r AbsReg
_ AbsReg
_)     = AbsReg -> IntSet
singleton AbsReg
r
defs (AndRR ann
_ AbsReg
r AbsReg
_ AbsReg
_)         = AbsReg -> IntSet
singleton AbsReg
r
defs (OrRR ann
_ AbsReg
r AbsReg
_ AbsReg
_)          = AbsReg -> IntSet
singleton AbsReg
r
defs (MulRR ann
_ AbsReg
r AbsReg
_ AbsReg
_)         = AbsReg -> IntSet
singleton AbsReg
r
defs (Load ann
_ AbsReg
r Addr AbsReg
_)            = AbsReg -> IntSet
singleton AbsReg
r
defs (SignedDivRR ann
_ AbsReg
r AbsReg
_ AbsReg
_)   = AbsReg -> IntSet
singleton AbsReg
r
defs (UnsignedDivRR ann
_ AbsReg
r AbsReg
_ AbsReg
_) = AbsReg -> IntSet
singleton AbsReg
r
defs (LoadLabel ann
_ AbsReg
r ByteString
_)       = AbsReg -> IntSet
singleton AbsReg
r
defs (CSet ann
_ AbsReg
r Cond
_)            = AbsReg -> IntSet
singleton AbsReg
r
defs (Neg ann
_ AbsReg
r AbsReg
_)             = AbsReg -> IntSet
singleton AbsReg
r
defs (XorRR ann
_ AbsReg
r AbsReg
_ AbsReg
_)         = AbsReg -> IntSet
singleton AbsReg
r
defs Arm AbsReg ann
_                       = IntSet
forall a. Monoid a => a
mempty

next :: [Arm AbsReg ()] -> FreshM ([Int] -> [Int], [Arm AbsReg ControlAnn])
next :: [Arm AbsReg ()] -> FreshM ([Int] -> [Int], [Arm AbsReg ControlAnn])
next [Arm AbsReg ()]
asms = do
    [Arm AbsReg ControlAnn]
nextAsms <- [Arm AbsReg ()] -> FreshM [Arm AbsReg ControlAnn]
addControlFlow [Arm AbsReg ()]
asms
    case [Arm AbsReg ControlAnn]
nextAsms of
        []      -> ([Int] -> [Int], [Arm AbsReg ControlAnn])
-> FreshM ([Int] -> [Int], [Arm AbsReg ControlAnn])
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Int] -> [Int]
forall a. a -> a
id, [])
        (Arm AbsReg ControlAnn
asm:[Arm AbsReg ControlAnn]
_) -> ([Int] -> [Int], [Arm AbsReg ControlAnn])
-> FreshM ([Int] -> [Int], [Arm AbsReg ControlAnn])
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((ControlAnn -> Int
node (Arm AbsReg ControlAnn -> ControlAnn
forall reg a. Arm reg a -> a
ann Arm AbsReg ControlAnn
asm) Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
:), [Arm AbsReg ControlAnn]
nextAsms)

-- | Construct map assigning labels to their node name.
broadcasts :: [Arm reg ()] -> FreshM [Arm reg ()]
broadcasts :: [Arm reg ()] -> FreshM [Arm reg ()]
broadcasts [] = [Arm reg ()] -> FreshM [Arm reg ()]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
broadcasts (asm :: Arm reg ()
asm@(Label ()
_ Label
l):[Arm reg ()]
asms) = do
    { Int
i <- FreshM Int
getFresh
    ; Int -> Label -> StateT (Int, Map Label Int) Identity ()
broadcast Int
i Label
l
    ; (Arm reg ()
asm Arm reg () -> [Arm reg ()] -> [Arm reg ()]
forall a. a -> [a] -> [a]
:) ([Arm reg ()] -> [Arm reg ()])
-> FreshM [Arm reg ()] -> FreshM [Arm reg ()]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Arm reg ()] -> FreshM [Arm reg ()]
forall reg. [Arm reg ()] -> FreshM [Arm reg ()]
broadcasts [Arm reg ()]
asms
    }
broadcasts (Arm reg ()
asm:[Arm reg ()]
asms) = (Arm reg ()
asm Arm reg () -> [Arm reg ()] -> [Arm reg ()]
forall a. a -> [a] -> [a]
:) ([Arm reg ()] -> [Arm reg ()])
-> FreshM [Arm reg ()] -> FreshM [Arm reg ()]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Arm reg ()] -> FreshM [Arm reg ()]
forall reg. [Arm reg ()] -> FreshM [Arm reg ()]
broadcasts [Arm reg ()]
asms