{-# LANGUAGE ScopedTypeVariables #-}

-- | Graph coloring register allocator.
module RegAlloc.Graph.Main (
        regAlloc
) where
import GhcPrelude

import qualified GraphColor as Color
import RegAlloc.Liveness
import RegAlloc.Graph.Spill
import RegAlloc.Graph.SpillClean
import RegAlloc.Graph.SpillCost
import RegAlloc.Graph.Stats
import RegAlloc.Graph.TrivColorable
import Instruction
import TargetReg
import RegClass
import Reg

import Bag
import DynFlags
import Outputable
import Platform
import UniqFM
import UniqSet
import UniqSupply
import Util (seqList)
import CFG

import Data.Maybe
import Control.Monad


-- | The maximum number of build\/spill cycles we'll allow.
--
--   It should only take 3 or 4 cycles for the allocator to converge.
--   If it takes any longer than this it's probably in an infinite loop,
--   so it's better just to bail out and report a bug.
maxSpinCount    :: Int
maxSpinCount :: Int
maxSpinCount    = 10


-- | The top level of the graph coloring register allocator.
regAlloc
        :: (Outputable statics, Outputable instr, Instruction instr)
        => DynFlags
        -> UniqFM (UniqSet RealReg)     -- ^ registers we can use for allocation
        -> UniqSet Int                  -- ^ set of available spill slots.
        -> Int                          -- ^ current number of spill slots
        -> [LiveCmmDecl statics instr]  -- ^ code annotated with liveness information.
        -> Maybe CFG                    -- ^ CFG of basic blocks if available
        -> UniqSM ( [NatCmmDecl statics instr]
                  , Maybe Int, [RegAllocStats statics instr] )
           -- ^ code with registers allocated, additional stacks required
           -- and stats for each stage of allocation

regAlloc :: DynFlags
-> UniqFM (UniqSet RealReg)
-> UniqSet Int
-> Int
-> [LiveCmmDecl statics instr]
-> Maybe CFG
-> UniqSM
     ([NatCmmDecl statics instr], Maybe Int,
      [RegAllocStats statics instr])
regAlloc dflags :: DynFlags
dflags regsFree :: UniqFM (UniqSet RealReg)
regsFree slotsFree :: UniqSet Int
slotsFree slotsCount :: Int
slotsCount code :: [LiveCmmDecl statics instr]
code cfg :: Maybe CFG
cfg
 = do
        -- TODO: the regClass function is currently hard coded to the default
        --       target architecture. Would prefer to determine this from dflags.
        --       There are other uses of targetRegClass later in this module.
        let platform :: Platform
platform = DynFlags -> Platform
targetPlatform DynFlags
dflags
            triv :: Triv VirtualReg RegClass RealReg
triv = Platform
-> (RegClass -> VirtualReg -> Int)
-> (RegClass -> RealReg -> Int)
-> Triv VirtualReg RegClass RealReg
trivColorable Platform
platform
                        (Platform -> RegClass -> VirtualReg -> Int
targetVirtualRegSqueeze Platform
platform)
                        (Platform -> RegClass -> RealReg -> Int
targetRealRegSqueeze Platform
platform)

        (code_final :: [NatCmmDecl statics instr]
code_final, debug_codeGraphs :: [RegAllocStats statics instr]
debug_codeGraphs, slotsCount' :: Int
slotsCount', _)
                <- DynFlags
-> Int
-> Triv VirtualReg RegClass RealReg
-> UniqFM (UniqSet RealReg)
-> UniqSet Int
-> Int
-> [RegAllocStats statics instr]
-> [LiveCmmDecl statics instr]
-> Maybe CFG
-> UniqSM
     ([NatCmmDecl statics instr], [RegAllocStats statics instr], Int,
      Graph VirtualReg RegClass RealReg)
forall instr statics.
(Instruction instr, Outputable instr, Outputable statics) =>
DynFlags
-> Int
-> Triv VirtualReg RegClass RealReg
-> UniqFM (UniqSet RealReg)
-> UniqSet Int
-> Int
-> [RegAllocStats statics instr]
-> [LiveCmmDecl statics instr]
-> Maybe CFG
-> UniqSM
     ([NatCmmDecl statics instr], [RegAllocStats statics instr], Int,
      Graph VirtualReg RegClass RealReg)
regAlloc_spin DynFlags
dflags 0
                        Triv VirtualReg RegClass RealReg
triv
                        UniqFM (UniqSet RealReg)
regsFree UniqSet Int
slotsFree Int
slotsCount [] [LiveCmmDecl statics instr]
code Maybe CFG
cfg

        let needStack :: Maybe Int
needStack
                | Int
slotsCount Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
slotsCount'
                = Maybe Int
forall a. Maybe a
Nothing
                | Bool
otherwise
                = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
slotsCount'

        ([NatCmmDecl statics instr], Maybe Int,
 [RegAllocStats statics instr])
-> UniqSM
     ([NatCmmDecl statics instr], Maybe Int,
      [RegAllocStats statics instr])
forall (m :: * -> *) a. Monad m => a -> m a
return  ( [NatCmmDecl statics instr]
code_final
                , Maybe Int
needStack
                , [RegAllocStats statics instr] -> [RegAllocStats statics instr]
forall a. [a] -> [a]
reverse [RegAllocStats statics instr]
debug_codeGraphs )


-- | Perform solver iterations for the graph coloring allocator.
--
--   We extract a register confict graph from the provided cmm code,
--   and try to colour it. If that works then we use the solution rewrite
--   the code with real hregs. If coloring doesn't work we add spill code
--   and try to colour it again. After `maxSpinCount` iterations we give up.
--
regAlloc_spin
        :: (Instruction instr,
            Outputable instr,
            Outputable statics)
        => DynFlags
        -> Int  -- ^ Number of solver iterations we've already performed.
        -> Color.Triv VirtualReg RegClass RealReg
                -- ^ Function for calculating whether a register is trivially
                --   colourable.
        -> UniqFM (UniqSet RealReg)      -- ^ Free registers that we can allocate.
        -> UniqSet Int                   -- ^ Free stack slots that we can use.
        -> Int                           -- ^ Number of spill slots in use
        -> [RegAllocStats statics instr] -- ^ Current regalloc stats to add to.
        -> [LiveCmmDecl statics instr]   -- ^ Liveness annotated code to allocate.
        -> Maybe CFG
        -> UniqSM ( [NatCmmDecl statics instr]
                  , [RegAllocStats statics instr]
                  , Int                  -- Slots in use
                  , Color.Graph VirtualReg RegClass RealReg)

regAlloc_spin :: DynFlags
-> Int
-> Triv VirtualReg RegClass RealReg
-> UniqFM (UniqSet RealReg)
-> UniqSet Int
-> Int
-> [RegAllocStats statics instr]
-> [LiveCmmDecl statics instr]
-> Maybe CFG
-> UniqSM
     ([NatCmmDecl statics instr], [RegAllocStats statics instr], Int,
      Graph VirtualReg RegClass RealReg)
regAlloc_spin dflags :: DynFlags
dflags spinCount :: Int
spinCount triv :: Triv VirtualReg RegClass RealReg
triv regsFree :: UniqFM (UniqSet RealReg)
regsFree slotsFree :: UniqSet Int
slotsFree slotsCount :: Int
slotsCount debug_codeGraphs :: [RegAllocStats statics instr]
debug_codeGraphs code :: [LiveCmmDecl statics instr]
code cfg :: Maybe CFG
cfg
 = do
        let platform :: Platform
platform = DynFlags -> Platform
targetPlatform DynFlags
dflags

        -- If any of these dump flags are turned on we want to hang on to
        -- intermediate structures in the allocator - otherwise tell the
        -- allocator to ditch them early so we don't end up creating space leaks.
        let dump :: Bool
dump = [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
or
                [ DumpFlag -> DynFlags -> Bool
dopt DumpFlag
Opt_D_dump_asm_regalloc_stages DynFlags
dflags
                , DumpFlag -> DynFlags -> Bool
dopt DumpFlag
Opt_D_dump_asm_stats DynFlags
dflags
                , DumpFlag -> DynFlags -> Bool
dopt DumpFlag
Opt_D_dump_asm_conflicts DynFlags
dflags ]

        -- Check that we're not running off down the garden path.
        Bool -> UniqSM () -> UniqSM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
spinCount Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
maxSpinCount)
         (UniqSM () -> UniqSM ()) -> UniqSM () -> UniqSM ()
forall a b. (a -> b) -> a -> b
$ String -> SDoc -> UniqSM ()
forall a. HasCallStack => String -> SDoc -> a
pprPanic "regAlloc_spin: max build/spill cycle count exceeded."
           (  String -> SDoc
text "It looks like the register allocator is stuck in an infinite loop."
           SDoc -> SDoc -> SDoc
$$ String -> SDoc
text "max cycles  = " SDoc -> SDoc -> SDoc
<> Int -> SDoc
int Int
maxSpinCount
           SDoc -> SDoc -> SDoc
$$ String -> SDoc
text "regsFree    = " SDoc -> SDoc -> SDoc
<> ([SDoc] -> SDoc
hcat ([SDoc] -> SDoc) -> [SDoc] -> SDoc
forall a b. (a -> b) -> a -> b
$ SDoc -> [SDoc] -> [SDoc]
punctuate SDoc
space ([SDoc] -> [SDoc]) -> [SDoc] -> [SDoc]
forall a b. (a -> b) -> a -> b
$ (RealReg -> SDoc) -> [RealReg] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map RealReg -> SDoc
forall a. Outputable a => a -> SDoc
ppr
                                             ([RealReg] -> [SDoc]) -> [RealReg] -> [SDoc]
forall a b. (a -> b) -> a -> b
$ UniqSet RealReg -> [RealReg]
forall elt. UniqSet elt -> [elt]
nonDetEltsUniqSet (UniqSet RealReg -> [RealReg]) -> UniqSet RealReg -> [RealReg]
forall a b. (a -> b) -> a -> b
$ [UniqSet RealReg] -> UniqSet RealReg
forall a. [UniqSet a] -> UniqSet a
unionManyUniqSets
                                             ([UniqSet RealReg] -> UniqSet RealReg)
-> [UniqSet RealReg] -> UniqSet RealReg
forall a b. (a -> b) -> a -> b
$ UniqFM (UniqSet RealReg) -> [UniqSet RealReg]
forall elt. UniqFM elt -> [elt]
nonDetEltsUFM UniqFM (UniqSet RealReg)
regsFree)
              -- This is non-deterministic but we do not
              -- currently support deterministic code-generation.
              -- See Note [Unique Determinism and code generation]
           SDoc -> SDoc -> SDoc
$$ String -> SDoc
text "slotsFree   = " SDoc -> SDoc -> SDoc
<> Int -> SDoc
forall a. Outputable a => a -> SDoc
ppr (UniqSet Int -> Int
forall a. UniqSet a -> Int
sizeUniqSet UniqSet Int
slotsFree))

        -- Build the register conflict graph from the cmm code.
        (Graph VirtualReg RegClass RealReg
graph  :: Color.Graph VirtualReg RegClass RealReg)
                <- {-# SCC "BuildGraph" #-} [LiveCmmDecl statics instr]
-> UniqSM (Graph VirtualReg RegClass RealReg)
forall instr statics.
Instruction instr =>
[LiveCmmDecl statics instr]
-> UniqSM (Graph VirtualReg RegClass RealReg)
buildGraph [LiveCmmDecl statics instr]
code

        -- VERY IMPORTANT:
        --   We really do want the graph to be fully evaluated _before_ we
        --   start coloring. If we don't do this now then when the call to
        --   Color.colorGraph forces bits of it, the heap will be filled with
        --   half evaluated pieces of graph and zillions of apply thunks.
        Graph VirtualReg RegClass RealReg -> ()
seqGraph Graph VirtualReg RegClass RealReg
graph () -> UniqSM () -> UniqSM ()
forall a b. a -> b -> b
`seq` () -> UniqSM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

        -- Build a map of the cost of spilling each instruction.
        -- This is a lazy binding, so the map will only be computed if we
        -- actually have to spill to the stack.
        let spillCosts :: SpillCostInfo
spillCosts  = (SpillCostInfo -> SpillCostInfo -> SpillCostInfo)
-> SpillCostInfo -> [SpillCostInfo] -> SpillCostInfo
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' SpillCostInfo -> SpillCostInfo -> SpillCostInfo
plusSpillCostInfo SpillCostInfo
zeroSpillCostInfo
                        ([SpillCostInfo] -> SpillCostInfo)
-> [SpillCostInfo] -> SpillCostInfo
forall a b. (a -> b) -> a -> b
$ (LiveCmmDecl statics instr -> SpillCostInfo)
-> [LiveCmmDecl statics instr] -> [SpillCostInfo]
forall a b. (a -> b) -> [a] -> [b]
map (Platform -> Maybe CFG -> LiveCmmDecl statics instr -> SpillCostInfo
forall instr statics.
(Outputable instr, Instruction instr) =>
Platform -> Maybe CFG -> LiveCmmDecl statics instr -> SpillCostInfo
slurpSpillCostInfo Platform
platform Maybe CFG
cfg) [LiveCmmDecl statics instr]
code

        -- The function to choose regs to leave uncolored.
        let spill :: Graph VirtualReg RegClass RealReg -> VirtualReg
spill       = SpillCostInfo -> Graph VirtualReg RegClass RealReg -> VirtualReg
chooseSpill SpillCostInfo
spillCosts

        -- Record startup state in our log.
        let stat1 :: Maybe (RegAllocStats statics instr)
stat1
             = if Int
spinCount Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 0
                 then   RegAllocStats statics instr -> Maybe (RegAllocStats statics instr)
forall a. a -> Maybe a
Just (RegAllocStats statics instr
 -> Maybe (RegAllocStats statics instr))
-> RegAllocStats statics instr
-> Maybe (RegAllocStats statics instr)
forall a b. (a -> b) -> a -> b
$ RegAllocStatsStart :: forall statics instr.
[LiveCmmDecl statics instr]
-> Graph VirtualReg RegClass RealReg
-> SpillCostInfo
-> RegAllocStats statics instr
RegAllocStatsStart
                        { raLiveCmm :: [LiveCmmDecl statics instr]
raLiveCmm     = [LiveCmmDecl statics instr]
code
                        , raGraph :: Graph VirtualReg RegClass RealReg
raGraph       = Graph VirtualReg RegClass RealReg
graph
                        , raSpillCosts :: SpillCostInfo
raSpillCosts  = SpillCostInfo
spillCosts }
                 else   Maybe (RegAllocStats statics instr)
forall a. Maybe a
Nothing

        -- Try and color the graph.
        let (graph_colored :: Graph VirtualReg RegClass RealReg
graph_colored, rsSpill :: UniqSet VirtualReg
rsSpill, rmCoalesce :: UniqFM VirtualReg
rmCoalesce)
                = {-# SCC "ColorGraph" #-}
                  Bool
-> Int
-> UniqFM (UniqSet RealReg)
-> Triv VirtualReg RegClass RealReg
-> (Graph VirtualReg RegClass RealReg -> VirtualReg)
-> Graph VirtualReg RegClass RealReg
-> (Graph VirtualReg RegClass RealReg, UniqSet VirtualReg,
    UniqFM VirtualReg)
forall k cls color.
(Uniquable k, Uniquable cls, Uniquable color, Eq cls, Ord k,
 Outputable k, Outputable cls, Outputable color) =>
Bool
-> Int
-> UniqFM (UniqSet color)
-> Triv k cls color
-> (Graph k cls color -> k)
-> Graph k cls color
-> (Graph k cls color, UniqSet k, UniqFM k)
Color.colorGraph
                       (GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_RegsIterative DynFlags
dflags)
                       Int
spinCount
                       UniqFM (UniqSet RealReg)
regsFree Triv VirtualReg RegClass RealReg
triv Graph VirtualReg RegClass RealReg -> VirtualReg
spill Graph VirtualReg RegClass RealReg
graph

        -- Rewrite registers in the code that have been coalesced.
        let patchF :: Reg -> Reg
patchF reg :: Reg
reg
                | RegVirtual vr :: VirtualReg
vr <- Reg
reg
                = case UniqFM VirtualReg -> VirtualReg -> Maybe VirtualReg
forall key elt. Uniquable key => UniqFM elt -> key -> Maybe elt
lookupUFM UniqFM VirtualReg
rmCoalesce VirtualReg
vr of
                        Just vr' :: VirtualReg
vr'        -> Reg -> Reg
patchF (VirtualReg -> Reg
RegVirtual VirtualReg
vr')
                        Nothing         -> Reg
reg

                | Bool
otherwise
                = Reg
reg

        let code_coalesced :: [LiveCmmDecl statics instr]
code_coalesced
                = (LiveCmmDecl statics instr -> LiveCmmDecl statics instr)
-> [LiveCmmDecl statics instr] -> [LiveCmmDecl statics instr]
forall a b. (a -> b) -> [a] -> [b]
map ((Reg -> Reg)
-> LiveCmmDecl statics instr -> LiveCmmDecl statics instr
forall instr statics.
Instruction instr =>
(Reg -> Reg)
-> LiveCmmDecl statics instr -> LiveCmmDecl statics instr
patchEraseLive Reg -> Reg
patchF) [LiveCmmDecl statics instr]
code

        -- Check whether we've found a coloring.
        if UniqSet VirtualReg -> Bool
forall a. UniqSet a -> Bool
isEmptyUniqSet UniqSet VirtualReg
rsSpill

         -- Coloring was successful because no registers needed to be spilled.
         then do
                -- if -fasm-lint is turned on then validate the graph.
                -- This checks for bugs in the graph allocator itself.
                let graph_colored_lint :: Graph VirtualReg RegClass RealReg
graph_colored_lint  =
                        if GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_DoAsmLinting DynFlags
dflags
                                then SDoc
-> Bool
-> Graph VirtualReg RegClass RealReg
-> Graph VirtualReg RegClass RealReg
forall k color cls.
(Uniquable k, Outputable k, Eq color) =>
SDoc -> Bool -> Graph k cls color -> Graph k cls color
Color.validateGraph (String -> SDoc
text "")
                                        Bool
True    -- Require all nodes to be colored.
                                        Graph VirtualReg RegClass RealReg
graph_colored
                                else Graph VirtualReg RegClass RealReg
graph_colored

                -- Rewrite the code to use real hregs, using the colored graph.
                let code_patched :: [LiveCmmDecl statics instr]
code_patched
                        = (LiveCmmDecl statics instr -> LiveCmmDecl statics instr)
-> [LiveCmmDecl statics instr] -> [LiveCmmDecl statics instr]
forall a b. (a -> b) -> [a] -> [b]
map (Platform
-> Graph VirtualReg RegClass RealReg
-> LiveCmmDecl statics instr
-> LiveCmmDecl statics instr
forall statics instr.
(Outputable statics, Outputable instr, Instruction instr) =>
Platform
-> Graph VirtualReg RegClass RealReg
-> LiveCmmDecl statics instr
-> LiveCmmDecl statics instr
patchRegsFromGraph Platform
platform Graph VirtualReg RegClass RealReg
graph_colored_lint)
                              [LiveCmmDecl statics instr]
code_coalesced

                -- Clean out unneeded SPILL/RELOAD meta instructions.
                --   The spill code generator just spills the entire live range
                --   of a vreg, but it might not need to be on the stack for
                --   its entire lifetime.
                let code_spillclean :: [LiveCmmDecl statics instr]
code_spillclean
                        = (LiveCmmDecl statics instr -> LiveCmmDecl statics instr)
-> [LiveCmmDecl statics instr] -> [LiveCmmDecl statics instr]
forall a b. (a -> b) -> [a] -> [b]
map (Platform -> LiveCmmDecl statics instr -> LiveCmmDecl statics instr
forall instr statics.
Instruction instr =>
Platform -> LiveCmmDecl statics instr -> LiveCmmDecl statics instr
cleanSpills Platform
platform) [LiveCmmDecl statics instr]
code_patched

                -- Strip off liveness information from the allocated code.
                -- Also rewrite SPILL/RELOAD meta instructions into real machine
                -- instructions along the way
                let code_final :: [NatCmmDecl statics instr]
code_final
                        = (LiveCmmDecl statics instr -> NatCmmDecl statics instr)
-> [LiveCmmDecl statics instr] -> [NatCmmDecl statics instr]
forall a b. (a -> b) -> [a] -> [b]
map (DynFlags -> LiveCmmDecl statics instr -> NatCmmDecl statics instr
forall statics instr.
(Outputable statics, Outputable instr, Instruction instr) =>
DynFlags -> LiveCmmDecl statics instr -> NatCmmDecl statics instr
stripLive DynFlags
dflags) [LiveCmmDecl statics instr]
code_spillclean

                -- Record what happened in this stage for debugging
                let stat :: RegAllocStats statics instr
stat
                     =  RegAllocStatsColored :: forall statics instr.
[LiveCmmDecl statics instr]
-> Graph VirtualReg RegClass RealReg
-> Graph VirtualReg RegClass RealReg
-> UniqFM VirtualReg
-> [LiveCmmDecl statics instr]
-> [LiveCmmDecl statics instr]
-> [LiveCmmDecl statics instr]
-> [NatCmmDecl statics instr]
-> (Int, Int, Int)
-> RegAllocStats statics instr
RegAllocStatsColored
                        { raCode :: [LiveCmmDecl statics instr]
raCode                = [LiveCmmDecl statics instr]
code
                        , raGraph :: Graph VirtualReg RegClass RealReg
raGraph               = Graph VirtualReg RegClass RealReg
graph
                        , raGraphColored :: Graph VirtualReg RegClass RealReg
raGraphColored        = Graph VirtualReg RegClass RealReg
graph_colored_lint
                        , raCoalesced :: UniqFM VirtualReg
raCoalesced           = UniqFM VirtualReg
rmCoalesce
                        , raCodeCoalesced :: [LiveCmmDecl statics instr]
raCodeCoalesced       = [LiveCmmDecl statics instr]
code_coalesced
                        , raPatched :: [LiveCmmDecl statics instr]
raPatched             = [LiveCmmDecl statics instr]
code_patched
                        , raSpillClean :: [LiveCmmDecl statics instr]
raSpillClean          = [LiveCmmDecl statics instr]
code_spillclean
                        , raFinal :: [NatCmmDecl statics instr]
raFinal               = [NatCmmDecl statics instr]
code_final
                        , raSRMs :: (Int, Int, Int)
raSRMs                = ((Int, Int, Int) -> (Int, Int, Int) -> (Int, Int, Int))
-> (Int, Int, Int) -> [(Int, Int, Int)] -> (Int, Int, Int)
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (Int, Int, Int) -> (Int, Int, Int) -> (Int, Int, Int)
addSRM (0, 0, 0)
                                                ([(Int, Int, Int)] -> (Int, Int, Int))
-> [(Int, Int, Int)] -> (Int, Int, Int)
forall a b. (a -> b) -> a -> b
$ (LiveCmmDecl statics instr -> (Int, Int, Int))
-> [LiveCmmDecl statics instr] -> [(Int, Int, Int)]
forall a b. (a -> b) -> [a] -> [b]
map LiveCmmDecl statics instr -> (Int, Int, Int)
forall instr statics.
Instruction instr =>
LiveCmmDecl statics instr -> (Int, Int, Int)
countSRMs [LiveCmmDecl statics instr]
code_spillclean }

                -- Bundle up all the register allocator statistics.
                --   .. but make sure to drop them on the floor if they're not
                --      needed, otherwise we'll get a space leak.
                let statList :: [RegAllocStats statics instr]
statList =
                        if Bool
dump then [RegAllocStats statics instr
stat] [RegAllocStats statics instr]
-> [RegAllocStats statics instr] -> [RegAllocStats statics instr]
forall a. [a] -> [a] -> [a]
++ Maybe (RegAllocStats statics instr)
-> [RegAllocStats statics instr]
forall a. Maybe a -> [a]
maybeToList Maybe (RegAllocStats statics instr)
stat1 [RegAllocStats statics instr]
-> [RegAllocStats statics instr] -> [RegAllocStats statics instr]
forall a. [a] -> [a] -> [a]
++ [RegAllocStats statics instr]
debug_codeGraphs
                                else []

                -- Ensure all the statistics are evaluated, to avoid space leaks.
                [RegAllocStats statics instr] -> UniqSM () -> UniqSM ()
forall a b. [a] -> b -> b
seqList [RegAllocStats statics instr]
statList (() -> UniqSM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())

                ([NatCmmDecl statics instr], [RegAllocStats statics instr], Int,
 Graph VirtualReg RegClass RealReg)
-> UniqSM
     ([NatCmmDecl statics instr], [RegAllocStats statics instr], Int,
      Graph VirtualReg RegClass RealReg)
forall (m :: * -> *) a. Monad m => a -> m a
return  ( [NatCmmDecl statics instr]
code_final
                        , [RegAllocStats statics instr]
statList
                        , Int
slotsCount
                        , Graph VirtualReg RegClass RealReg
graph_colored_lint)

         -- Coloring was unsuccessful. We need to spill some register to the
         -- stack, make a new graph, and try to color it again.
         else do
                -- if -fasm-lint is turned on then validate the graph
                let graph_colored_lint :: Graph VirtualReg RegClass RealReg
graph_colored_lint  =
                        if GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_DoAsmLinting DynFlags
dflags
                                then SDoc
-> Bool
-> Graph VirtualReg RegClass RealReg
-> Graph VirtualReg RegClass RealReg
forall k color cls.
(Uniquable k, Outputable k, Eq color) =>
SDoc -> Bool -> Graph k cls color -> Graph k cls color
Color.validateGraph (String -> SDoc
text "")
                                        Bool
False   -- don't require nodes to be colored
                                        Graph VirtualReg RegClass RealReg
graph_colored
                                else Graph VirtualReg RegClass RealReg
graph_colored

                -- Spill uncolored regs to the stack.
                (code_spilled :: [LiveCmmDecl statics instr]
code_spilled, slotsFree' :: UniqSet Int
slotsFree', slotsCount' :: Int
slotsCount', spillStats :: SpillStats
spillStats)
                        <- Platform
-> [LiveCmmDecl statics instr]
-> UniqSet Int
-> Int
-> UniqSet VirtualReg
-> UniqSM
     ([LiveCmmDecl statics instr], UniqSet Int, Int, SpillStats)
forall instr statics.
Instruction instr =>
Platform
-> [LiveCmmDecl statics instr]
-> UniqSet Int
-> Int
-> UniqSet VirtualReg
-> UniqSM
     ([LiveCmmDecl statics instr], UniqSet Int, Int, SpillStats)
regSpill Platform
platform [LiveCmmDecl statics instr]
code_coalesced UniqSet Int
slotsFree Int
slotsCount UniqSet VirtualReg
rsSpill

                -- Recalculate liveness information.
                -- NOTE: we have to reverse the SCCs here to get them back into
                --       the reverse-dependency order required by computeLiveness.
                --       If they're not in the correct order that function will panic.
                [LiveCmmDecl statics instr]
code_relive     <- (LiveCmmDecl statics instr -> UniqSM (LiveCmmDecl statics instr))
-> [LiveCmmDecl statics instr]
-> UniqSM [LiveCmmDecl statics instr]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Platform
-> LiveCmmDecl statics instr -> UniqSM (LiveCmmDecl statics instr)
forall instr statics.
(Outputable instr, Instruction instr) =>
Platform
-> LiveCmmDecl statics instr -> UniqSM (LiveCmmDecl statics instr)
regLiveness Platform
platform (LiveCmmDecl statics instr -> UniqSM (LiveCmmDecl statics instr))
-> (LiveCmmDecl statics instr -> LiveCmmDecl statics instr)
-> LiveCmmDecl statics instr
-> UniqSM (LiveCmmDecl statics instr)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LiveCmmDecl statics instr -> LiveCmmDecl statics instr
forall statics instr.
LiveCmmDecl statics instr -> LiveCmmDecl statics instr
reverseBlocksInTops)
                                        [LiveCmmDecl statics instr]
code_spilled

                -- Record what happened in this stage for debugging.
                let stat :: RegAllocStats statics instr
stat        =
                        RegAllocStatsSpill :: forall statics instr.
[LiveCmmDecl statics instr]
-> Graph VirtualReg RegClass RealReg
-> UniqFM VirtualReg
-> SpillStats
-> SpillCostInfo
-> [LiveCmmDecl statics instr]
-> RegAllocStats statics instr
RegAllocStatsSpill
                        { raCode :: [LiveCmmDecl statics instr]
raCode        = [LiveCmmDecl statics instr]
code
                        , raGraph :: Graph VirtualReg RegClass RealReg
raGraph       = Graph VirtualReg RegClass RealReg
graph_colored_lint
                        , raCoalesced :: UniqFM VirtualReg
raCoalesced   = UniqFM VirtualReg
rmCoalesce
                        , raSpillStats :: SpillStats
raSpillStats  = SpillStats
spillStats
                        , raSpillCosts :: SpillCostInfo
raSpillCosts  = SpillCostInfo
spillCosts
                        , raSpilled :: [LiveCmmDecl statics instr]
raSpilled     = [LiveCmmDecl statics instr]
code_spilled }

                -- Bundle up all the register allocator statistics.
                --   .. but make sure to drop them on the floor if they're not
                --      needed, otherwise we'll get a space leak.
                let statList :: [RegAllocStats statics instr]
statList =
                        if Bool
dump
                                then [RegAllocStats statics instr
stat] [RegAllocStats statics instr]
-> [RegAllocStats statics instr] -> [RegAllocStats statics instr]
forall a. [a] -> [a] -> [a]
++ Maybe (RegAllocStats statics instr)
-> [RegAllocStats statics instr]
forall a. Maybe a -> [a]
maybeToList Maybe (RegAllocStats statics instr)
stat1 [RegAllocStats statics instr]
-> [RegAllocStats statics instr] -> [RegAllocStats statics instr]
forall a. [a] -> [a] -> [a]
++ [RegAllocStats statics instr]
debug_codeGraphs
                                else []

                -- Ensure all the statistics are evaluated, to avoid space leaks.
                [RegAllocStats statics instr] -> UniqSM () -> UniqSM ()
forall a b. [a] -> b -> b
seqList [RegAllocStats statics instr]
statList (() -> UniqSM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())

                DynFlags
-> Int
-> Triv VirtualReg RegClass RealReg
-> UniqFM (UniqSet RealReg)
-> UniqSet Int
-> Int
-> [RegAllocStats statics instr]
-> [LiveCmmDecl statics instr]
-> Maybe CFG
-> UniqSM
     ([NatCmmDecl statics instr], [RegAllocStats statics instr], Int,
      Graph VirtualReg RegClass RealReg)
forall instr statics.
(Instruction instr, Outputable instr, Outputable statics) =>
DynFlags
-> Int
-> Triv VirtualReg RegClass RealReg
-> UniqFM (UniqSet RealReg)
-> UniqSet Int
-> Int
-> [RegAllocStats statics instr]
-> [LiveCmmDecl statics instr]
-> Maybe CFG
-> UniqSM
     ([NatCmmDecl statics instr], [RegAllocStats statics instr], Int,
      Graph VirtualReg RegClass RealReg)
regAlloc_spin DynFlags
dflags (Int
spinCount Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1) Triv VirtualReg RegClass RealReg
triv UniqFM (UniqSet RealReg)
regsFree UniqSet Int
slotsFree'
                              Int
slotsCount' [RegAllocStats statics instr]
statList [LiveCmmDecl statics instr]
code_relive Maybe CFG
cfg


-- | Build a graph from the liveness and coalesce information in this code.
buildGraph
        :: Instruction instr
        => [LiveCmmDecl statics instr]
        -> UniqSM (Color.Graph VirtualReg RegClass RealReg)

buildGraph :: [LiveCmmDecl statics instr]
-> UniqSM (Graph VirtualReg RegClass RealReg)
buildGraph code :: [LiveCmmDecl statics instr]
code
 = do
        -- Slurp out the conflicts and reg->reg moves from this code.
        let (conflictList :: [Bag (UniqSet Reg)]
conflictList, moveList :: [Bag (Reg, Reg)]
moveList) =
                [(Bag (UniqSet Reg), Bag (Reg, Reg))]
-> ([Bag (UniqSet Reg)], [Bag (Reg, Reg)])
forall a b. [(a, b)] -> ([a], [b])
unzip ([(Bag (UniqSet Reg), Bag (Reg, Reg))]
 -> ([Bag (UniqSet Reg)], [Bag (Reg, Reg)]))
-> [(Bag (UniqSet Reg), Bag (Reg, Reg))]
-> ([Bag (UniqSet Reg)], [Bag (Reg, Reg)])
forall a b. (a -> b) -> a -> b
$ (LiveCmmDecl statics instr -> (Bag (UniqSet Reg), Bag (Reg, Reg)))
-> [LiveCmmDecl statics instr]
-> [(Bag (UniqSet Reg), Bag (Reg, Reg))]
forall a b. (a -> b) -> [a] -> [b]
map LiveCmmDecl statics instr -> (Bag (UniqSet Reg), Bag (Reg, Reg))
forall instr statics.
Instruction instr =>
LiveCmmDecl statics instr -> (Bag (UniqSet Reg), Bag (Reg, Reg))
slurpConflicts [LiveCmmDecl statics instr]
code

        -- Slurp out the spill/reload coalesces.
        let moveList2 :: [Bag (Reg, Reg)]
moveList2           = (LiveCmmDecl statics instr -> Bag (Reg, Reg))
-> [LiveCmmDecl statics instr] -> [Bag (Reg, Reg)]
forall a b. (a -> b) -> [a] -> [b]
map LiveCmmDecl statics instr -> Bag (Reg, Reg)
forall statics instr.
Instruction instr =>
LiveCmmDecl statics instr -> Bag (Reg, Reg)
slurpReloadCoalesce [LiveCmmDecl statics instr]
code

        -- Add the reg-reg conflicts to the graph.
        let conflictBag :: Bag (UniqSet Reg)
conflictBag         = [Bag (UniqSet Reg)] -> Bag (UniqSet Reg)
forall a. [Bag a] -> Bag a
unionManyBags [Bag (UniqSet Reg)]
conflictList
        let graph_conflict :: Graph VirtualReg RegClass RealReg
graph_conflict
                = (UniqSet Reg
 -> Graph VirtualReg RegClass RealReg
 -> Graph VirtualReg RegClass RealReg)
-> Graph VirtualReg RegClass RealReg
-> Bag (UniqSet Reg)
-> Graph VirtualReg RegClass RealReg
forall a r. (a -> r -> r) -> r -> Bag a -> r
foldrBag UniqSet Reg
-> Graph VirtualReg RegClass RealReg
-> Graph VirtualReg RegClass RealReg
graphAddConflictSet Graph VirtualReg RegClass RealReg
forall k cls color. Graph k cls color
Color.initGraph Bag (UniqSet Reg)
conflictBag

        -- Add the coalescences edges to the graph.
        let moveBag :: Bag (Reg, Reg)
moveBag
                = Bag (Reg, Reg) -> Bag (Reg, Reg) -> Bag (Reg, Reg)
forall a. Bag a -> Bag a -> Bag a
unionBags ([Bag (Reg, Reg)] -> Bag (Reg, Reg)
forall a. [Bag a] -> Bag a
unionManyBags [Bag (Reg, Reg)]
moveList2)
                            ([Bag (Reg, Reg)] -> Bag (Reg, Reg)
forall a. [Bag a] -> Bag a
unionManyBags [Bag (Reg, Reg)]
moveList)

        let graph_coalesce :: Graph VirtualReg RegClass RealReg
graph_coalesce
                = ((Reg, Reg)
 -> Graph VirtualReg RegClass RealReg
 -> Graph VirtualReg RegClass RealReg)
-> Graph VirtualReg RegClass RealReg
-> Bag (Reg, Reg)
-> Graph VirtualReg RegClass RealReg
forall a r. (a -> r -> r) -> r -> Bag a -> r
foldrBag (Reg, Reg)
-> Graph VirtualReg RegClass RealReg
-> Graph VirtualReg RegClass RealReg
graphAddCoalesce Graph VirtualReg RegClass RealReg
graph_conflict Bag (Reg, Reg)
moveBag

        Graph VirtualReg RegClass RealReg
-> UniqSM (Graph VirtualReg RegClass RealReg)
forall (m :: * -> *) a. Monad m => a -> m a
return  Graph VirtualReg RegClass RealReg
graph_coalesce


-- | Add some conflict edges to the graph.
--   Conflicts between virtual and real regs are recorded as exclusions.
graphAddConflictSet
        :: UniqSet Reg
        -> Color.Graph VirtualReg RegClass RealReg
        -> Color.Graph VirtualReg RegClass RealReg

graphAddConflictSet :: UniqSet Reg
-> Graph VirtualReg RegClass RealReg
-> Graph VirtualReg RegClass RealReg
graphAddConflictSet set :: UniqSet Reg
set graph :: Graph VirtualReg RegClass RealReg
graph
 = let  virtuals :: UniqSet VirtualReg
virtuals        = [VirtualReg] -> UniqSet VirtualReg
forall a. Uniquable a => [a] -> UniqSet a
mkUniqSet
                        [ VirtualReg
vr | RegVirtual vr :: VirtualReg
vr <- UniqSet Reg -> [Reg]
forall elt. UniqSet elt -> [elt]
nonDetEltsUniqSet UniqSet Reg
set ]

        graph1 :: Graph VirtualReg RegClass RealReg
graph1  = UniqSet VirtualReg
-> (VirtualReg -> RegClass)
-> Graph VirtualReg RegClass RealReg
-> Graph VirtualReg RegClass RealReg
forall k cls color.
Uniquable k =>
UniqSet k -> (k -> cls) -> Graph k cls color -> Graph k cls color
Color.addConflicts UniqSet VirtualReg
virtuals VirtualReg -> RegClass
classOfVirtualReg Graph VirtualReg RegClass RealReg
graph

        graph2 :: Graph VirtualReg RegClass RealReg
graph2  = ((VirtualReg, RealReg)
 -> Graph VirtualReg RegClass RealReg
 -> Graph VirtualReg RegClass RealReg)
-> Graph VirtualReg RegClass RealReg
-> [(VirtualReg, RealReg)]
-> Graph VirtualReg RegClass RealReg
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\(r1 :: VirtualReg
r1, r2 :: RealReg
r2) -> VirtualReg
-> (VirtualReg -> RegClass)
-> RealReg
-> Graph VirtualReg RegClass RealReg
-> Graph VirtualReg RegClass RealReg
forall k color cls.
(Uniquable k, Uniquable color) =>
k -> (k -> cls) -> color -> Graph k cls color -> Graph k cls color
Color.addExclusion VirtualReg
r1 VirtualReg -> RegClass
classOfVirtualReg RealReg
r2)
                        Graph VirtualReg RegClass RealReg
graph1
                        [ (VirtualReg
vr, RealReg
rr)
                                | RegVirtual vr :: VirtualReg
vr <- UniqSet Reg -> [Reg]
forall elt. UniqSet elt -> [elt]
nonDetEltsUniqSet UniqSet Reg
set
                                , RegReal    rr :: RealReg
rr <- UniqSet Reg -> [Reg]
forall elt. UniqSet elt -> [elt]
nonDetEltsUniqSet UniqSet Reg
set]
                          -- See Note [Unique Determinism and code generation]

   in   Graph VirtualReg RegClass RealReg
graph2


-- | Add some coalesence edges to the graph
--   Coalesences between virtual and real regs are recorded as preferences.
graphAddCoalesce
        :: (Reg, Reg)
        -> Color.Graph VirtualReg RegClass RealReg
        -> Color.Graph VirtualReg RegClass RealReg

graphAddCoalesce :: (Reg, Reg)
-> Graph VirtualReg RegClass RealReg
-> Graph VirtualReg RegClass RealReg
graphAddCoalesce (r1 :: Reg
r1, r2 :: Reg
r2) graph :: Graph VirtualReg RegClass RealReg
graph
        | RegReal rr :: RealReg
rr            <- Reg
r1
        , RegVirtual vr :: VirtualReg
vr         <- Reg
r2
        = (VirtualReg, RegClass)
-> RealReg
-> Graph VirtualReg RegClass RealReg
-> Graph VirtualReg RegClass RealReg
forall k cls color.
Uniquable k =>
(k, cls) -> color -> Graph k cls color -> Graph k cls color
Color.addPreference (VirtualReg
vr, VirtualReg -> RegClass
classOfVirtualReg VirtualReg
vr) RealReg
rr Graph VirtualReg RegClass RealReg
graph

        | RegReal rr :: RealReg
rr            <- Reg
r2
        , RegVirtual vr :: VirtualReg
vr         <- Reg
r1
        = (VirtualReg, RegClass)
-> RealReg
-> Graph VirtualReg RegClass RealReg
-> Graph VirtualReg RegClass RealReg
forall k cls color.
Uniquable k =>
(k, cls) -> color -> Graph k cls color -> Graph k cls color
Color.addPreference (VirtualReg
vr, VirtualReg -> RegClass
classOfVirtualReg VirtualReg
vr) RealReg
rr Graph VirtualReg RegClass RealReg
graph

        | RegVirtual vr1 :: VirtualReg
vr1        <- Reg
r1
        , RegVirtual vr2 :: VirtualReg
vr2        <- Reg
r2
        = (VirtualReg, RegClass)
-> (VirtualReg, RegClass)
-> Graph VirtualReg RegClass RealReg
-> Graph VirtualReg RegClass RealReg
forall k cls color.
Uniquable k =>
(k, cls) -> (k, cls) -> Graph k cls color -> Graph k cls color
Color.addCoalesce
                (VirtualReg
vr1, VirtualReg -> RegClass
classOfVirtualReg VirtualReg
vr1)
                (VirtualReg
vr2, VirtualReg -> RegClass
classOfVirtualReg VirtualReg
vr2)
                Graph VirtualReg RegClass RealReg
graph

        -- We can't coalesce two real regs, but there could well be existing
        --      hreg,hreg moves in the input code. We'll just ignore these
        --      for coalescing purposes.
        | RegReal _             <- Reg
r1
        , RegReal _             <- Reg
r2
        = Graph VirtualReg RegClass RealReg
graph

        | Bool
otherwise
        = String -> Graph VirtualReg RegClass RealReg
forall a. String -> a
panic "graphAddCoalesce"


-- | Patch registers in code using the reg -> reg mapping in this graph.
patchRegsFromGraph
        :: (Outputable statics, Outputable instr, Instruction instr)
        => Platform -> Color.Graph VirtualReg RegClass RealReg
        -> LiveCmmDecl statics instr -> LiveCmmDecl statics instr

patchRegsFromGraph :: Platform
-> Graph VirtualReg RegClass RealReg
-> LiveCmmDecl statics instr
-> LiveCmmDecl statics instr
patchRegsFromGraph platform :: Platform
platform graph :: Graph VirtualReg RegClass RealReg
graph code :: LiveCmmDecl statics instr
code
 = (Reg -> Reg)
-> LiveCmmDecl statics instr -> LiveCmmDecl statics instr
forall instr statics.
Instruction instr =>
(Reg -> Reg)
-> LiveCmmDecl statics instr -> LiveCmmDecl statics instr
patchEraseLive Reg -> Reg
patchF LiveCmmDecl statics instr
code
 where
        -- Function to lookup the hardreg for a virtual reg from the graph.
        patchF :: Reg -> Reg
patchF reg :: Reg
reg
                -- leave real regs alone.
                | RegReal{}     <- Reg
reg
                = Reg
reg

                -- this virtual has a regular node in the graph.
                | RegVirtual vr :: VirtualReg
vr <- Reg
reg
                , Just node :: Node VirtualReg RegClass RealReg
node     <- Graph VirtualReg RegClass RealReg
-> VirtualReg -> Maybe (Node VirtualReg RegClass RealReg)
forall k cls color.
Uniquable k =>
Graph k cls color -> k -> Maybe (Node k cls color)
Color.lookupNode Graph VirtualReg RegClass RealReg
graph VirtualReg
vr
                = case Node VirtualReg RegClass RealReg -> Maybe RealReg
forall k cls color. Node k cls color -> Maybe color
Color.nodeColor Node VirtualReg RegClass RealReg
node of
                        Just color :: RealReg
color      -> RealReg -> Reg
RegReal    RealReg
color
                        Nothing         -> VirtualReg -> Reg
RegVirtual VirtualReg
vr

                -- no node in the graph for this virtual, bad news.
                | Bool
otherwise
                = String -> SDoc -> Reg
forall a. HasCallStack => String -> SDoc -> a
pprPanic "patchRegsFromGraph: register mapping failed."
                        (  String -> SDoc
text "There is no node in the graph for register "
                                SDoc -> SDoc -> SDoc
<> Reg -> SDoc
forall a. Outputable a => a -> SDoc
ppr Reg
reg
                        SDoc -> SDoc -> SDoc
$$ LiveCmmDecl statics instr -> SDoc
forall a. Outputable a => a -> SDoc
ppr LiveCmmDecl statics instr
code
                        SDoc -> SDoc -> SDoc
$$ (RealReg -> SDoc)
-> Triv VirtualReg RegClass RealReg
-> Graph VirtualReg RegClass RealReg
-> SDoc
forall k cls color.
(Uniquable k, Outputable k, Outputable cls, Outputable color) =>
(color -> SDoc) -> Triv k cls color -> Graph k cls color -> SDoc
Color.dotGraph
                                (\_ -> String -> SDoc
text "white")
                                (Platform
-> (RegClass -> VirtualReg -> Int)
-> (RegClass -> RealReg -> Int)
-> Triv VirtualReg RegClass RealReg
trivColorable Platform
platform
                                        (Platform -> RegClass -> VirtualReg -> Int
targetVirtualRegSqueeze Platform
platform)
                                        (Platform -> RegClass -> RealReg -> Int
targetRealRegSqueeze Platform
platform))
                                Graph VirtualReg RegClass RealReg
graph)


-----
-- for when laziness just isn't what you wanted...
--  We need to deepSeq the whole graph before trying to colour it to avoid
--  space leaks.
seqGraph :: Color.Graph VirtualReg RegClass RealReg -> ()
seqGraph :: Graph VirtualReg RegClass RealReg -> ()
seqGraph graph :: Graph VirtualReg RegClass RealReg
graph          = [Node VirtualReg RegClass RealReg] -> ()
seqNodes (UniqFM (Node VirtualReg RegClass RealReg)
-> [Node VirtualReg RegClass RealReg]
forall elt. UniqFM elt -> [elt]
nonDetEltsUFM (Graph VirtualReg RegClass RealReg
-> UniqFM (Node VirtualReg RegClass RealReg)
forall k cls color. Graph k cls color -> UniqFM (Node k cls color)
Color.graphMap Graph VirtualReg RegClass RealReg
graph))
   -- See Note [Unique Determinism and code generation]

seqNodes :: [Color.Node VirtualReg RegClass RealReg] -> ()
seqNodes :: [Node VirtualReg RegClass RealReg] -> ()
seqNodes ns :: [Node VirtualReg RegClass RealReg]
ns
 = case [Node VirtualReg RegClass RealReg]
ns of
        []              -> ()
        (n :: Node VirtualReg RegClass RealReg
n : ns :: [Node VirtualReg RegClass RealReg]
ns)        -> Node VirtualReg RegClass RealReg -> ()
seqNode Node VirtualReg RegClass RealReg
n () -> () -> ()
forall a b. a -> b -> b
`seq` [Node VirtualReg RegClass RealReg] -> ()
seqNodes [Node VirtualReg RegClass RealReg]
ns

seqNode :: Color.Node VirtualReg RegClass RealReg -> ()
seqNode :: Node VirtualReg RegClass RealReg -> ()
seqNode node :: Node VirtualReg RegClass RealReg
node
        =     VirtualReg -> ()
seqVirtualReg     (Node VirtualReg RegClass RealReg -> VirtualReg
forall k cls color. Node k cls color -> k
Color.nodeId Node VirtualReg RegClass RealReg
node)
        () -> () -> ()
forall a b. a -> b -> b
`seq` RegClass -> ()
seqRegClass       (Node VirtualReg RegClass RealReg -> RegClass
forall k cls color. Node k cls color -> cls
Color.nodeClass Node VirtualReg RegClass RealReg
node)
        () -> () -> ()
forall a b. a -> b -> b
`seq` Maybe RealReg -> ()
seqMaybeRealReg   (Node VirtualReg RegClass RealReg -> Maybe RealReg
forall k cls color. Node k cls color -> Maybe color
Color.nodeColor Node VirtualReg RegClass RealReg
node)
        () -> () -> ()
forall a b. a -> b -> b
`seq` ([VirtualReg] -> ()
seqVirtualRegList (UniqSet VirtualReg -> [VirtualReg]
forall elt. UniqSet elt -> [elt]
nonDetEltsUniqSet (Node VirtualReg RegClass RealReg -> UniqSet VirtualReg
forall k cls color. Node k cls color -> UniqSet k
Color.nodeConflicts Node VirtualReg RegClass RealReg
node)))
        () -> () -> ()
forall a b. a -> b -> b
`seq` ([RealReg] -> ()
seqRealRegList    (UniqSet RealReg -> [RealReg]
forall elt. UniqSet elt -> [elt]
nonDetEltsUniqSet (Node VirtualReg RegClass RealReg -> UniqSet RealReg
forall k cls color. Node k cls color -> UniqSet color
Color.nodeExclusions Node VirtualReg RegClass RealReg
node)))
        () -> () -> ()
forall a b. a -> b -> b
`seq` ([RealReg] -> ()
seqRealRegList (Node VirtualReg RegClass RealReg -> [RealReg]
forall k cls color. Node k cls color -> [color]
Color.nodePreference Node VirtualReg RegClass RealReg
node))
        () -> () -> ()
forall a b. a -> b -> b
`seq` ([VirtualReg] -> ()
seqVirtualRegList (UniqSet VirtualReg -> [VirtualReg]
forall elt. UniqSet elt -> [elt]
nonDetEltsUniqSet (Node VirtualReg RegClass RealReg -> UniqSet VirtualReg
forall k cls color. Node k cls color -> UniqSet k
Color.nodeCoalesce Node VirtualReg RegClass RealReg
node)))
              -- It's OK to use nonDetEltsUniqSet for seq

seqVirtualReg :: VirtualReg -> ()
seqVirtualReg :: VirtualReg -> ()
seqVirtualReg reg :: VirtualReg
reg = VirtualReg
reg VirtualReg -> () -> ()
forall a b. a -> b -> b
`seq` ()

seqRealReg :: RealReg -> ()
seqRealReg :: RealReg -> ()
seqRealReg reg :: RealReg
reg = RealReg
reg RealReg -> () -> ()
forall a b. a -> b -> b
`seq` ()

seqRegClass :: RegClass -> ()
seqRegClass :: RegClass -> ()
seqRegClass c :: RegClass
c = RegClass
c RegClass -> () -> ()
forall a b. a -> b -> b
`seq` ()

seqMaybeRealReg :: Maybe RealReg -> ()
seqMaybeRealReg :: Maybe RealReg -> ()
seqMaybeRealReg mr :: Maybe RealReg
mr
 = case Maybe RealReg
mr of
        Nothing         -> ()
        Just r :: RealReg
r          -> RealReg -> ()
seqRealReg RealReg
r

seqVirtualRegList :: [VirtualReg] -> ()
seqVirtualRegList :: [VirtualReg] -> ()
seqVirtualRegList rs :: [VirtualReg]
rs
 = case [VirtualReg]
rs of
        []              -> ()
        (r :: VirtualReg
r : rs :: [VirtualReg]
rs)        -> VirtualReg -> ()
seqVirtualReg VirtualReg
r () -> () -> ()
forall a b. a -> b -> b
`seq` [VirtualReg] -> ()
seqVirtualRegList [VirtualReg]
rs

seqRealRegList :: [RealReg] -> ()
seqRealRegList :: [RealReg] -> ()
seqRealRegList rs :: [RealReg]
rs
 = case [RealReg]
rs of
        []              -> ()
        (r :: RealReg
r : rs :: [RealReg]
rs)        -> RealReg -> ()
seqRealReg RealReg
r () -> () -> ()
forall a b. a -> b -> b
`seq` [RealReg] -> ()
seqRealRegList [RealReg]
rs