    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

    -- | 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
            = forall key elt.
    Uniquable key =>
    (elt -> elt -> elt)
    -> UniqFM key elt -> [(key, elt)] -> UniqFM key elt
    addListToUFM_C
                    (forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
    zipWith forall a. Num a => a -> a -> a
    (+))
                    forall key elt. UniqFM key elt
    emptyUFM
                    (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
            => NatCmmDecl statics instr -> Int

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

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

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

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

    pprStats :: forall instr statics.
    Instruction instr =>
    [NatCmmDecl statics instr] -> [RegAllocStats] -> SDoc
    pprStats [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          = forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl' (forall elt key.
    (elt -> elt -> elt)
    -> UniqFM key elt -> UniqFM key elt -> UniqFM key elt
    plusUFM_C (forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
    zipWith forall a. Num a => a -> a -> a
    (+)))
                                    forall key elt. UniqFM key elt
    emptyUFM
                            forall a b. (a -> b) -> a -> b
    $ forall a b. (a -> b) -> [a] -> [b]
    map RegAllocStats -> UniqFM Unique [Int]
    ra_spillInstrs [RegAllocStats]
    statss

            spillTotals :: [Int]
    spillTotals     = forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl' (forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
    zipWith forall a. Num a => a -> a -> a
    (+))
                                    [Int
    0, Int
    0, Int
    0, Int
    0, Int
    0]
                            forall a b. (a -> b) -> a -> b
    $ forall key 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           = forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
    sum forall a b. (a -> b) -> a -> b
    $ forall a b. (a -> b) -> [a] -> [b]
    map forall instr statics.
    Instruction instr =>
    NatCmmDecl statics instr -> Int
    countRegRegMovesNat [NatCmmDecl statics instr]
    code

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

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