module RegAlloc.Linear.StackMap (
StackSlot,
StackMap(..),
emptyStackMap,
getStackSlotFor,
getStackUse
)
where
import GhcPrelude
import DynFlags
import UniqFM
import Unique
type StackSlot = Int
data StackMap
= StackMap
{
StackMap -> Int
stackMapNextFreeSlot :: !Int
, StackMap -> UniqFM Int
stackMapAssignment :: UniqFM StackSlot }
emptyStackMap :: DynFlags -> StackMap
emptyStackMap :: DynFlags -> StackMap
emptyStackMap DynFlags
_ = Int -> UniqFM Int -> StackMap
StackMap Int
0 UniqFM Int
forall elt. UniqFM elt
emptyUFM
getStackSlotFor :: StackMap -> Unique -> (StackMap, Int)
getStackSlotFor :: StackMap -> Unique -> (StackMap, Int)
getStackSlotFor fs :: StackMap
fs@(StackMap Int
_ UniqFM Int
reserved) Unique
reg
| Just Int
slot <- UniqFM Int -> Unique -> Maybe Int
forall key elt. Uniquable key => UniqFM elt -> key -> Maybe elt
lookupUFM UniqFM Int
reserved Unique
reg = (StackMap
fs, Int
slot)
getStackSlotFor (StackMap Int
freeSlot UniqFM Int
reserved) Unique
reg =
(Int -> UniqFM Int -> StackMap
StackMap (Int
freeSlotInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) (UniqFM Int -> Unique -> Int -> UniqFM Int
forall key elt.
Uniquable key =>
UniqFM elt -> key -> elt -> UniqFM elt
addToUFM UniqFM Int
reserved Unique
reg Int
freeSlot), Int
freeSlot)
getStackUse :: StackMap -> Int
getStackUse :: StackMap -> Int
getStackUse (StackMap Int
freeSlot UniqFM Int
_) = Int
freeSlot