{-# LANGUAGE PatternSynonyms, DeriveFunctor, DerivingVia #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE UnboxedTuples #-}

-- | State monad for the linear register allocator.

--      Here we keep all the state that the register allocator keeps track
--      of as it walks the instructions in a basic block.

module GHC.CmmToAsm.Reg.Linear.State (
        RA_State(..),
        RegM,
        runR,

        spillR,
        loadR,

        getFreeRegsR,
        setFreeRegsR,

        getAssigR,
        setAssigR,

        getBlockAssigR,
        setBlockAssigR,

        setDeltaR,
        getDeltaR,

        getUniqueR,
        getConfig,
        getPlatform,

        recordSpill,
        recordFixupBlock
)
where

import GHC.Prelude

import GHC.CmmToAsm.Reg.Linear.Stats
import GHC.CmmToAsm.Reg.Linear.StackMap
import GHC.CmmToAsm.Reg.Linear.Base
import GHC.CmmToAsm.Reg.Liveness
import GHC.CmmToAsm.Format
import GHC.CmmToAsm.Instr
import GHC.CmmToAsm.Config
import GHC.Cmm.BlockId

import GHC.Platform
import GHC.Types.Unique
import GHC.Types.Unique.DSM
import GHC.Exts (oneShot)

import GHC.Utils.Monad.State.Strict as Strict

type RA_Result freeRegs a = (# a, RA_State freeRegs #)

pattern RA_Result :: a -> b -> (# b, a #)
pattern $mRA_Result :: forall {r} {a} {b}.
(# b, a #) -> (a -> b -> r) -> ((# #) -> r) -> r
$bRA_Result :: forall a b. a -> b -> (# b, a #)
RA_Result a b = (# b, a #)
{-# COMPLETE RA_Result #-}

-- | The register allocator monad type.
newtype RegM freeRegs a
        = RegM { forall freeRegs a.
RegM freeRegs a -> RA_State freeRegs -> RA_Result freeRegs a
unReg :: RA_State freeRegs -> RA_Result freeRegs a }
        deriving ((forall a b. (a -> b) -> RegM freeRegs a -> RegM freeRegs b)
-> (forall a b. a -> RegM freeRegs b -> RegM freeRegs a)
-> Functor (RegM freeRegs)
forall a b. a -> RegM freeRegs b -> RegM freeRegs a
forall a b. (a -> b) -> RegM freeRegs a -> RegM freeRegs b
forall freeRegs a b. a -> RegM freeRegs b -> RegM freeRegs a
forall freeRegs a b. (a -> b) -> RegM freeRegs a -> RegM freeRegs b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall freeRegs a b. (a -> b) -> RegM freeRegs a -> RegM freeRegs b
fmap :: forall a b. (a -> b) -> RegM freeRegs a -> RegM freeRegs b
$c<$ :: forall freeRegs a b. a -> RegM freeRegs b -> RegM freeRegs a
<$ :: forall a b. a -> RegM freeRegs b -> RegM freeRegs a
Functor, Functor (RegM freeRegs)
Functor (RegM freeRegs) =>
(forall a. a -> RegM freeRegs a)
-> (forall a b.
    RegM freeRegs (a -> b) -> RegM freeRegs a -> RegM freeRegs b)
-> (forall a b c.
    (a -> b -> c)
    -> RegM freeRegs a -> RegM freeRegs b -> RegM freeRegs c)
-> (forall a b.
    RegM freeRegs a -> RegM freeRegs b -> RegM freeRegs b)
-> (forall a b.
    RegM freeRegs a -> RegM freeRegs b -> RegM freeRegs a)
-> Applicative (RegM freeRegs)
forall freeRegs. Functor (RegM freeRegs)
forall a. a -> RegM freeRegs a
forall freeRegs a. a -> RegM freeRegs a
forall a b. RegM freeRegs a -> RegM freeRegs b -> RegM freeRegs a
forall a b. RegM freeRegs a -> RegM freeRegs b -> RegM freeRegs b
forall a b.
RegM freeRegs (a -> b) -> RegM freeRegs a -> RegM freeRegs b
forall freeRegs a b.
RegM freeRegs a -> RegM freeRegs b -> RegM freeRegs a
forall freeRegs a b.
RegM freeRegs a -> RegM freeRegs b -> RegM freeRegs b
forall freeRegs a b.
RegM freeRegs (a -> b) -> RegM freeRegs a -> RegM freeRegs b
forall a b c.
(a -> b -> c)
-> RegM freeRegs a -> RegM freeRegs b -> RegM freeRegs c
forall freeRegs a b c.
(a -> b -> c)
-> RegM freeRegs a -> RegM freeRegs b -> RegM freeRegs c
forall (f :: * -> *).
Functor f =>
(forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
$cpure :: forall freeRegs a. a -> RegM freeRegs a
pure :: forall a. a -> RegM freeRegs a
$c<*> :: forall freeRegs a b.
RegM freeRegs (a -> b) -> RegM freeRegs a -> RegM freeRegs b
<*> :: forall a b.
RegM freeRegs (a -> b) -> RegM freeRegs a -> RegM freeRegs b
$cliftA2 :: forall freeRegs a b c.
(a -> b -> c)
-> RegM freeRegs a -> RegM freeRegs b -> RegM freeRegs c
liftA2 :: forall a b c.
(a -> b -> c)
-> RegM freeRegs a -> RegM freeRegs b -> RegM freeRegs c
$c*> :: forall freeRegs a b.
RegM freeRegs a -> RegM freeRegs b -> RegM freeRegs b
*> :: forall a b. RegM freeRegs a -> RegM freeRegs b -> RegM freeRegs b
$c<* :: forall freeRegs a b.
RegM freeRegs a -> RegM freeRegs b -> RegM freeRegs a
<* :: forall a b. RegM freeRegs a -> RegM freeRegs b -> RegM freeRegs a
Applicative, Applicative (RegM freeRegs)
Applicative (RegM freeRegs) =>
(forall a b.
 RegM freeRegs a -> (a -> RegM freeRegs b) -> RegM freeRegs b)
-> (forall a b.
    RegM freeRegs a -> RegM freeRegs b -> RegM freeRegs b)
-> (forall a. a -> RegM freeRegs a)
-> Monad (RegM freeRegs)
forall freeRegs. Applicative (RegM freeRegs)
forall a. a -> RegM freeRegs a
forall freeRegs a. a -> RegM freeRegs a
forall a b. RegM freeRegs a -> RegM freeRegs b -> RegM freeRegs b
forall a b.
RegM freeRegs a -> (a -> RegM freeRegs b) -> RegM freeRegs b
forall freeRegs a b.
RegM freeRegs a -> RegM freeRegs b -> RegM freeRegs b
forall freeRegs a b.
RegM freeRegs a -> (a -> RegM freeRegs b) -> RegM freeRegs b
forall (m :: * -> *).
Applicative m =>
(forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
$c>>= :: forall freeRegs a b.
RegM freeRegs a -> (a -> RegM freeRegs b) -> RegM freeRegs b
>>= :: forall a b.
RegM freeRegs a -> (a -> RegM freeRegs b) -> RegM freeRegs b
$c>> :: forall freeRegs a b.
RegM freeRegs a -> RegM freeRegs b -> RegM freeRegs b
>> :: forall a b. RegM freeRegs a -> RegM freeRegs b -> RegM freeRegs b
$creturn :: forall freeRegs a. a -> RegM freeRegs a
return :: forall a. a -> RegM freeRegs a
Monad) via (Strict.State (RA_State freeRegs))

-- | Smart constructor for 'RegM', as described in Note [The one-shot state
-- monad trick] in GHC.Utils.Monad.
mkRegM :: (RA_State freeRegs -> RA_Result freeRegs a) -> RegM freeRegs a
mkRegM :: forall freeRegs a.
(RA_State freeRegs -> RA_Result freeRegs a) -> RegM freeRegs a
mkRegM RA_State freeRegs -> RA_Result freeRegs a
f = (RA_State freeRegs -> RA_Result freeRegs a) -> RegM freeRegs a
forall freeRegs a.
(RA_State freeRegs -> RA_Result freeRegs a) -> RegM freeRegs a
RegM ((RA_State freeRegs -> RA_Result freeRegs a)
-> RA_State freeRegs -> RA_Result freeRegs a
forall a b. (a -> b) -> a -> b
oneShot RA_State freeRegs -> RA_Result freeRegs a
f)

-- | Get native code generator configuration
getConfig :: RegM a NCGConfig
getConfig :: forall a. RegM a NCGConfig
getConfig = (RA_State a -> RA_Result a NCGConfig) -> RegM a NCGConfig
forall freeRegs a.
(RA_State freeRegs -> RA_Result freeRegs a) -> RegM freeRegs a
mkRegM ((RA_State a -> RA_Result a NCGConfig) -> RegM a NCGConfig)
-> (RA_State a -> RA_Result a NCGConfig) -> RegM a NCGConfig
forall a b. (a -> b) -> a -> b
$ \RA_State a
s -> RA_State a -> NCGConfig -> RA_Result a NCGConfig
forall a b. a -> b -> (# b, a #)
RA_Result RA_State a
s (RA_State a -> NCGConfig
forall freeRegs. RA_State freeRegs -> NCGConfig
ra_config RA_State a
s)

-- | Get target platform from native code generator configuration
getPlatform :: RegM a Platform
getPlatform :: forall a. RegM a Platform
getPlatform = NCGConfig -> Platform
ncgPlatform (NCGConfig -> Platform) -> RegM a NCGConfig -> RegM a Platform
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RegM a NCGConfig
forall a. RegM a NCGConfig
getConfig

-- | Run a computation in the RegM register allocator monad.
runR    :: NCGConfig
        -> BlockAssignment freeRegs
        -> freeRegs
        -> RegMap Loc
        -> StackMap
        -> DUniqSupply
        -> RegM freeRegs a
        -> (BlockAssignment freeRegs, StackMap, RegAllocStats, a, DUniqSupply)

runR :: forall freeRegs a.
NCGConfig
-> BlockAssignment freeRegs
-> freeRegs
-> RegMap Loc
-> StackMap
-> DUniqSupply
-> RegM freeRegs a
-> (BlockAssignment freeRegs, StackMap, RegAllocStats, a,
    DUniqSupply)
runR NCGConfig
config BlockAssignment freeRegs
block_assig freeRegs
freeregs RegMap Loc
assig StackMap
stack DUniqSupply
us RegM freeRegs a
thing =
  case RegM freeRegs a -> RA_State freeRegs -> RA_Result freeRegs a
forall freeRegs a.
RegM freeRegs a -> RA_State freeRegs -> RA_Result freeRegs a
unReg RegM freeRegs a
thing
        (RA_State
                { ra_blockassig :: BlockAssignment freeRegs
ra_blockassig = BlockAssignment freeRegs
block_assig
                , ra_freeregs :: freeRegs
ra_freeregs   = freeRegs
freeregs
                , ra_assig :: RegMap Loc
ra_assig      = RegMap Loc
assig
                , ra_delta :: Int
ra_delta      = Int
0{-???-}
                , ra_stack :: StackMap
ra_stack      = StackMap
stack
                , ra_us :: DUniqSupply
ra_us         = DUniqSupply
us
                , ra_spills :: [SpillReason]
ra_spills     = []
                , ra_config :: NCGConfig
ra_config     = NCGConfig
config
                , ra_fixups :: [(BlockId, BlockId, BlockId)]
ra_fixups     = [] })
   of
        RA_Result RA_State freeRegs
state a
returned_thing
         ->  (RA_State freeRegs -> BlockAssignment freeRegs
forall freeRegs. RA_State freeRegs -> BlockAssignment freeRegs
ra_blockassig RA_State freeRegs
state, RA_State freeRegs -> StackMap
forall freeRegs. RA_State freeRegs -> StackMap
ra_stack RA_State freeRegs
state, RA_State freeRegs -> RegAllocStats
forall freeRegs. RA_State freeRegs -> RegAllocStats
makeRAStats RA_State freeRegs
state, a
returned_thing, RA_State freeRegs -> DUniqSupply
forall freeRegs. RA_State freeRegs -> DUniqSupply
ra_us RA_State freeRegs
state)


-- | Make register allocator stats from its final state.
makeRAStats :: RA_State freeRegs -> RegAllocStats
makeRAStats :: forall freeRegs. RA_State freeRegs -> RegAllocStats
makeRAStats RA_State freeRegs
state
        = RegAllocStats
        { ra_spillInstrs :: UniqFM Unique [Int]
ra_spillInstrs        = [SpillReason] -> UniqFM Unique [Int]
binSpillReasons (RA_State freeRegs -> [SpillReason]
forall freeRegs. RA_State freeRegs -> [SpillReason]
ra_spills RA_State freeRegs
state)
        , ra_fixupList :: [(BlockId, BlockId, BlockId)]
ra_fixupList          = RA_State freeRegs -> [(BlockId, BlockId, BlockId)]
forall freeRegs. RA_State freeRegs -> [(BlockId, BlockId, BlockId)]
ra_fixups RA_State freeRegs
state }


spillR :: Instruction instr
       => RegWithFormat -> Unique -> RegM freeRegs ([instr], Int)

spillR :: forall instr freeRegs.
Instruction instr =>
RegWithFormat -> Unique -> RegM freeRegs ([instr], Int)
spillR RegWithFormat
reg Unique
temp = (RA_State freeRegs -> RA_Result freeRegs ([instr], Int))
-> RegM freeRegs ([instr], Int)
forall freeRegs a.
(RA_State freeRegs -> RA_Result freeRegs a) -> RegM freeRegs a
mkRegM ((RA_State freeRegs -> RA_Result freeRegs ([instr], Int))
 -> RegM freeRegs ([instr], Int))
-> (RA_State freeRegs -> RA_Result freeRegs ([instr], Int))
-> RegM freeRegs ([instr], Int)
forall a b. (a -> b) -> a -> b
$ \RA_State freeRegs
s ->
  let (StackMap
stack1,Int
slots) = StackMap -> Format -> Unique -> (StackMap, Int)
getStackSlotFor (RA_State freeRegs -> StackMap
forall freeRegs. RA_State freeRegs -> StackMap
ra_stack RA_State freeRegs
s) (RegWithFormat -> Format
regWithFormat_format RegWithFormat
reg) Unique
temp
      instr :: [instr]
instr  = NCGConfig -> RegWithFormat -> Int -> Int -> [instr]
forall instr.
(Instruction instr, HasDebugCallStack) =>
NCGConfig -> RegWithFormat -> Int -> Int -> [instr]
mkSpillInstr (RA_State freeRegs -> NCGConfig
forall freeRegs. RA_State freeRegs -> NCGConfig
ra_config RA_State freeRegs
s) RegWithFormat
reg (RA_State freeRegs -> Int
forall freeRegs. RA_State freeRegs -> Int
ra_delta RA_State freeRegs
s) Int
slots
  in
  RA_State freeRegs
-> ([instr], Int) -> RA_Result freeRegs ([instr], Int)
forall a b. a -> b -> (# b, a #)
RA_Result RA_State freeRegs
s{ra_stack=stack1} ([instr]
instr,Int
slots)


loadR :: Instruction instr
      => RegWithFormat -> Int -> RegM freeRegs [instr]

loadR :: forall instr freeRegs.
Instruction instr =>
RegWithFormat -> Int -> RegM freeRegs [instr]
loadR RegWithFormat
reg Int
slot = (RA_State freeRegs -> RA_Result freeRegs [instr])
-> RegM freeRegs [instr]
forall freeRegs a.
(RA_State freeRegs -> RA_Result freeRegs a) -> RegM freeRegs a
mkRegM ((RA_State freeRegs -> RA_Result freeRegs [instr])
 -> RegM freeRegs [instr])
-> (RA_State freeRegs -> RA_Result freeRegs [instr])
-> RegM freeRegs [instr]
forall a b. (a -> b) -> a -> b
$ \RA_State freeRegs
s ->
  RA_State freeRegs -> [instr] -> RA_Result freeRegs [instr]
forall a b. a -> b -> (# b, a #)
RA_Result RA_State freeRegs
s (NCGConfig -> RegWithFormat -> Int -> Int -> [instr]
forall instr.
(Instruction instr, HasDebugCallStack) =>
NCGConfig -> RegWithFormat -> Int -> Int -> [instr]
mkLoadInstr (RA_State freeRegs -> NCGConfig
forall freeRegs. RA_State freeRegs -> NCGConfig
ra_config RA_State freeRegs
s) RegWithFormat
reg (RA_State freeRegs -> Int
forall freeRegs. RA_State freeRegs -> Int
ra_delta RA_State freeRegs
s) Int
slot)

getFreeRegsR :: RegM freeRegs freeRegs
getFreeRegsR :: forall freeRegs. RegM freeRegs freeRegs
getFreeRegsR = (RA_State freeRegs -> RA_Result freeRegs freeRegs)
-> RegM freeRegs freeRegs
forall freeRegs a.
(RA_State freeRegs -> RA_Result freeRegs a) -> RegM freeRegs a
mkRegM ((RA_State freeRegs -> RA_Result freeRegs freeRegs)
 -> RegM freeRegs freeRegs)
-> (RA_State freeRegs -> RA_Result freeRegs freeRegs)
-> RegM freeRegs freeRegs
forall a b. (a -> b) -> a -> b
$ \ s :: RA_State freeRegs
s@RA_State{ra_freeregs :: forall freeRegs. RA_State freeRegs -> freeRegs
ra_freeregs = freeRegs
freeregs} ->
  RA_State freeRegs -> freeRegs -> RA_Result freeRegs freeRegs
forall a b. a -> b -> (# b, a #)
RA_Result RA_State freeRegs
s freeRegs
freeregs

setFreeRegsR :: freeRegs -> RegM freeRegs ()
setFreeRegsR :: forall freeRegs. freeRegs -> RegM freeRegs ()
setFreeRegsR freeRegs
regs = (RA_State freeRegs -> RA_Result freeRegs ()) -> RegM freeRegs ()
forall freeRegs a.
(RA_State freeRegs -> RA_Result freeRegs a) -> RegM freeRegs a
mkRegM ((RA_State freeRegs -> RA_Result freeRegs ()) -> RegM freeRegs ())
-> (RA_State freeRegs -> RA_Result freeRegs ()) -> RegM freeRegs ()
forall a b. (a -> b) -> a -> b
$ \ RA_State freeRegs
s ->
  RA_State freeRegs -> () -> RA_Result freeRegs ()
forall a b. a -> b -> (# b, a #)
RA_Result RA_State freeRegs
s{ra_freeregs = regs} ()

getAssigR :: RegM freeRegs (RegMap Loc)
getAssigR :: forall freeRegs. RegM freeRegs (RegMap Loc)
getAssigR = (RA_State freeRegs -> RA_Result freeRegs (RegMap Loc))
-> RegM freeRegs (RegMap Loc)
forall freeRegs a.
(RA_State freeRegs -> RA_Result freeRegs a) -> RegM freeRegs a
mkRegM ((RA_State freeRegs -> RA_Result freeRegs (RegMap Loc))
 -> RegM freeRegs (RegMap Loc))
-> (RA_State freeRegs -> RA_Result freeRegs (RegMap Loc))
-> RegM freeRegs (RegMap Loc)
forall a b. (a -> b) -> a -> b
$ \ s :: RA_State freeRegs
s@RA_State{ra_assig :: forall freeRegs. RA_State freeRegs -> RegMap Loc
ra_assig = RegMap Loc
assig} ->
  RA_State freeRegs -> RegMap Loc -> RA_Result freeRegs (RegMap Loc)
forall a b. a -> b -> (# b, a #)
RA_Result RA_State freeRegs
s RegMap Loc
assig

setAssigR :: RegMap Loc -> RegM freeRegs ()
setAssigR :: forall freeRegs. RegMap Loc -> RegM freeRegs ()
setAssigR RegMap Loc
assig = (RA_State freeRegs -> RA_Result freeRegs ()) -> RegM freeRegs ()
forall freeRegs a.
(RA_State freeRegs -> RA_Result freeRegs a) -> RegM freeRegs a
mkRegM ((RA_State freeRegs -> RA_Result freeRegs ()) -> RegM freeRegs ())
-> (RA_State freeRegs -> RA_Result freeRegs ()) -> RegM freeRegs ()
forall a b. (a -> b) -> a -> b
$ \ RA_State freeRegs
s ->
  RA_State freeRegs -> () -> RA_Result freeRegs ()
forall a b. a -> b -> (# b, a #)
RA_Result RA_State freeRegs
s{ra_assig=assig} ()

getBlockAssigR :: RegM freeRegs (BlockAssignment freeRegs)
getBlockAssigR :: forall freeRegs. RegM freeRegs (BlockAssignment freeRegs)
getBlockAssigR = (RA_State freeRegs
 -> RA_Result freeRegs (BlockAssignment freeRegs))
-> RegM freeRegs (BlockAssignment freeRegs)
forall freeRegs a.
(RA_State freeRegs -> RA_Result freeRegs a) -> RegM freeRegs a
mkRegM ((RA_State freeRegs
  -> RA_Result freeRegs (BlockAssignment freeRegs))
 -> RegM freeRegs (BlockAssignment freeRegs))
-> (RA_State freeRegs
    -> RA_Result freeRegs (BlockAssignment freeRegs))
-> RegM freeRegs (BlockAssignment freeRegs)
forall a b. (a -> b) -> a -> b
$ \ s :: RA_State freeRegs
s@RA_State{ra_blockassig :: forall freeRegs. RA_State freeRegs -> BlockAssignment freeRegs
ra_blockassig = BlockAssignment freeRegs
assig} ->
  RA_State freeRegs
-> BlockAssignment freeRegs
-> RA_Result freeRegs (BlockAssignment freeRegs)
forall a b. a -> b -> (# b, a #)
RA_Result RA_State freeRegs
s BlockAssignment freeRegs
assig

setBlockAssigR :: BlockAssignment freeRegs -> RegM freeRegs ()
setBlockAssigR :: forall freeRegs. BlockAssignment freeRegs -> RegM freeRegs ()
setBlockAssigR BlockAssignment freeRegs
assig = (RA_State freeRegs -> RA_Result freeRegs ()) -> RegM freeRegs ()
forall freeRegs a.
(RA_State freeRegs -> RA_Result freeRegs a) -> RegM freeRegs a
mkRegM ((RA_State freeRegs -> RA_Result freeRegs ()) -> RegM freeRegs ())
-> (RA_State freeRegs -> RA_Result freeRegs ()) -> RegM freeRegs ()
forall a b. (a -> b) -> a -> b
$ \ RA_State freeRegs
s ->
  RA_State freeRegs -> () -> RA_Result freeRegs ()
forall a b. a -> b -> (# b, a #)
RA_Result RA_State freeRegs
s{ra_blockassig = assig} ()

setDeltaR :: Int -> RegM freeRegs ()
setDeltaR :: forall freeRegs. Int -> RegM freeRegs ()
setDeltaR Int
n = (RA_State freeRegs -> RA_Result freeRegs ()) -> RegM freeRegs ()
forall freeRegs a.
(RA_State freeRegs -> RA_Result freeRegs a) -> RegM freeRegs a
mkRegM ((RA_State freeRegs -> RA_Result freeRegs ()) -> RegM freeRegs ())
-> (RA_State freeRegs -> RA_Result freeRegs ()) -> RegM freeRegs ()
forall a b. (a -> b) -> a -> b
$ \ RA_State freeRegs
s ->
  RA_State freeRegs -> () -> RA_Result freeRegs ()
forall a b. a -> b -> (# b, a #)
RA_Result RA_State freeRegs
s{ra_delta = n} ()

getDeltaR :: RegM freeRegs Int
getDeltaR :: forall freeRegs. RegM freeRegs Int
getDeltaR = (RA_State freeRegs -> RA_Result freeRegs Int) -> RegM freeRegs Int
forall freeRegs a.
(RA_State freeRegs -> RA_Result freeRegs a) -> RegM freeRegs a
mkRegM ((RA_State freeRegs -> RA_Result freeRegs Int)
 -> RegM freeRegs Int)
-> (RA_State freeRegs -> RA_Result freeRegs Int)
-> RegM freeRegs Int
forall a b. (a -> b) -> a -> b
$ \RA_State freeRegs
s -> RA_State freeRegs -> Int -> RA_Result freeRegs Int
forall a b. a -> b -> (# b, a #)
RA_Result RA_State freeRegs
s (RA_State freeRegs -> Int
forall freeRegs. RA_State freeRegs -> Int
ra_delta RA_State freeRegs
s)

getUniqueR :: RegM freeRegs Unique
getUniqueR :: forall freeRegs. RegM freeRegs Unique
getUniqueR = (RA_State freeRegs -> RA_Result freeRegs Unique)
-> RegM freeRegs Unique
forall freeRegs a.
(RA_State freeRegs -> RA_Result freeRegs a) -> RegM freeRegs a
mkRegM ((RA_State freeRegs -> RA_Result freeRegs Unique)
 -> RegM freeRegs Unique)
-> (RA_State freeRegs -> RA_Result freeRegs Unique)
-> RegM freeRegs Unique
forall a b. (a -> b) -> a -> b
$ \RA_State freeRegs
s ->
  case DUniqSupply -> (Unique, DUniqSupply)
takeUniqueFromDSupply (RA_State freeRegs -> DUniqSupply
forall freeRegs. RA_State freeRegs -> DUniqSupply
ra_us RA_State freeRegs
s) of
    (Unique
uniq, DUniqSupply
us) -> RA_State freeRegs -> Unique -> RA_Result freeRegs Unique
forall a b. a -> b -> (# b, a #)
RA_Result RA_State freeRegs
s{ra_us = us} Unique
uniq


-- | Record that a spill instruction was inserted, for profiling.
recordSpill :: SpillReason -> RegM freeRegs ()
recordSpill :: forall freeRegs. SpillReason -> RegM freeRegs ()
recordSpill SpillReason
spill
    = (RA_State freeRegs -> RA_Result freeRegs ()) -> RegM freeRegs ()
forall freeRegs a.
(RA_State freeRegs -> RA_Result freeRegs a) -> RegM freeRegs a
mkRegM ((RA_State freeRegs -> RA_Result freeRegs ()) -> RegM freeRegs ())
-> (RA_State freeRegs -> RA_Result freeRegs ()) -> RegM freeRegs ()
forall a b. (a -> b) -> a -> b
$ \RA_State freeRegs
s -> RA_State freeRegs -> () -> RA_Result freeRegs ()
forall a b. a -> b -> (# b, a #)
RA_Result (RA_State freeRegs
s { ra_spills = spill : ra_spills s }) ()

-- | Record a created fixup block
recordFixupBlock :: BlockId -> BlockId -> BlockId -> RegM freeRegs ()
recordFixupBlock :: forall freeRegs. BlockId -> BlockId -> BlockId -> RegM freeRegs ()
recordFixupBlock BlockId
from BlockId
between BlockId
to
    = (RA_State freeRegs -> RA_Result freeRegs ()) -> RegM freeRegs ()
forall freeRegs a.
(RA_State freeRegs -> RA_Result freeRegs a) -> RegM freeRegs a
mkRegM ((RA_State freeRegs -> RA_Result freeRegs ()) -> RegM freeRegs ())
-> (RA_State freeRegs -> RA_Result freeRegs ()) -> RegM freeRegs ()
forall a b. (a -> b) -> a -> b
$ \RA_State freeRegs
s -> RA_State freeRegs -> () -> RA_Result freeRegs ()
forall a b. a -> b -> (# b, a #)
RA_Result (RA_State freeRegs
s { ra_fixups = (from,between,to) : ra_fixups s }) ()