    module GHC.CmmToAsm.Reg.Linear.Stats (
            binSpillReasons,
            countRegRegMovesNat,
            pprStats
    )

    where

    import GHC.Prelude

    import GHC.CmmToAsm.Reg.Linear.Base
    import GHC.CmmToAsm.Reg.Liveness
    import GHC.CmmToAsm.Instr
    import GHC.Types.Unique (Unique)
    import GHC.CmmToAsm.Types

    import GHC.Types.Unique.FM

    import GHC.Utils.Outputable
    import GHC.Utils.Monad.State.Strict
    import GHC.Platform (Platform)

    -- | Build a map of how many times each reg was alloced, clobbered, loaded etc.
    binSpillReasons
            :: [SpillReason] -> UniqFM Unique [Int]
            -- See Note [UniqFM and the register allocator]
    binSpillReasons :: [SpillReason] -> UniqFM Unique [Int]
    binSpillReasons [SpillReason]
    reasons
            = ([Int] -> [Int] -> [Int])
    -> UniqFM Unique [Int] -> [(Unique, [Int])] -> UniqFM Unique [Int]
    forall key elt.
    Uniquable key =>
    (elt -> elt -> elt)
    -> UniqFM key elt -> [(key, elt)] -> UniqFM key elt
    addListToUFM_C
                    ((Int -> Int -> Int) -> [Int] -> [Int] -> [Int]
    forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
    zipWith Int -> Int -> Int
    forall a. Num a => a -> a -> a
    (+))
                    UniqFM Unique [Int]
    forall {k} (key :: k) elt. UniqFM key elt
    emptyUFM
                    ((SpillReason -> (Unique, [Int]))
    -> [SpillReason] -> [(Unique, [Int])]
    forall a b. (a -> b) -> [a] -> [b]
    map (\SpillReason
    reason -> case SpillReason
    reason of
                            SpillAlloc Unique
    r    -> (Unique
    r, [Int
    1, Int
    0, Int
    0, Int
    0, Int
    0])
                            SpillClobber Unique
    r  -> (Unique
    r, [Int
    0, Int
    1, Int
    0, Int
    0, Int
    0])
                            SpillLoad Unique
    r     -> (Unique
    r, [Int
    0, Int
    0, Int
    1, Int
    0, Int
    0])
                            SpillJoinRR Unique
    r   -> (Unique
    r, [Int
    0, Int
    0, Int
    0, Int
    1, Int
    0])
                            SpillJoinRM Unique
    r   -> (Unique
    r, [Int
    0, Int
    0, Int
    0, Int
    0, Int
    1])) [SpillReason]
    reasons)

    -- | Count reg-reg moves remaining in this code.
    countRegRegMovesNat
            :: Instruction instr
            => Platform
            -> NatCmmDecl statics instr -> Int

    countRegRegMovesNat :: forall instr statics.
    Instruction instr =>
    Platform -> NatCmmDecl statics instr -> Int
    countRegRegMovesNat Platform
    platform NatCmmDecl statics instr
    cmm
            = State Int (NatCmmDecl statics instr) -> Int -> Int
    forall s a. State s a -> s -> s
    execState ((GenBasicBlock instr -> State Int (GenBasicBlock instr))
    -> NatCmmDecl statics instr -> State Int (NatCmmDecl statics instr)
    forall (m :: * -> *) i d h.
    Monad m =>
    (GenBasicBlock i -> m (GenBasicBlock i))
    -> GenCmmDecl d h (ListGraph i) -> m (GenCmmDecl d h (ListGraph i))
    mapGenBlockTopM GenBasicBlock instr -> State Int (GenBasicBlock instr)
    countBlock NatCmmDecl statics instr
    cmm) Int
    0
     where
            countBlock :: GenBasicBlock instr -> State Int (GenBasicBlock instr)
    countBlock b :: GenBasicBlock instr
    b@(BasicBlock BlockId
    _ [instr]
    instrs)
             = do   (instr -> State Int instr) -> [instr] -> State Int ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ instr -> State Int instr
    countInstr [instr]
    instrs
                    GenBasicBlock instr -> State Int (GenBasicBlock instr)
    forall a. a -> State Int a
    forall (m :: * -> *) a. Monad m => a -> m a
    return  GenBasicBlock instr
    b

            countInstr :: instr -> State Int instr
    countInstr instr
    instr
                    | Just (Reg, Reg)
    _        <- Platform -> instr -> Maybe (Reg, Reg)
    forall instr.
    Instruction instr =>
    Platform -> instr -> Maybe (Reg, Reg)
    takeRegRegMoveInstr Platform
    platform instr
    instr
                    = do    (Int -> Int) -> State Int ()
    forall s. (s -> s) -> State s ()
    modify (Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1)
                            instr -> State Int instr
    forall a. a -> State Int a
    forall (m :: * -> *) a. Monad m => a -> m a
    return instr
    instr

                    | Bool
    otherwise
                    =       instr -> State Int instr
    forall a. a -> State Int a
    forall (m :: * -> *) a. Monad m => a -> m a
    return instr
    instr

    -- | Pretty print some RegAllocStats
    pprStats
            :: Instruction instr
            => Platform -> [NatCmmDecl statics instr] -> [RegAllocStats] -> SDoc

    pprStats :: forall instr statics.
    Instruction instr =>
    Platform -> [NatCmmDecl statics instr] -> [RegAllocStats] -> SDoc
    pprStats Platform
    platform [NatCmmDecl statics instr]
    code [RegAllocStats]
    statss
     = let  -- sum up all the instrs inserted by the spiller
            -- See Note [UniqFM and the register allocator]
            spills :: UniqFM Unique [Int]
            spills :: UniqFM Unique [Int]
    spills          = (UniqFM Unique [Int] -> UniqFM Unique [Int] -> UniqFM Unique [Int])
    -> UniqFM Unique [Int]
    -> [UniqFM Unique [Int]]
    -> UniqFM Unique [Int]
    forall b a. (b -> a -> b) -> b -> [a] -> b
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl' (([Int] -> [Int] -> [Int])
    -> UniqFM Unique [Int]
    -> UniqFM Unique [Int]
    -> UniqFM Unique [Int]
    forall {k} elt (key :: k).
    (elt -> elt -> elt)
    -> UniqFM key elt -> UniqFM key elt -> UniqFM key elt
    plusUFM_C ((Int -> Int -> Int) -> [Int] -> [Int] -> [Int]
    forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
    zipWith Int -> Int -> Int
    forall a. Num a => a -> a -> a
    (+)))
                                    UniqFM Unique [Int]
    forall {k} (key :: k) elt. UniqFM key elt
    emptyUFM
                            ([UniqFM Unique [Int]] -> UniqFM Unique [Int])
    -> [UniqFM Unique [Int]] -> UniqFM Unique [Int]
    forall a b. (a -> b) -> a -> b
    $ (RegAllocStats -> UniqFM Unique [Int])
    -> [RegAllocStats] -> [UniqFM Unique [Int]]
    forall a b. (a -> b) -> [a] -> [b]
    map RegAllocStats -> UniqFM Unique [Int]
    ra_spillInstrs [RegAllocStats]
    statss

            spillTotals :: [Int]
    spillTotals     = ([Int] -> [Int] -> [Int]) -> [Int] -> [[Int]] -> [Int]
    forall b a. (b -> a -> b) -> b -> [a] -> b
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl' ((Int -> Int -> Int) -> [Int] -> [Int] -> [Int]
    forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
    zipWith Int -> Int -> Int
    forall a. Num a => a -> a -> a
    (+))
                                    [Int
    0, Int
    0, Int
    0, Int
    0, Int
    0]
                            ([[Int]] -> [Int]) -> [[Int]] -> [Int]
    forall a b. (a -> b) -> a -> b
    $ UniqFM Unique [Int] -> [[Int]]
    forall {k} (key :: k) elt. UniqFM key elt -> [elt]
    nonDetEltsUFM UniqFM Unique [Int]
    spills
                            -- See Note [Unique Determinism and code generation]

            -- count how many reg-reg-moves remain in the code
            moves :: Int
    moves           = [Int] -> Int
    forall a. Num a => [a] -> a
    forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
    sum ([Int] -> Int) -> [Int] -> Int
    forall a b. (a -> b) -> a -> b
    $ (NatCmmDecl statics instr -> Int)
    -> [NatCmmDecl statics instr] -> [Int]
    forall a b. (a -> b) -> [a] -> [b]
    map (Platform -> NatCmmDecl statics instr -> Int
    forall instr statics.
    Instruction instr =>
    Platform -> NatCmmDecl statics instr -> Int
    countRegRegMovesNat Platform
    platform) [NatCmmDecl statics instr]
    code

            pprSpill :: (a, [a]) -> SDoc
    pprSpill (a
    reg, [a]
    spills)
                    = SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc
    parens (SDoc -> SDoc) -> SDoc -> SDoc
    forall a b. (a -> b) -> a -> b
    $ ([SDoc] -> SDoc
    forall doc. IsLine doc => [doc] -> doc
    hcat ([SDoc] -> SDoc) -> [SDoc] -> SDoc
    forall a b. (a -> b) -> a -> b
    $ SDoc -> [SDoc] -> [SDoc]
    forall doc. IsLine doc => doc -> [doc] -> [doc]
    punctuate (String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    ", ")  (SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc
    doubleQuotes (a -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr a
    reg) SDoc -> [SDoc] -> [SDoc]
    forall a. a -> [a] -> [a]
    : (a -> SDoc) -> [a] -> [SDoc]
    forall a b. (a -> b) -> [a] -> [b]
    map a -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr [a]
    spills))

       in   (  String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "-- spills-added-total"
            SDoc -> SDoc -> SDoc
    forall doc. IsDoc doc => doc -> doc -> doc
    $$ String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "--    (allocs, clobbers, loads, joinRR, joinRM, reg_reg_moves_remaining)"
            SDoc -> SDoc -> SDoc
    forall doc. IsDoc doc => doc -> doc -> doc
    $$ (SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc
    parens (SDoc -> SDoc) -> SDoc -> SDoc
    forall a b. (a -> b) -> a -> b
    $ ([SDoc] -> SDoc
    forall doc. IsLine doc => [doc] -> doc
    hcat ([SDoc] -> SDoc) -> [SDoc] -> SDoc
    forall a b. (a -> b) -> a -> b
    $ SDoc -> [SDoc] -> [SDoc]
    forall doc. IsLine doc => doc -> [doc] -> [doc]
    punctuate (String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    ", ") ((Int -> SDoc) -> [Int] -> [SDoc]
    forall a b. (a -> b) -> [a] -> [b]
    map Int -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr [Int]
    spillTotals [SDoc] -> [SDoc] -> [SDoc]
    forall a. [a] -> [a] -> [a]
    ++ [Int -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Int
    moves])))
            SDoc -> SDoc -> SDoc
    forall doc. IsDoc doc => doc -> doc -> doc
    $$ String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    ""
            SDoc -> SDoc -> SDoc
    forall doc. IsDoc doc => doc -> doc -> doc
    $$ String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "-- spills-added"
            SDoc -> SDoc -> SDoc
    forall doc. IsDoc doc => doc -> doc -> doc
    $$ String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "--    (reg_name, allocs, clobbers, loads, joinRR, joinRM)"
            SDoc -> SDoc -> SDoc
    forall doc. IsDoc doc => doc -> doc -> doc
    $$ (UniqFM Unique [Int] -> ([(Unique, [Int])] -> SDoc) -> SDoc
    forall {k} (key :: k) a.
    UniqFM key a -> ([(Unique, a)] -> SDoc) -> SDoc
    pprUFMWithKeys UniqFM Unique [Int]
    spills ([SDoc] -> SDoc
    forall doc. IsDoc doc => [doc] -> doc
    vcat ([SDoc] -> SDoc)
    -> ([(Unique, [Int])] -> [SDoc]) -> [(Unique, [Int])] -> SDoc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ((Unique, [Int]) -> SDoc) -> [(Unique, [Int])] -> [SDoc]
    forall a b. (a -> b) -> [a] -> [b]
    map (Unique, [Int]) -> SDoc
    forall {a} {a}. (Outputable a, Outputable a) => (a, [a]) -> SDoc
    pprSpill))
            SDoc -> SDoc -> SDoc
    forall doc. IsDoc doc => doc -> doc -> doc
    $$ String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "")