    {-# LANGUAGE RecordWildCards #-}

    -- | Put common type definitions here to break recursive module dependencies.

    module GHC.CmmToAsm.Reg.Linear.Base (
            BlockAssignment,
            lookupBlockAssignment,
            lookupFirstUsed,
            emptyBlockAssignment,
            updateBlockAssignment,

            Loc(..),
            regsOfLoc,
            RealRegUsage(..),

            -- for stats
            SpillReason(..),
            RegAllocStats(..),

            -- the allocator monad
            RA_State(..),
    )

    where

    import GHC.Prelude

    import GHC.CmmToAsm.Reg.Linear.StackMap
    import GHC.CmmToAsm.Reg.Liveness
    import GHC.CmmToAsm.Config
    import GHC.Platform.Reg

    import GHC.Utils.Outputable
    import GHC.Types.Unique
    import GHC.Types.Unique.FM
    import GHC.Types.Unique.DSM
    import GHC.Cmm.BlockId
    import GHC.Cmm.Dataflow.Label
    import GHC.CmmToAsm.Reg.Utils
    import GHC.CmmToAsm.Format

    import Data.Function ( on )

    data ReadingOrWriting = Reading | Writing deriving (ReadingOrWriting -> ReadingOrWriting -> Bool
    (ReadingOrWriting -> ReadingOrWriting -> Bool)
    -> (ReadingOrWriting -> ReadingOrWriting -> Bool)
    -> Eq ReadingOrWriting
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: ReadingOrWriting -> ReadingOrWriting -> Bool
    == :: ReadingOrWriting -> ReadingOrWriting -> Bool
    $c/= :: ReadingOrWriting -> ReadingOrWriting -> Bool
    /= :: ReadingOrWriting -> ReadingOrWriting -> Bool
    Eq,Eq ReadingOrWriting
    Eq ReadingOrWriting =>
    (ReadingOrWriting -> ReadingOrWriting -> Ordering)
    -> (ReadingOrWriting -> ReadingOrWriting -> Bool)
    -> (ReadingOrWriting -> ReadingOrWriting -> Bool)
    -> (ReadingOrWriting -> ReadingOrWriting -> Bool)
    -> (ReadingOrWriting -> ReadingOrWriting -> Bool)
    -> (ReadingOrWriting -> ReadingOrWriting -> ReadingOrWriting)
    -> (ReadingOrWriting -> ReadingOrWriting -> ReadingOrWriting)
    -> Ord ReadingOrWriting
    ReadingOrWriting -> ReadingOrWriting -> Bool
    ReadingOrWriting -> ReadingOrWriting -> Ordering
    ReadingOrWriting -> ReadingOrWriting -> ReadingOrWriting
    forall a.
    Eq a =>
    (a -> a -> Ordering)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> a)
    -> (a -> a -> a)
    -> Ord a
    $ccompare :: ReadingOrWriting -> ReadingOrWriting -> Ordering
    compare :: ReadingOrWriting -> ReadingOrWriting -> Ordering
    $c< :: ReadingOrWriting -> ReadingOrWriting -> Bool
    < :: ReadingOrWriting -> ReadingOrWriting -> Bool
    $c<= :: ReadingOrWriting -> ReadingOrWriting -> Bool
    <= :: ReadingOrWriting -> ReadingOrWriting -> Bool
    $c> :: ReadingOrWriting -> ReadingOrWriting -> Bool
    > :: ReadingOrWriting -> ReadingOrWriting -> Bool
    $c>= :: ReadingOrWriting -> ReadingOrWriting -> Bool
    >= :: ReadingOrWriting -> ReadingOrWriting -> Bool
    $cmax :: ReadingOrWriting -> ReadingOrWriting -> ReadingOrWriting
    max :: ReadingOrWriting -> ReadingOrWriting -> ReadingOrWriting
    $cmin :: ReadingOrWriting -> ReadingOrWriting -> ReadingOrWriting
    min :: ReadingOrWriting -> ReadingOrWriting -> ReadingOrWriting
    Ord)

    -- | Used to store the register assignment on entry to a basic block.
    --      We use this to handle join points, where multiple branch instructions
    --      target a particular label. We have to insert fixup code to make
    --      the register assignments from the different sources match up.
    --
    data BlockAssignment freeRegs
            = BlockAssignment { forall freeRegs.
    BlockAssignment freeRegs -> BlockMap (freeRegs, RegMap Loc)
    blockMap :: !(BlockMap (freeRegs, RegMap Loc))
                              , forall freeRegs.
    BlockAssignment freeRegs -> UniqFM VirtualReg RealReg
    firstUsed :: !(UniqFM VirtualReg RealReg) }

    -- | Find the register mapping for a specific BlockId.
    lookupBlockAssignment :: BlockId -> BlockAssignment freeRegs -> Maybe (freeRegs, RegMap Loc)
    lookupBlockAssignment :: forall freeRegs.
    BlockId -> BlockAssignment freeRegs -> Maybe (freeRegs, RegMap Loc)
    lookupBlockAssignment BlockId
    bid BlockAssignment freeRegs
    ba = BlockId
    -> LabelMap (freeRegs, RegMap Loc) -> Maybe (freeRegs, RegMap Loc)
    forall a. BlockId -> LabelMap a -> Maybe a
    mapLookup BlockId
    bid (BlockAssignment freeRegs -> LabelMap (freeRegs, RegMap Loc)
    forall freeRegs.
    BlockAssignment freeRegs -> BlockMap (freeRegs, RegMap Loc)
    blockMap BlockAssignment freeRegs
    ba)

    -- | Lookup which register a virtual register was first assigned to.
    lookupFirstUsed :: VirtualReg -> BlockAssignment freeRegs -> Maybe RealReg
    lookupFirstUsed :: forall freeRegs.
    VirtualReg -> BlockAssignment freeRegs -> Maybe RealReg
    lookupFirstUsed VirtualReg
    vr BlockAssignment freeRegs
    ba = UniqFM VirtualReg RealReg -> VirtualReg -> Maybe RealReg
    forall key elt. Uniquable key => UniqFM key elt -> key -> Maybe elt
    lookupUFM (BlockAssignment freeRegs -> UniqFM VirtualReg RealReg
    forall freeRegs.
    BlockAssignment freeRegs -> UniqFM VirtualReg RealReg
    firstUsed BlockAssignment freeRegs
    ba) VirtualReg
    vr

    -- | An initial empty 'BlockAssignment'
    emptyBlockAssignment :: BlockAssignment freeRegs
    emptyBlockAssignment :: forall freeRegs. BlockAssignment freeRegs
    emptyBlockAssignment = BlockMap (freeRegs, RegMap Loc)
    -> UniqFM VirtualReg RealReg -> BlockAssignment freeRegs
    forall freeRegs.
    BlockMap (freeRegs, RegMap Loc)
    -> UniqFM VirtualReg RealReg -> BlockAssignment freeRegs
    BlockAssignment BlockMap (freeRegs, RegMap Loc)
    forall v. LabelMap v
    mapEmpty UniqFM VirtualReg RealReg
    forall a. Monoid a => a
    mempty

    -- | Add new register mappings for a specific block.
    updateBlockAssignment :: BlockId
      -> (freeRegs, RegMap Loc)
      -> BlockAssignment freeRegs
      -> BlockAssignment freeRegs
    updateBlockAssignment :: forall freeRegs.
    BlockId
    -> (freeRegs, RegMap Loc)
    -> BlockAssignment freeRegs
    -> BlockAssignment freeRegs
    updateBlockAssignment BlockId
    dest (freeRegs
    freeRegs, RegMap Loc
    regMap) (BlockAssignment {UniqFM VirtualReg RealReg
    BlockMap (freeRegs, RegMap Loc)
    blockMap :: forall freeRegs.
    BlockAssignment freeRegs -> BlockMap (freeRegs, RegMap Loc)
    firstUsed :: forall freeRegs.
    BlockAssignment freeRegs -> UniqFM VirtualReg RealReg
    blockMap :: BlockMap (freeRegs, RegMap Loc)
    firstUsed :: UniqFM VirtualReg RealReg
    ..}) =
      BlockMap (freeRegs, RegMap Loc)
    -> UniqFM VirtualReg RealReg -> BlockAssignment freeRegs
    forall freeRegs.
    BlockMap (freeRegs, RegMap Loc)
    -> UniqFM VirtualReg RealReg -> BlockAssignment freeRegs
    BlockAssignment (BlockId
    -> (freeRegs, RegMap Loc)
    -> BlockMap (freeRegs, RegMap Loc)
    -> BlockMap (freeRegs, RegMap Loc)
    forall v. BlockId -> v -> LabelMap v -> LabelMap v
    mapInsert BlockId
    dest (freeRegs
    freeRegs, RegMap Loc
    regMap) BlockMap (freeRegs, RegMap Loc)
    blockMap)
                      ((RealReg -> Loc -> Maybe RealReg)
    -> (UniqFM VirtualReg RealReg -> UniqFM VirtualReg RealReg)
    -> (UniqFM VirtualReg Loc -> UniqFM VirtualReg RealReg)
    -> UniqFM VirtualReg RealReg
    -> UniqFM VirtualReg Loc
    -> UniqFM VirtualReg RealReg
    forall {k} elta eltb eltc (key :: k).
    (elta -> eltb -> Maybe eltc)
    -> (UniqFM key elta -> UniqFM key eltc)
    -> (UniqFM key eltb -> UniqFM key eltc)
    -> UniqFM key elta
    -> UniqFM key eltb
    -> UniqFM key eltc
    mergeUFM RealReg -> Loc -> Maybe RealReg
    combWithExisting UniqFM VirtualReg RealReg -> UniqFM VirtualReg RealReg
    forall a. a -> a
    id ((Loc -> Maybe RealReg)
    -> UniqFM VirtualReg Loc -> UniqFM VirtualReg RealReg
    forall {k} elt1 elt2 (key :: k).
    (elt1 -> Maybe elt2) -> UniqFM key elt1 -> UniqFM key elt2
    mapMaybeUFM Loc -> Maybe RealReg
    fromLoc) (UniqFM VirtualReg RealReg
    firstUsed) (RegMap Loc -> UniqFM VirtualReg Loc
    forall elt. UniqFM Reg elt -> UniqFM VirtualReg elt
    toVRegMap RegMap Loc
    regMap))
      where
        -- The blocks are processed in dependency order, so if there's already an
        -- entry in the map then keep that assignment rather than writing the new
        -- assignment.
        combWithExisting :: RealReg -> Loc -> Maybe RealReg
        combWithExisting :: RealReg -> Loc -> Maybe RealReg
    combWithExisting RealReg
    old_reg Loc
    _ = RealReg -> Maybe RealReg
    forall a. a -> Maybe a
    Just (RealReg -> Maybe RealReg) -> RealReg -> Maybe RealReg
    forall a b. (a -> b) -> a -> b
    $ RealReg
    old_reg

        fromLoc :: Loc -> Maybe RealReg
        fromLoc :: Loc -> Maybe RealReg
    fromLoc (InReg RealRegUsage
    rr) = RealReg -> Maybe RealReg
    forall a. a -> Maybe a
    Just (RealReg -> Maybe RealReg) -> RealReg -> Maybe RealReg
    forall a b. (a -> b) -> a -> b
    $ RealRegUsage -> RealReg
    realReg RealRegUsage
    rr
        fromLoc (InBoth RealRegUsage
    rr StackSlot
    _) = RealReg -> Maybe RealReg
    forall a. a -> Maybe a
    Just (RealReg -> Maybe RealReg) -> RealReg -> Maybe RealReg
    forall a b. (a -> b) -> a -> b
    $ RealRegUsage -> RealReg
    realReg RealRegUsage
    rr
        fromLoc Loc
    _ = Maybe RealReg
    forall a. Maybe a
    Nothing

    -- | Where a vreg is currently stored
    --      A temporary can be marked as living in both a register and memory
    --      (InBoth), for example if it was recently loaded from a spill location.
    --      This makes it cheap to spill (no save instruction required), but we
    --      have to be careful to turn this into InReg if the value in the
    --      register is changed.

    --      This is also useful when a temporary is about to be clobbered.  We
    --      save it in a spill location, but mark it as InBoth because the current
    --      instruction might still want to read it.
    --
    data Loc
            -- | vreg is in a register
            = InReg   {-# UNPACK #-} !RealRegUsage

            -- | vreg is held in stack slots
            | InMem   {-# UNPACK #-}  !StackSlot

            -- | vreg is held in both a register and stack slots
            | InBoth   {-# UNPACK #-} !RealRegUsage
                       {-# UNPACK #-} !StackSlot
            deriving (Loc -> Loc -> Bool
    (Loc -> Loc -> Bool) -> (Loc -> Loc -> Bool) -> Eq Loc
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: Loc -> Loc -> Bool
    == :: Loc -> Loc -> Bool
    $c/= :: Loc -> Loc -> Bool
    /= :: Loc -> Loc -> Bool
    Eq, Eq Loc
    Eq Loc =>
    (Loc -> Loc -> Ordering)
    -> (Loc -> Loc -> Bool)
    -> (Loc -> Loc -> Bool)
    -> (Loc -> Loc -> Bool)
    -> (Loc -> Loc -> Bool)
    -> (Loc -> Loc -> Loc)
    -> (Loc -> Loc -> Loc)
    -> Ord Loc
    Loc -> Loc -> Bool
    Loc -> Loc -> Ordering
    Loc -> Loc -> Loc
    forall a.
    Eq a =>
    (a -> a -> Ordering)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> a)
    -> (a -> a -> a)
    -> Ord a
    $ccompare :: Loc -> Loc -> Ordering
    compare :: Loc -> Loc -> Ordering
    $c< :: Loc -> Loc -> Bool
    < :: Loc -> Loc -> Bool
    $c<= :: Loc -> Loc -> Bool
    <= :: Loc -> Loc -> Bool
    $c> :: Loc -> Loc -> Bool
    > :: Loc -> Loc -> Bool
    $c>= :: Loc -> Loc -> Bool
    >= :: Loc -> Loc -> Bool
    $cmax :: Loc -> Loc -> Loc
    max :: Loc -> Loc -> Loc
    $cmin :: Loc -> Loc -> Loc
    min :: Loc -> Loc -> Loc
    Ord, StackSlot -> Loc -> ShowS
    [Loc] -> ShowS
    Loc -> String
    (StackSlot -> Loc -> ShowS)
    -> (Loc -> String) -> ([Loc] -> ShowS) -> Show Loc
    forall a.
    (StackSlot -> a -> ShowS)
    -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: StackSlot -> Loc -> ShowS
    showsPrec :: StackSlot -> Loc -> ShowS
    $cshow :: Loc -> String
    show :: Loc -> String
    $cshowList :: [Loc] -> ShowS
    showList :: [Loc] -> ShowS
    Show)

    instance Outputable Loc where
            ppr :: Loc -> SDoc
    ppr Loc
    l = String -> SDoc
    forall doc. IsLine doc => String -> doc
    text (Loc -> String
    forall a. Show a => a -> String
    show Loc
    l)

    -- | A 'RealReg', together with the specific 'Format' it is used at.
    data RealRegUsage
      = RealRegUsage
        { RealRegUsage -> RealReg
    realReg :: !RealReg
        , RealRegUsage -> Format
    realRegFormat :: !Format
        } deriving StackSlot -> RealRegUsage -> ShowS
    [RealRegUsage] -> ShowS
    RealRegUsage -> String
    (StackSlot -> RealRegUsage -> ShowS)
    -> (RealRegUsage -> String)
    -> ([RealRegUsage] -> ShowS)
    -> Show RealRegUsage
    forall a.
    (StackSlot -> a -> ShowS)
    -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: StackSlot -> RealRegUsage -> ShowS
    showsPrec :: StackSlot -> RealRegUsage -> ShowS
    $cshow :: RealRegUsage -> String
    show :: RealRegUsage -> String
    $cshowList :: [RealRegUsage] -> ShowS
    showList :: [RealRegUsage] -> ShowS
    Show

    instance Outputable RealRegUsage where
      ppr :: RealRegUsage -> SDoc
    ppr (RealRegUsage RealReg
    r Format
    fmt) = RealReg -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr RealReg
    r SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <> SDoc
    dcolon SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> Format -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Format
    fmt

    -- NB: these instances only compare the underlying 'RealReg', as that is what
    -- is important for register allocation.
    --
    -- (It would nonetheless be a good idea to remove these instances.)
    instance Eq RealRegUsage where
      == :: RealRegUsage -> RealRegUsage -> Bool
    (==) = RealReg -> RealReg -> Bool
    forall a. Eq a => a -> a -> Bool
    (==) (RealReg -> RealReg -> Bool)
    -> (RealRegUsage -> RealReg)
    -> RealRegUsage
    -> RealRegUsage
    -> Bool
    forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
    `on` RealRegUsage -> RealReg
    realReg
    instance Ord RealRegUsage where
      compare :: RealRegUsage -> RealRegUsage -> Ordering
    compare = RealReg -> RealReg -> Ordering
    forall a. Ord a => a -> a -> Ordering
    compare (RealReg -> RealReg -> Ordering)
    -> (RealRegUsage -> RealReg)
    -> RealRegUsage
    -> RealRegUsage
    -> Ordering
    forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
    `on` RealRegUsage -> RealReg
    realReg

    -- | Get the reg numbers stored in this Loc.
    regsOfLoc :: Loc -> [RealRegUsage]
    regsOfLoc :: Loc -> [RealRegUsage]
    regsOfLoc (InReg RealRegUsage
    r)    = [RealRegUsage
    r]
    regsOfLoc (InBoth RealRegUsage
    r StackSlot
    _) = [RealRegUsage
    r]
    regsOfLoc (InMem StackSlot
    _)    = []

    -- | Reasons why instructions might be inserted by the spiller.
    --      Used when generating stats for -ddrop-asm-stats.
    --
    data SpillReason
            -- | vreg was spilled to a slot so we could use its
            --      current hreg for another vreg
            = SpillAlloc    !Unique

            -- | vreg was moved because its hreg was clobbered
            | SpillClobber  !Unique

            -- | vreg was loaded from a spill slot
            | SpillLoad     !Unique

            -- | reg-reg move inserted during join to targets
            | SpillJoinRR   !Unique

            -- | reg-mem move inserted during join to targets
            | SpillJoinRM   !Unique

    -- | Used to carry interesting stats out of the register allocator.
    data RegAllocStats
            = RegAllocStats
            { RegAllocStats -> UniqFM Unique [StackSlot]
    ra_spillInstrs        :: UniqFM Unique [Int] -- Keys are the uniques of regs
                                                           -- and taken from SpillReason
                                                           -- See Note [UniqFM and the register allocator]
            , RegAllocStats -> [(BlockId, BlockId, BlockId)]
    ra_fixupList     :: [(BlockId,BlockId,BlockId)]
            -- ^ (from,fixup,to) : We inserted fixup code between from and to
            }

    -- | The register allocator state
    data RA_State freeRegs
            = RA_State

            {
            -- | the current mapping from basic blocks to
            --      the register assignments at the beginning of that block.
              forall freeRegs. RA_State freeRegs -> BlockAssignment freeRegs
    ra_blockassig :: BlockAssignment freeRegs

            -- | free machine registers
            , forall freeRegs. RA_State freeRegs -> freeRegs
    ra_freeregs   :: !freeRegs

            -- | assignment of temps to locations
            , forall freeRegs. RA_State freeRegs -> RegMap Loc
    ra_assig      :: RegMap Loc

            -- | current stack delta
            , forall freeRegs. RA_State freeRegs -> StackSlot
    ra_delta      :: Int

            -- | free stack slots for spilling
            , forall freeRegs. RA_State freeRegs -> StackMap
    ra_stack      :: StackMap

            -- | unique supply for generating names for join point fixup blocks.
            , forall freeRegs. RA_State freeRegs -> DUniqSupply
    ra_us         :: DUniqSupply

            -- | Record why things were spilled, for -ddrop-asm-stats.
            --      Just keep a list here instead of a map of regs -> reasons.
            --      We don't want to slow down the allocator if we're not going to emit the stats.
            , forall freeRegs. RA_State freeRegs -> [SpillReason]
    ra_spills     :: [SpillReason]

            -- | Native code generator configuration
            , forall freeRegs. RA_State freeRegs -> NCGConfig
    ra_config     :: !NCGConfig

            -- | (from,fixup,to) : We inserted fixup code between from and to
            , forall freeRegs. RA_State freeRegs -> [(BlockId, BlockId, BlockId)]
    ra_fixups     :: [(BlockId,BlockId,BlockId)]

            }