    {-# LANGUAGE GADTs #-}
    {-# LANGUAGE ScopedTypeVariables #-}

    module GHC.Cmm.Sink (
         cmmSink
      ) where

    import GHC.Prelude

    import GHC.Cmm
    import GHC.Cmm.Opt
    import GHC.Cmm.Liveness
    import GHC.Cmm.LRegSet
    import GHC.Cmm.Utils
    import GHC.Cmm.Dataflow.Block
    import GHC.Cmm.Dataflow.Label
    import GHC.Cmm.Dataflow.Collections
    import GHC.Cmm.Dataflow.Graph
    import GHC.Platform.Regs

    import GHC.Platform
    import GHC.Types.Unique.FM

    import qualified Data.IntSet as IntSet
    import Data.List (partition)
    import Data.Maybe

    import GHC.Exts (inline)

    -- -----------------------------------------------------------------------------
    -- Sinking and inlining

    -- This is an optimisation pass that
    --  (a) moves assignments closer to their uses, to reduce register pressure
    --  (b) pushes assignments into a single branch of a conditional if possible
    --  (c) inlines assignments to registers that are mentioned only once
    --  (d) discards dead assignments
    --
    -- This tightens up lots of register-heavy code.  It is particularly
    -- helpful in the Cmm generated by the Stg->Cmm code generator, in
    -- which every function starts with a copyIn sequence like:
    --
    --    x1 = R1
    --    x2 = Sp[8]
    --    x3 = Sp[16]
    --    if (Sp - 32 < SpLim) then L1 else L2
    --
    -- we really want to push the x1..x3 assignments into the L2 branch.
    --
    -- Algorithm:
    --
    --  * Start by doing liveness analysis.
    --
    --  * Keep a list of assignments A; earlier ones may refer to later ones.
    --    Currently we only sink assignments to local registers, because we don't
    --    have liveness information about global registers.
    --
    --  * Walk forwards through the graph, look at each node N:
    --
    --    * If it is a dead assignment, i.e. assignment to a register that is
    --      not used after N, discard it.
    --
    --    * Try to inline based on current list of assignments
    --      * If any assignments in A (1) occur only once in N, and (2) are
    --        not live after N, inline the assignment and remove it
    --        from A.
    --
    --      * If an assignment in A is cheap (RHS is local register), then
    --        inline the assignment and keep it in A in case it is used afterwards.
    --
    --      * Otherwise don't inline.
    --
    --    * If N is assignment to a local register pick up the assignment
    --      and add it to A.
    --
    --    * If N is not an assignment to a local register:
    --      * remove any assignments from A that conflict with N, and
    --        place them before N in the current block.  We call this
    --        "dropping" the assignments.
    --
    --      * An assignment conflicts with N if it:
    --        - assigns to a register mentioned in N
    --        - mentions a register assigned by N
    --        - reads from memory written by N
    --      * do this recursively, dropping dependent assignments
    --
    --    * At an exit node:
    --      * drop any assignments that are live on more than one successor
    --        and are not trivial
    --      * if any successor has more than one predecessor (a join-point),
    --        drop everything live in that successor. Since we only propagate
    --        assignments that are not dead at the successor, we will therefore
    --        eliminate all assignments dead at this point. Thus analysis of a
    --        join-point will always begin with an empty list of assignments.
    --
    --
    -- As a result of above algorithm, sinking deletes some dead assignments
    -- (transitively, even).  This isn't as good as removeDeadAssignments,
    -- but it's much cheaper.

    -- -----------------------------------------------------------------------------
    -- things that we aren't optimising very well yet.
    --
    -- -----------
    -- (1) From GHC's FastString.hashStr:
    --
    --  s2ay:
    --      if ((_s2an::I64 == _s2ao::I64) >= 1) goto c2gn; else goto c2gp;
    --  c2gn:
    --      R1 = _s2au::I64;
    --      call (I64[Sp])(R1) args: 8, res: 0, upd: 8;
    --  c2gp:
    --      _s2cO::I64 = %MO_S_Rem_W64(%MO_UU_Conv_W8_W64(I8[_s2aq::I64 + (_s2an::I64 << 0)]) + _s2au::I64 * 128,
    --                                 4091);
    --      _s2an::I64 = _s2an::I64 + 1;
    --      _s2au::I64 = _s2cO::I64;
    --      goto s2ay;
    --
    -- a nice loop, but we didn't eliminate the silly assignment at the end.
    -- See Note [dependent assignments], which would probably fix this.
    -- This is #8336.
    --
    -- -----------
    -- (2) From stg_atomically_frame in PrimOps.cmm
    --
    -- We have a diamond control flow:
    --
    --     x = ...
    --       |
    --      / \
    --     A   B
    --      \ /
    --       |
    --    use of x
    --
    -- Now x won't be sunk down to its use, because we won't push it into
    -- both branches of the conditional.  We certainly do have to check
    -- that we can sink it past all the code in both A and B, but having
    -- discovered that, we could sink it to its use.
    --

    -- -----------------------------------------------------------------------------

    type Assignment = (LocalReg, CmmExpr, AbsMem)
      -- Assignment caches AbsMem, an abstraction of the memory read by
      -- the RHS of the assignment.

    type Assignments = [Assignment]
      -- A sequence of assignments; kept in *reverse* order
      -- So the list [ x=e1, y=e2 ] means the sequence of assignments
      --     y = e2
      --     x = e1

    cmmSink :: Platform -> CmmGraph -> CmmGraph
    cmmSink :: Platform -> CmmGraph -> CmmGraph
    cmmSink Platform
    platform CmmGraph
    graph = BlockId -> [CmmBlock] -> CmmGraph
    ofBlockList (forall (n :: Extensibility -> Extensibility -> *).
    GenCmmGraph n -> BlockId
    g_entry CmmGraph
    graph) forall a b. (a -> b) -> a -> b
    $ LabelMap Assignments -> [CmmBlock] -> [CmmBlock]
    sink forall (map :: * -> *) a. IsMap map => map a
    mapEmpty forall a b. (a -> b) -> a -> b
    $ [CmmBlock]
    blocks
      where
      liveness :: BlockEntryLivenessL
    liveness = Platform -> CmmGraph -> BlockEntryLivenessL
    cmmLocalLivenessL Platform
    platform CmmGraph
    graph
      getLive :: BlockId -> LRegSet
    getLive BlockId
    l = forall (map :: * -> *) a. IsMap map => a -> KeyOf map -> map a -> a
    mapFindWithDefault LRegSet
    emptyLRegSet BlockId
    l BlockEntryLivenessL
    liveness

      blocks :: [CmmBlock]
    blocks = CmmGraph -> [CmmBlock]
    revPostorder CmmGraph
    graph

      join_pts :: LabelMap Int
    join_pts = [CmmBlock] -> LabelMap Int
    findJoinPoints [CmmBlock]
    blocks

      sink :: LabelMap Assignments -> [CmmBlock] -> [CmmBlock]
      sink :: LabelMap Assignments -> [CmmBlock] -> [CmmBlock]
    sink LabelMap Assignments
    _ [] = []
      sink LabelMap Assignments
    sunk (CmmBlock
    b:[CmmBlock]
    bs) =
        -- pprTrace "sink" (ppr lbl) $
        forall (n :: Extensibility -> Extensibility -> *).
    n C O -> Block n O O -> n O C -> Block n C C
    blockJoin CmmNode C O
    first Block CmmNode O O
    final_middle CmmNode O C
    final_last forall a. a -> [a] -> [a]
    : LabelMap Assignments -> [CmmBlock] -> [CmmBlock]
    sink LabelMap Assignments
    sunk' [CmmBlock]
    bs
        where
          lbl :: BlockId
    lbl = forall (thing :: Extensibility -> Extensibility -> *)
           (x :: Extensibility).
    NonLocal thing =>
    thing C x -> BlockId
    entryLabel CmmBlock
    b
          (CmmNode C O
    first, Block CmmNode O O
    middle, CmmNode O C
    last) = forall (n :: Extensibility -> Extensibility -> *).
    Block n C C -> (n C O, Block n O O, n O C)
    blockSplit CmmBlock
    b

          succs :: [BlockId]
    succs = forall (thing :: Extensibility -> Extensibility -> *)
           (e :: Extensibility).
    NonLocal thing =>
    thing e C -> [BlockId]
    successors CmmNode O C
    last

          -- Annotate the middle nodes with the registers live *after*
          -- the node.  This will help us decide whether we can inline
          -- an assignment in the current node or not.
          live :: LRegSet
    live = forall (f :: * -> *). Foldable f => f LRegSet -> LRegSet
    IntSet.unions (forall a b. (a -> b) -> [a] -> [b]
    map BlockId -> LRegSet
    getLive [BlockId]
    succs)
          live_middle :: LRegSet
    live_middle = forall n.
    (DefinerOfRegs LocalReg n, UserOfRegs LocalReg n) =>
    Platform -> n -> LRegSet -> LRegSet
    gen_killL Platform
    platform CmmNode O C
    last LRegSet
    live
          ann_middles :: [(LRegSet, CmmNode O O)]
    ann_middles = Platform -> LRegSet -> [CmmNode O O] -> [(LRegSet, CmmNode O O)]
    annotate Platform
    platform LRegSet
    live_middle (forall (n :: Extensibility -> Extensibility -> *).
    Block n O O -> [n O O]
    blockToList Block CmmNode O O
    middle)

          -- Now sink and inline in this block
          (Block CmmNode O O
    middle', Assignments
    assigs) = Platform
    -> [(LRegSet, CmmNode O O)]
    -> Assignments
    -> (Block CmmNode O O, Assignments)
    walk Platform
    platform [(LRegSet, CmmNode O O)]
    ann_middles (forall (map :: * -> *) a. IsMap map => a -> KeyOf map -> map a -> a
    mapFindWithDefault [] BlockId
    lbl LabelMap Assignments
    sunk)
          fold_last :: CmmNode O C
    fold_last = forall (e :: Extensibility) (x :: Extensibility).
    Platform -> CmmNode e x -> CmmNode e x
    constantFoldNode Platform
    platform CmmNode O C
    last
          (CmmNode O C
    final_last, Assignments
    assigs') = forall (x :: Extensibility).
    Platform
    -> LRegSet
    -> CmmNode O x
    -> Assignments
    -> (CmmNode O x, Assignments)
    tryToInline Platform
    platform LRegSet
    live CmmNode O C
    fold_last Assignments
    assigs

          -- We cannot sink into join points (successors with more than
          -- one predecessor), so identify the join points and the set
          -- of registers live in them.
          ([BlockId]
    joins, [BlockId]
    nonjoins) = forall a. (a -> Bool) -> [a] -> ([a], [a])
    partition (forall (map :: * -> *) a. IsMap map => KeyOf map -> map a -> Bool
    `mapMember` LabelMap Int
    join_pts) [BlockId]
    succs
          live_in_joins :: LRegSet
    live_in_joins = forall (f :: * -> *). Foldable f => f LRegSet -> LRegSet
    IntSet.unions (forall a b. (a -> b) -> [a] -> [b]
    map BlockId -> LRegSet
    getLive [BlockId]
    joins)

          -- We do not want to sink an assignment into multiple branches,
          -- so identify the set of registers live in multiple successors.
          -- This is made more complicated because when we sink an assignment
          -- into one branch, this might change the set of registers that are
          -- now live in multiple branches.
          init_live_sets :: [LRegSet]
    init_live_sets = forall a b. (a -> b) -> [a] -> [b]
    map BlockId -> LRegSet
    getLive [BlockId]
    nonjoins
          live_in_multi :: [LRegSet] -> LocalReg -> Bool
    live_in_multi [LRegSet]
    live_sets LocalReg
    r =
             case forall a. (a -> Bool) -> [a] -> [a]
    filter (LocalReg -> LRegSet -> Bool
    elemLRegSet LocalReg
    r) [LRegSet]
    live_sets of
               (LRegSet
    _one:LRegSet
    _two:[LRegSet]
    _) -> Bool
    True
               [LRegSet]
    _ -> Bool
    False

          -- Now, drop any assignments that we will not sink any further.
          ([CmmNode O O]
    dropped_last, Assignments
    assigs'') = forall s.
    Platform
    -> (Assignment -> s -> (Bool, s))
    -> s
    -> Assignments
    -> ([CmmNode O O], Assignments)
    dropAssignments Platform
    platform Assignment -> [LRegSet] -> (Bool, [LRegSet])
    drop_if [LRegSet]
    init_live_sets Assignments
    assigs'

          drop_if :: (LocalReg, CmmExpr, AbsMem)
                          -> [LRegSet] -> (Bool, [LRegSet])
          drop_if :: Assignment -> [LRegSet] -> (Bool, [LRegSet])
    drop_if a :: Assignment
    a@(LocalReg
    r,CmmExpr
    rhs,AbsMem
    _) [LRegSet]
    live_sets = (Bool
    should_drop, [LRegSet]
    live_sets')
              where
                should_drop :: Bool
    should_drop =  forall (x :: Extensibility).
    Platform -> Assignment -> CmmNode O x -> Bool
    conflicts Platform
    platform Assignment
    a CmmNode O C
    final_last
                            Bool -> Bool -> Bool
    || Bool -> Bool
    not (Platform -> CmmExpr -> Bool
    isTrivial Platform
    platform CmmExpr
    rhs) Bool -> Bool -> Bool
    && [LRegSet] -> LocalReg -> Bool
    live_in_multi [LRegSet]
    live_sets LocalReg
    r
                            Bool -> Bool -> Bool
    || LocalReg
    r LocalReg -> LRegSet -> Bool
    `elemLRegSet` LRegSet
    live_in_joins

                live_sets' :: [LRegSet]
    live_sets' | Bool
    should_drop = [LRegSet]
    live_sets
                           | Bool
    otherwise   = forall a b. (a -> b) -> [a] -> [b]
    map LRegSet -> LRegSet
    upd [LRegSet]
    live_sets

                upd :: LRegSet -> LRegSet
    upd LRegSet
    set | LocalReg
    r LocalReg -> LRegSet -> Bool
    `elemLRegSet` LRegSet
    set = LRegSet
    set LRegSet -> LRegSet -> LRegSet
    `IntSet.union` LRegSet
    live_rhs
                        | Bool
    otherwise          = LRegSet
    set

                live_rhs :: LRegSet
    live_rhs = forall r a b.
    UserOfRegs r a =>
    Platform -> (b -> r -> b) -> b -> a -> b
    foldRegsUsed Platform
    platform (forall a b c. (a -> b -> c) -> b -> a -> c
    flip LocalReg -> LRegSet -> LRegSet
    insertLRegSet) LRegSet
    emptyLRegSet CmmExpr
    rhs

          final_middle :: Block CmmNode O O
    final_middle = forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl' forall (n :: Extensibility -> Extensibility -> *)
           (e :: Extensibility).
    Block n e O -> n O O -> Block n e O
    blockSnoc Block CmmNode O O
    middle' [CmmNode O O]
    dropped_last

          sunk' :: LabelMap Assignments
    sunk' = forall (map :: * -> *) a. IsMap map => map a -> map a -> map a
    mapUnion LabelMap Assignments
    sunk forall a b. (a -> b) -> a -> b
    $
                     forall (map :: * -> *) a. IsMap map => [(KeyOf map, a)] -> map a
    mapFromList [ (BlockId
    l, Platform -> LRegSet -> Assignments -> Assignments
    filterAssignments Platform
    platform (BlockId -> LRegSet
    getLive BlockId
    l) Assignments
    assigs'')
                                 | BlockId
    l <- [BlockId]
    succs ]

    {- TODO: enable this later, when we have some good tests in place to
       measure the effect and tune it.

    -- small: an expression we don't mind duplicating
    isSmall :: CmmExpr -> Bool
    isSmall (CmmReg (CmmLocal _)) = True  --
    isSmall (CmmLit _) = True
    isSmall (CmmMachOp (MO_Add _) [x,y]) = isTrivial x && isTrivial y
    isSmall (CmmRegOff (CmmLocal _) _) = True
    isSmall _ = False
    -}

    --
    -- We allow duplication of trivial expressions: registers (both local and
    -- global) and literals.
    --
    isTrivial :: Platform -> CmmExpr -> Bool
    isTrivial :: Platform -> CmmExpr -> Bool
    isTrivial Platform
    _ (CmmReg (CmmLocal LocalReg
    _)) = Bool
    True
    isTrivial Platform
    platform (CmmReg (CmmGlobal GlobalReg
    r)) = -- see Note [Inline GlobalRegs?]
      if Arch -> Bool
    isARM (Platform -> Arch
    platformArch Platform
    platform)
      then Bool
    True -- CodeGen.Platform.ARM does not have globalRegMaybe
      else forall a. Maybe a -> Bool
    isJust (Platform -> GlobalReg -> Maybe RealReg
    globalRegMaybe Platform
    platform GlobalReg
    r)
      -- GlobalRegs that are loads from BaseReg are not trivial
    isTrivial Platform
    _ (CmmLit CmmLit
    _) = Bool
    True
    isTrivial Platform
    _ CmmExpr
    _          = Bool
    False

    --
    -- annotate each node with the set of registers live *after* the node
    --
    annotate :: Platform -> LRegSet -> [CmmNode O O] -> [(LRegSet, CmmNode O O)]
    annotate :: Platform -> LRegSet -> [CmmNode O O] -> [(LRegSet, CmmNode O O)]
    annotate Platform
    platform LRegSet
    live [CmmNode O O]
    nodes = forall a b. (a, b) -> b
    snd forall a b. (a -> b) -> a -> b
    $ forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr CmmNode O O
    -> (LRegSet, [(LRegSet, CmmNode O O)])
    -> (LRegSet, [(LRegSet, CmmNode O O)])
    ann (LRegSet
    live,[]) [CmmNode O O]
    nodes
      where ann :: CmmNode O O
    -> (LRegSet, [(LRegSet, CmmNode O O)])
    -> (LRegSet, [(LRegSet, CmmNode O O)])
    ann CmmNode O O
    n (LRegSet
    live,[(LRegSet, CmmNode O O)]
    nodes) = (forall n.
    (DefinerOfRegs LocalReg n, UserOfRegs LocalReg n) =>
    Platform -> n -> LRegSet -> LRegSet
    gen_killL Platform
    platform CmmNode O O
    n LRegSet
    live, (LRegSet
    live,CmmNode O O
    n) forall a. a -> [a] -> [a]
    : [(LRegSet, CmmNode O O)]
    nodes)

    --
    -- Find the blocks that have multiple successors (join points)
    --
    findJoinPoints :: [CmmBlock] -> LabelMap Int
    findJoinPoints :: [CmmBlock] -> LabelMap Int
    findJoinPoints [CmmBlock]
    blocks = forall (map :: * -> *) a.
    IsMap map =>
    (a -> Bool) -> map a -> map a
    mapFilter (forall a. Ord a => a -> a -> Bool
    >Int
    1) LabelMap Int
    succ_counts
     where
      all_succs :: [BlockId]
    all_succs = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap forall (thing :: Extensibility -> Extensibility -> *)
           (e :: Extensibility).
    NonLocal thing =>
    thing e C -> [BlockId]
    successors [CmmBlock]
    blocks

      succ_counts :: LabelMap Int
      succ_counts :: LabelMap Int
    succ_counts = forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr (\BlockId
    l -> forall (map :: * -> *) a.
    IsMap map =>
    (a -> a -> a) -> KeyOf map -> a -> map a -> map a
    mapInsertWith forall a. Num a => a -> a -> a
    (+) BlockId
    l Int
    1) forall (map :: * -> *) a. IsMap map => map a
    mapEmpty [BlockId]
    all_succs

    --
    -- filter the list of assignments to remove any assignments that
    -- are not live in a continuation.
    --
    filterAssignments :: Platform -> LRegSet -> Assignments -> Assignments
    filterAssignments :: Platform -> LRegSet -> Assignments -> Assignments
    filterAssignments Platform
    platform LRegSet
    live Assignments
    assigs = forall a. [a] -> [a]
    reverse (Assignments -> Assignments -> Assignments
    go Assignments
    assigs [])
      where go :: Assignments -> Assignments -> Assignments
    go []             Assignments
    kept = Assignments
    kept
            go (a :: Assignment
    a@(LocalReg
    r,CmmExpr
    _,AbsMem
    _):Assignments
    as) Assignments
    kept | Bool
    needed    = Assignments -> Assignments -> Assignments
    go Assignments
    as (Assignment
    aforall a. a -> [a] -> [a]
    :Assignments
    kept)
                                   | Bool
    otherwise = Assignments -> Assignments -> Assignments
    go Assignments
    as Assignments
    kept
               where
                  needed :: Bool
    needed = LocalReg
    r LocalReg -> LRegSet -> Bool
    `elemLRegSet` LRegSet
    live
                           Bool -> Bool -> Bool
    || forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    any (forall (x :: Extensibility).
    Platform -> Assignment -> CmmNode O x -> Bool
    conflicts Platform
    platform Assignment
    a) (forall a b. (a -> b) -> [a] -> [b]
    map Assignment -> CmmNode O O
    toNode Assignments
    kept)
                           --  Note that we must keep assignments that are
                           -- referred to by other assignments we have
                           -- already kept.

    -- -----------------------------------------------------------------------------
    -- Walk through the nodes of a block, sinking and inlining assignments
    -- as we go.
    --
    -- On input we pass in a:
    --    * list of nodes in the block
    --    * a list of assignments that appeared *before* this block and
    --      that are being sunk.
    --
    -- On output we get:
    --    * a new block
    --    * a list of assignments that will be placed *after* that block.
    --

    walk :: Platform
         -> [(LRegSet, CmmNode O O)]    -- nodes of the block, annotated with
                                            -- the set of registers live *after*
                                            -- this node.

         -> Assignments                     -- The current list of
                                            -- assignments we are sinking.
                                            -- Earlier assignments may refer
                                            -- to later ones.

         -> ( Block CmmNode O O             -- The new block
            , Assignments                   -- Assignments to sink further
            )

    walk :: Platform
    -> [(LRegSet, CmmNode O O)]
    -> Assignments
    -> (Block CmmNode O O, Assignments)
    walk Platform
    platform [(LRegSet, CmmNode O O)]
    nodes Assignments
    assigs = [(LRegSet, CmmNode O O)]
    -> Block CmmNode O O
    -> Assignments
    -> (Block CmmNode O O, Assignments)
    go [(LRegSet, CmmNode O O)]
    nodes forall (n :: Extensibility -> Extensibility -> *). Block n O O
    emptyBlock Assignments
    assigs
     where
       go :: [(LRegSet, CmmNode O O)]
    -> Block CmmNode O O
    -> Assignments
    -> (Block CmmNode O O, Assignments)
    go []               Block CmmNode O O
    block Assignments
    as = (Block CmmNode O O
    block, Assignments
    as)
       go ((LRegSet
    live,CmmNode O O
    node):[(LRegSet, CmmNode O O)]
    ns) Block CmmNode O O
    block Assignments
    as
        | forall (e :: Extensibility) (x :: Extensibility).
    CmmNode e x -> LRegSet -> Bool
    shouldDiscard CmmNode O O
    node LRegSet
    live             = [(LRegSet, CmmNode O O)]
    -> Block CmmNode O O
    -> Assignments
    -> (Block CmmNode O O, Assignments)
    go [(LRegSet, CmmNode O O)]
    ns Block CmmNode O O
    block Assignments
    as
           -- discard dead assignment
        | Just Assignment
    a <- forall (e :: Extensibility) (x :: Extensibility).
    Platform -> CmmNode e x -> Maybe Assignment
    shouldSink Platform
    platform CmmNode O O
    node2 = [(LRegSet, CmmNode O O)]
    -> Block CmmNode O O
    -> Assignments
    -> (Block CmmNode O O, Assignments)
    go [(LRegSet, CmmNode O O)]
    ns Block CmmNode O O
    block (Assignment
    a forall a. a -> [a] -> [a]
    : Assignments
    as1)
        | Bool
    otherwise                           = [(LRegSet, CmmNode O O)]
    -> Block CmmNode O O
    -> Assignments
    -> (Block CmmNode O O, Assignments)
    go [(LRegSet, CmmNode O O)]
    ns Block CmmNode O O
    block' Assignments
    as'
        where
          node1 :: CmmNode O O
    node1 = forall (e :: Extensibility) (x :: Extensibility).
    Platform -> CmmNode e x -> CmmNode e x
    constantFoldNode Platform
    platform CmmNode O O
    node

          (CmmNode O O
    node2, Assignments
    as1) = forall (x :: Extensibility).
    Platform
    -> LRegSet
    -> CmmNode O x
    -> Assignments
    -> (CmmNode O x, Assignments)
    tryToInline Platform
    platform LRegSet
    live CmmNode O O
    node1 Assignments
    as

          ([CmmNode O O]
    dropped, Assignments
    as') = Platform
    -> (Assignment -> Bool)
    -> Assignments
    -> ([CmmNode O O], Assignments)
    dropAssignmentsSimple Platform
    platform
                              (\Assignment
    a -> forall (x :: Extensibility).
    Platform -> Assignment -> CmmNode O x -> Bool
    conflicts Platform
    platform Assignment
    a CmmNode O O
    node2) Assignments
    as1

          block' :: Block CmmNode O O
    block' = forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl' forall (n :: Extensibility -> Extensibility -> *)
           (e :: Extensibility).
    Block n e O -> n O O -> Block n e O
    blockSnoc Block CmmNode O O
    block [CmmNode O O]
    dropped forall (n :: Extensibility -> Extensibility -> *)
           (e :: Extensibility).
    Block n e O -> n O O -> Block n e O
    `blockSnoc` CmmNode O O
    node2

    --
    -- Heuristic to decide whether to pick up and sink an assignment
    -- Currently we pick up all assignments to local registers.  It might
    -- be profitable to sink assignments to global regs too, but the
    -- liveness analysis doesn't track those (yet) so we can't.
    --
    shouldSink :: Platform -> CmmNode e x -> Maybe Assignment
    shouldSink :: forall (e :: Extensibility) (x :: Extensibility).
    Platform -> CmmNode e x -> Maybe Assignment
    shouldSink Platform
    platform (CmmAssign (CmmLocal LocalReg
    r) CmmExpr
    e) | Bool
    no_local_regs = forall a. a -> Maybe a
    Just (LocalReg
    r, CmmExpr
    e, Platform -> CmmExpr -> AbsMem
    exprMem Platform
    platform CmmExpr
    e)
      where no_local_regs :: Bool
    no_local_regs = Bool
    True -- foldRegsUsed (\_ _ -> False) True e
    shouldSink Platform
    _ CmmNode e x
    _other = forall a. Maybe a
    Nothing

    --
    -- discard dead assignments.  This doesn't do as good a job as
    -- removeDeadAssignments, because it would need multiple passes
    -- to get all the dead code, but it catches the common case of
    -- superfluous reloads from the stack that the stack allocator
    -- leaves behind.
    --
    -- Also we catch "r = r" here.  You might think it would fall
    -- out of inlining, but the inliner will see that r is live
    -- after the instruction and choose not to inline r in the rhs.
    --
    shouldDiscard :: CmmNode e x -> LRegSet -> Bool
    shouldDiscard :: forall (e :: Extensibility) (x :: Extensibility).
    CmmNode e x -> LRegSet -> Bool
    shouldDiscard CmmNode e x
    node LRegSet
    live
       = case CmmNode e x
    node of
           CmmAssign CmmReg
    r (CmmReg CmmReg
    r') | CmmReg
    r forall a. Eq a => a -> a -> Bool
    == CmmReg
    r' -> Bool
    True
           CmmAssign (CmmLocal LocalReg
    r) CmmExpr
    _ -> Bool -> Bool
    not (LocalReg
    r LocalReg -> LRegSet -> Bool
    `elemLRegSet` LRegSet
    live)
           CmmNode e x
    _otherwise -> Bool
    False

    toNode :: Assignment -> CmmNode O O
    toNode :: Assignment -> CmmNode O O
    toNode (LocalReg
    r,CmmExpr
    rhs,AbsMem
    _) = CmmReg -> CmmExpr -> CmmNode O O
    CmmAssign (LocalReg -> CmmReg
    CmmLocal LocalReg
    r) CmmExpr
    rhs

    dropAssignmentsSimple :: Platform -> (Assignment -> Bool) -> Assignments
                          -> ([CmmNode O O], Assignments)
    dropAssignmentsSimple :: Platform
    -> (Assignment -> Bool)
    -> Assignments
    -> ([CmmNode O O], Assignments)
    dropAssignmentsSimple Platform
    platform Assignment -> Bool
    f = forall s.
    Platform
    -> (Assignment -> s -> (Bool, s))
    -> s
    -> Assignments
    -> ([CmmNode O O], Assignments)
    dropAssignments Platform
    platform (\Assignment
    a ()
    _ -> (Assignment -> Bool
    f Assignment
    a, ())) ()

    dropAssignments :: Platform -> (Assignment -> s -> (Bool, s)) -> s -> Assignments
                    -> ([CmmNode O O], Assignments)
    dropAssignments :: forall s.
    Platform
    -> (Assignment -> s -> (Bool, s))
    -> s
    -> Assignments
    -> ([CmmNode O O], Assignments)
    dropAssignments Platform
    platform Assignment -> s -> (Bool, s)
    should_drop s
    state Assignments
    assigs
     = ([CmmNode O O]
    dropped, forall a. [a] -> [a]
    reverse Assignments
    kept)
     where
       ([CmmNode O O]
    dropped,Assignments
    kept) = s
    -> Assignments
    -> [CmmNode O O]
    -> Assignments
    -> ([CmmNode O O], Assignments)
    go s
    state Assignments
    assigs [] []

       go :: s
    -> Assignments
    -> [CmmNode O O]
    -> Assignments
    -> ([CmmNode O O], Assignments)
    go s
    _ []             [CmmNode O O]
    dropped Assignments
    kept = ([CmmNode O O]
    dropped, Assignments
    kept)
       go s
    state (Assignment
    assig : Assignments
    rest) [CmmNode O O]
    dropped Assignments
    kept
          | Bool
    conflict  = s
    -> Assignments
    -> [CmmNode O O]
    -> Assignments
    -> ([CmmNode O O], Assignments)
    go s
    state' Assignments
    rest (Assignment -> CmmNode O O
    toNode Assignment
    assig forall a. a -> [a] -> [a]
    : [CmmNode O O]
    dropped) Assignments
    kept
          | Bool
    otherwise = s
    -> Assignments
    -> [CmmNode O O]
    -> Assignments
    -> ([CmmNode O O], Assignments)
    go s
    state' Assignments
    rest [CmmNode O O]
    dropped (Assignment
    assigforall a. a -> [a] -> [a]
    :Assignments
    kept)
          where
            (Bool
    dropit, s
    state') = Assignment -> s -> (Bool, s)
    should_drop Assignment
    assig s
    state
            conflict :: Bool
    conflict = Bool
    dropit Bool -> Bool -> Bool
    || forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    any (forall (x :: Extensibility).
    Platform -> Assignment -> CmmNode O x -> Bool
    conflicts Platform
    platform Assignment
    assig) [CmmNode O O]
    dropped

    -- -----------------------------------------------------------------------------
    -- Try to inline assignments into a node.
    -- This also does constant folding for primpops, since
    -- inlining opens up opportunities for doing so.

    tryToInline
       :: forall x. Platform
       -> LRegSet               -- set of registers live after this
      --  -> LocalRegSet               -- set of registers live after this
                                    -- node.  We cannot inline anything
                                    -- that is live after the node, unless
                                    -- it is small enough to duplicate.
       -> CmmNode O x               -- The node to inline into
       -> Assignments               -- Assignments to inline
       -> (
            CmmNode O x             -- New node
          , Assignments             -- Remaining assignments
          )

    tryToInline :: forall (x :: Extensibility).
    Platform
    -> LRegSet
    -> CmmNode O x
    -> Assignments
    -> (CmmNode O x, Assignments)
    tryToInline Platform
    platform LRegSet
    liveAfter CmmNode O x
    node Assignments
    assigs =
      -- pprTrace "tryToInline assig length:" (ppr $ length assigs) $
        UniqFM LocalReg Int
    -> LRegSet
    -> CmmNode O x
    -> LRegSet
    -> Assignments
    -> (CmmNode O x, Assignments)
    go UniqFM LocalReg Int
    usages LRegSet
    liveAfter CmmNode O x
    node LRegSet
    emptyLRegSet Assignments
    assigs
     where
      usages :: UniqFM LocalReg Int -- Maps each LocalReg to a count of how often it is used
      usages :: UniqFM LocalReg Int
    usages = forall a b.
    UserOfRegs LocalReg a =>
    Platform -> (b -> LocalReg -> b) -> b -> a -> b
    foldLocalRegsUsed Platform
    platform UniqFM LocalReg Int -> LocalReg -> UniqFM LocalReg Int
    addUsage forall key elt. UniqFM key elt
    emptyUFM CmmNode O x
    node

      go :: UniqFM LocalReg Int -> LRegSet -> CmmNode O x -> LRegSet -> Assignments
         -> (CmmNode O x, Assignments)
      go :: UniqFM LocalReg Int
    -> LRegSet
    -> CmmNode O x
    -> LRegSet
    -> Assignments
    -> (CmmNode O x, Assignments)
    go UniqFM LocalReg Int
    _usages LRegSet
    _live CmmNode O x
    node LRegSet
    _skipped [] = (CmmNode O x
    node, [])

      go UniqFM LocalReg Int
    usages LRegSet
    live CmmNode O x
    node LRegSet
    skipped (a :: Assignment
    a@(LocalReg
    l,CmmExpr
    rhs,AbsMem
    _) : Assignments
    rest)
       | Bool
    cannot_inline            = (CmmNode O x, Assignments)
    dont_inline
       | Bool
    occurs_none              = (CmmNode O x, Assignments)
    discard  -- Note [discard during inlining]
       | Bool
    occurs_once              = (CmmNode O x, Assignments)
    inline_and_discard
       | Platform -> CmmExpr -> Bool
    isTrivial Platform
    platform CmmExpr
    rhs   = (CmmNode O x, Assignments)
    inline_and_keep
       | Bool
    otherwise                = (CmmNode O x, Assignments)
    dont_inline
       where
            inline_and_discard :: (CmmNode O x, Assignments)
    inline_and_discard = UniqFM LocalReg Int
    -> LRegSet
    -> CmmNode O x
    -> LRegSet
    -> Assignments
    -> (CmmNode O x, Assignments)
    go UniqFM LocalReg Int
    usages' LRegSet
    live CmmNode O x
    inl_node LRegSet
    skipped Assignments
    rest
              where usages' :: UniqFM LocalReg Int
    usages' = forall a b.
    UserOfRegs LocalReg a =>
    Platform -> (b -> LocalReg -> b) -> b -> a -> b
    foldLocalRegsUsed Platform
    platform UniqFM LocalReg Int -> LocalReg -> UniqFM LocalReg Int
    addUsage UniqFM LocalReg Int
    usages CmmExpr
    rhs

            discard :: (CmmNode O x, Assignments)
    discard = UniqFM LocalReg Int
    -> LRegSet
    -> CmmNode O x
    -> LRegSet
    -> Assignments
    -> (CmmNode O x, Assignments)
    go UniqFM LocalReg Int
    usages LRegSet
    live CmmNode O x
    node LRegSet
    skipped Assignments
    rest

            dont_inline :: (CmmNode O x, Assignments)
    dont_inline        = CmmNode O x -> (CmmNode O x, Assignments)
    keep CmmNode O x
    node  -- don't inline the assignment, keep it
            inline_and_keep :: (CmmNode O x, Assignments)
    inline_and_keep    = CmmNode O x -> (CmmNode O x, Assignments)
    keep CmmNode O x
    inl_node -- inline the assignment, keep it

            keep :: CmmNode O x -> (CmmNode O x, Assignments)
            keep :: CmmNode O x -> (CmmNode O x, Assignments)
    keep CmmNode O x
    node' = (CmmNode O x
    final_node, Assignment
    a forall a. a -> [a] -> [a]
    : Assignments
    rest')
              where (CmmNode O x
    final_node, Assignments
    rest') = UniqFM LocalReg Int
    -> LRegSet
    -> CmmNode O x
    -> LRegSet
    -> Assignments
    -> (CmmNode O x, Assignments)
    go UniqFM LocalReg Int
    usages LRegSet
    live' CmmNode O x
    node' (LocalReg -> LRegSet -> LRegSet
    insertLRegSet LocalReg
    l LRegSet
    skipped) Assignments
    rest

                    -- Avoid discarding of assignments to vars on the rhs.
                    -- See Note [Keeping assignemnts mentioned in skipped RHSs]
                    -- usages' = foldLocalRegsUsed platform (\m r -> addToUFM m r 2)
                                                -- usages rhs
                    live' :: LRegSet
    live' = forall a. a -> a
    inline forall a b.
    UserOfRegs LocalReg a =>
    Platform -> (b -> LocalReg -> b) -> b -> a -> b
    foldLocalRegsUsed Platform
    platform (\LRegSet
    m LocalReg
    r -> LocalReg -> LRegSet -> LRegSet
    insertLRegSet LocalReg
    r LRegSet
    m)
                                                LRegSet
    live CmmExpr
    rhs

            cannot_inline :: Bool
    cannot_inline = LRegSet
    skipped LRegSet -> CmmExpr -> Bool
    `regsUsedIn` CmmExpr
    rhs -- Note [dependent assignments]
                            Bool -> Bool -> Bool
    || LocalReg
    l LocalReg -> LRegSet -> Bool
    `elemLRegSet` LRegSet
    skipped
                            Bool -> Bool -> Bool
    || Bool -> Bool
    not (forall (e :: Extensibility) (x :: Extensibility).
    Platform -> CmmExpr -> CmmNode e x -> Bool
    okToInline Platform
    platform CmmExpr
    rhs CmmNode O x
    node)

            -- How often is l used in the current node.
            l_usages :: Maybe Int
    l_usages = forall key elt. Uniquable key => UniqFM key elt -> key -> Maybe elt
    lookupUFM UniqFM LocalReg Int
    usages LocalReg
    l
            l_live :: Bool
    l_live   = LocalReg
    l LocalReg -> LRegSet -> Bool
    `elemLRegSet` LRegSet
    live

            occurs_once :: Bool
    occurs_once = Bool -> Bool
    not Bool
    l_live Bool -> Bool -> Bool
    && Maybe Int
    l_usages forall a. Eq a => a -> a -> Bool
    == forall a. a -> Maybe a
    Just Int
    1
            occurs_none :: Bool
    occurs_none = Bool -> Bool
    not Bool
    l_live Bool -> Bool -> Bool
    && Maybe Int
    l_usages forall a. Eq a => a -> a -> Bool
    == forall a. Maybe a
    Nothing

            inl_node :: CmmNode O x
    inl_node = forall (x :: Extensibility). CmmNode O x -> CmmNode O x
    improveConditional (forall (e :: Extensibility) (x :: Extensibility).
    (CmmExpr -> CmmExpr) -> CmmNode e x -> CmmNode e x
    mapExpDeep CmmExpr -> CmmExpr
    inl_exp CmmNode O x
    node)

            inl_exp :: CmmExpr -> CmmExpr
            -- inl_exp is where the inlining actually takes place!
            inl_exp :: CmmExpr -> CmmExpr
    inl_exp (CmmReg    (CmmLocal LocalReg
    l'))     | LocalReg
    l forall a. Eq a => a -> a -> Bool
    == LocalReg
    l' = CmmExpr
    rhs
            inl_exp (CmmRegOff (CmmLocal LocalReg
    l') Int
    off) | LocalReg
    l forall a. Eq a => a -> a -> Bool
    == LocalReg
    l'
                        = Platform -> CmmExpr -> Int -> CmmExpr
    cmmOffset Platform
    platform CmmExpr
    rhs Int
    off
                        -- re-constant fold after inlining
            inl_exp (CmmMachOp MachOp
    op [CmmExpr]
    args) = Platform -> MachOp -> [CmmExpr] -> CmmExpr
    cmmMachOpFold Platform
    platform MachOp
    op [CmmExpr]
    args
            inl_exp CmmExpr
    other = CmmExpr
    other

    {- Note [Keeping assignemnts mentioned in skipped RHSs]
        ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

        If we have to assignments: [z = y, y = e1] and we skip
        z we *must* retain the assignment y = e1. This is because
        we might inline "z = y" into another node later on so we
        must ensure y is still defined at this point.

        If we dropped the assignment of "y = e1" then we would end up
        referencing a variable which hasn't been mentioned after
        inlining.

        We use a hack to do this.

        We pretend the regs from the rhs are live after the current
        node. Since we only discard assignments to variables
        which are dead after the current block this prevents discarding of the
        assignment. It still allows inlining should e1 be a trivial rhs
        however.

    -}

    {- Note [improveConditional]

    cmmMachOpFold tries to simplify conditionals to turn things like
      (a == b) != 1
    into
      (a != b)
    but there's one case it can't handle: when the comparison is over
    floating-point values, we can't invert it, because floating-point
    comparisons aren't invertible (because of NaNs).

    But we *can* optimise this conditional by swapping the true and false
    branches. Given
      CmmCondBranch ((a >## b) != 1) t f
    we can turn it into
      CmmCondBranch (a >## b) f t

    So here we catch conditionals that weren't optimised by cmmMachOpFold,
    and apply above transformation to eliminate the comparison against 1.

    It's tempting to just turn every != into == and then let cmmMachOpFold
    do its thing, but that risks changing a nice fall-through conditional
    into one that requires two jumps. (see swapcond_last in
    GHC.Cmm.ContFlowOpt), so instead we carefully look for just the cases where
    we can eliminate a comparison.
    -}
    improveConditional :: CmmNode O x -> CmmNode O x
    improveConditional :: forall (x :: Extensibility). CmmNode O x -> CmmNode O x
    improveConditional
      (CmmCondBranch (CmmMachOp MachOp
    mop [CmmExpr
    x, CmmLit (CmmInt Integer
    1 Width
    _)]) BlockId
    t BlockId
    f Maybe Bool
    l)
      | MachOp -> Bool
    neLike MachOp
    mop, CmmExpr -> Bool
    isComparisonExpr CmmExpr
    x
      = CmmExpr -> BlockId -> BlockId -> Maybe Bool -> CmmNode O C
    CmmCondBranch CmmExpr
    x BlockId
    f BlockId
    t (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap Bool -> Bool
    not Maybe Bool
    l)
      where
        neLike :: MachOp -> Bool
    neLike (MO_Ne Width
    _) = Bool
    True
        neLike (MO_U_Lt Width
    _) = Bool
    True   -- (x<y) < 1 behaves like (x<y) != 1
        neLike (MO_S_Lt Width
    _) = Bool
    True   -- (x<y) < 1 behaves like (x<y) != 1
        neLike MachOp
    _ = Bool
    False
    improveConditional CmmNode O x
    other = CmmNode O x
    other

    -- Note [dependent assignments]
    -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    --
    -- If our assignment list looks like
    --
    --    [ y = e,  x = ... y ... ]
    --
    -- We cannot inline x.  Remember this list is really in reverse order,
    -- so it means  x = ... y ...; y = e
    --
    -- Hence if we inline x, the outer assignment to y will capture the
    -- reference in x's right hand side.
    --
    -- In this case we should rename the y in x's right-hand side,
    -- i.e. change the list to [ y = e, x = ... y1 ..., y1 = y ]
    -- Now we can go ahead and inline x.
    --
    -- For now we do nothing, because this would require putting
    -- everything inside UniqSM.
    --
    -- One more variant of this (#7366):
    --
    --   [ y = e, y = z ]
    --
    -- If we don't want to inline y = e, because y is used many times, we
    -- might still be tempted to inline y = z (because we always inline
    -- trivial rhs's).  But of course we can't, because y is equal to e,
    -- not z.

    -- Note [discard during inlining]
    -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    -- Opportunities to discard assignments sometimes appear after we've
    -- done some inlining.  Here's an example:
    --
    --      x = R1;
    --      y = P64[x + 7];
    --      z = P64[x + 15];
    --      /* z is dead */
    --      R1 = y & (-8);
    --
    -- The x assignment is trivial, so we inline it in the RHS of y, and
    -- keep both x and y.  z gets dropped because it is dead, then we
    -- inline y, and we have a dead assignment to x.  If we don't notice
    -- that x is dead in tryToInline, we end up retaining it.

    addUsage :: UniqFM LocalReg Int -> LocalReg -> UniqFM LocalReg Int
    addUsage :: UniqFM LocalReg Int -> LocalReg -> UniqFM LocalReg Int
    addUsage UniqFM LocalReg Int
    m LocalReg
    r = forall key elt.
    Uniquable key =>
    (elt -> elt -> elt)
    -> UniqFM key elt -> key -> elt -> UniqFM key elt
    addToUFM_C forall a. Num a => a -> a -> a
    (+) UniqFM LocalReg Int
    m LocalReg
    r Int
    1

    regsUsedIn :: LRegSet -> CmmExpr -> Bool
    regsUsedIn :: LRegSet -> CmmExpr -> Bool
    regsUsedIn LRegSet
    ls CmmExpr
    _ | LRegSet -> Bool
    nullLRegSet LRegSet
    ls = Bool
    False
    regsUsedIn LRegSet
    ls CmmExpr
    e = LRegSet -> CmmExpr -> Bool -> Bool
    go LRegSet
    ls CmmExpr
    e Bool
    False
      where use :: LRegSet -> CmmExpr -> Bool -> Bool
            use :: LRegSet -> CmmExpr -> Bool -> Bool
    use LRegSet
    ls (CmmReg (CmmLocal LocalReg
    l))      Bool
    _ | LocalReg
    l LocalReg -> LRegSet -> Bool
    `elemLRegSet` LRegSet
    ls = Bool
    True
            use LRegSet
    ls (CmmRegOff (CmmLocal LocalReg
    l) Int
    _) Bool
    _ | LocalReg
    l LocalReg -> LRegSet -> Bool
    `elemLRegSet` LRegSet
    ls = Bool
    True
            use LRegSet
    _ls CmmExpr
    _ Bool
    z = Bool
    z

            go :: LRegSet -> CmmExpr -> Bool -> Bool
            go :: LRegSet -> CmmExpr -> Bool -> Bool
    go LRegSet
    ls (CmmMachOp MachOp
    _ [CmmExpr]
    es)   Bool
    z = forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr (LRegSet -> CmmExpr -> Bool -> Bool
    go LRegSet
    ls) Bool
    z [CmmExpr]
    es
            go LRegSet
    ls (CmmLoad CmmExpr
    addr CmmType
    _ AlignmentSpec
    _) Bool
    z = LRegSet -> CmmExpr -> Bool -> Bool
    go LRegSet
    ls CmmExpr
    addr Bool
    z
            go LRegSet
    ls CmmExpr
    e                  Bool
    z = LRegSet -> CmmExpr -> Bool -> Bool
    use LRegSet
    ls CmmExpr
    e Bool
    z

    -- we don't inline into CmmUnsafeForeignCall if the expression refers
    -- to global registers.  This is a HACK to avoid global registers
    -- clashing with C argument-passing registers, really the back-end
    -- ought to be able to handle it properly, but currently neither PprC
    -- nor the NCG can do it.  See Note [Register parameter passing]
    -- See also GHC.StgToCmm.Foreign.load_args_into_temps.
    okToInline :: Platform -> CmmExpr -> CmmNode e x -> Bool
    okToInline :: forall (e :: Extensibility) (x :: Extensibility).
    Platform -> CmmExpr -> CmmNode e x -> Bool
    okToInline Platform
    platform CmmExpr
    expr node :: CmmNode e x
    node@(CmmUnsafeForeignCall{}) =
        Bool -> Bool
    not (forall (e :: Extensibility) (x :: Extensibility).
    Platform -> CmmExpr -> CmmNode e x -> Bool
    globalRegistersConflict Platform
    platform CmmExpr
    expr CmmNode e x
    node)
    okToInline Platform
    _ CmmExpr
    _ CmmNode e x
    _ = Bool
    True

    -- -----------------------------------------------------------------------------

    -- | @conflicts (r,e) node@ is @False@ if and only if the assignment
    -- @r = e@ can be safely commuted past statement @node@.
    conflicts :: Platform -> Assignment -> CmmNode O x -> Bool
    conflicts :: forall (x :: Extensibility).
    Platform -> Assignment -> CmmNode O x -> Bool
    conflicts Platform
    platform (LocalReg
    r, CmmExpr
    rhs, AbsMem
    addr) CmmNode O x
    node

      -- (1) node defines registers used by rhs of assignment. This catches
      -- assignments and all three kinds of calls. See Note [Sinking and calls]
      | forall (e :: Extensibility) (x :: Extensibility).
    Platform -> CmmExpr -> CmmNode e x -> Bool
    globalRegistersConflict Platform
    platform CmmExpr
    rhs CmmNode O x
    node                       = Bool
    True
      | forall (e :: Extensibility) (x :: Extensibility).
    Platform -> CmmExpr -> CmmNode e x -> Bool
    localRegistersConflict  Platform
    platform CmmExpr
    rhs CmmNode O x
    node                       = Bool
    True

      -- (2) node uses register defined by assignment
      | forall r a b.
    UserOfRegs r a =>
    Platform -> (b -> r -> b) -> b -> a -> b
    foldRegsUsed Platform
    platform (\Bool
    b LocalReg
    r' -> LocalReg
    r forall a. Eq a => a -> a -> Bool
    == LocalReg
    r' Bool -> Bool -> Bool
    || Bool
    b) Bool
    False CmmNode O x
    node        = Bool
    True

      -- (3) a store to an address conflicts with a read of the same memory
      | CmmStore CmmExpr
    addr' CmmExpr
    e AlignmentSpec
    _ <- CmmNode O x
    node
      , AbsMem -> AbsMem -> Bool
    memConflicts AbsMem
    addr (Platform -> CmmExpr -> Width -> AbsMem
    loadAddr Platform
    platform CmmExpr
    addr' (Platform -> CmmExpr -> Width
    cmmExprWidth Platform
    platform CmmExpr
    e)) = Bool
    True

      -- (4) an assignment to Hp/Sp conflicts with a heap/stack read respectively
      | AbsMem
    HeapMem    <- AbsMem
    addr, CmmAssign (CmmGlobal GlobalReg
    Hp) CmmExpr
    _ <- CmmNode O x
    node        = Bool
    True
      | AbsMem
    StackMem   <- AbsMem
    addr, CmmAssign (CmmGlobal GlobalReg
    Sp) CmmExpr
    _ <- CmmNode O x
    node        = Bool
    True
      | SpMem{}    <- AbsMem
    addr, CmmAssign (CmmGlobal GlobalReg
    Sp) CmmExpr
    _ <- CmmNode O x
    node        = Bool
    True

      -- (5) foreign calls clobber heap: see Note [Foreign calls clobber heap]
      | CmmUnsafeForeignCall{} <- CmmNode O x
    node, AbsMem -> AbsMem -> Bool
    memConflicts AbsMem
    addr AbsMem
    AnyMem      = Bool
    True

      -- (6) native calls clobber any memory
      | CmmCall{} <- CmmNode O x
    node, AbsMem -> AbsMem -> Bool
    memConflicts AbsMem
    addr AbsMem
    AnyMem                   = Bool
    True

      -- (7) otherwise, no conflict
      | Bool
    otherwise = Bool
    False

    {- Note [Inlining foldRegsDefd]
       ~~~~~~~~~~~~~~~~~~~~~~~~~~~~

       foldRegsDefd is, after optimization, *not* a small function so
       it's only marked INLINEABLE, but not INLINE.

       However in some specific cases we call it *very* often making it
       important to avoid the overhead of allocating the folding function.

       So we simply force inlining via the magic inline function.
       For T3294 this improves allocation with -O by ~1%.

    -}

    -- Returns True if node defines any global registers that are used in the
    -- Cmm expression
    globalRegistersConflict :: Platform -> CmmExpr -> CmmNode e x -> Bool
    globalRegistersConflict :: forall (e :: Extensibility) (x :: Extensibility).
    Platform -> CmmExpr -> CmmNode e x -> Bool
    globalRegistersConflict Platform
    platform CmmExpr
    expr CmmNode e x
    node =
        -- See Note [Inlining foldRegsDefd]
        forall a. a -> a
    inline forall r a b.
    DefinerOfRegs r a =>
    Platform -> (b -> r -> b) -> b -> a -> b
    foldRegsDefd Platform
    platform (\Bool
    b GlobalReg
    r -> Bool
    b Bool -> Bool -> Bool
    || Platform -> CmmReg -> CmmExpr -> Bool
    regUsedIn Platform
    platform (GlobalReg -> CmmReg
    CmmGlobal GlobalReg
    r) CmmExpr
    expr)
                     Bool
    False CmmNode e x
    node

    -- Returns True if node defines any local registers that are used in the
    -- Cmm expression
    localRegistersConflict :: Platform -> CmmExpr -> CmmNode e x -> Bool
    localRegistersConflict :: forall (e :: Extensibility) (x :: Extensibility).
    Platform -> CmmExpr -> CmmNode e x -> Bool
    localRegistersConflict Platform
    platform CmmExpr
    expr CmmNode e x
    node =
        -- See Note [Inlining foldRegsDefd]
        forall a. a -> a
    inline forall r a b.
    DefinerOfRegs r a =>
    Platform -> (b -> r -> b) -> b -> a -> b
    foldRegsDefd Platform
    platform (\Bool
    b LocalReg
    r -> Bool
    b Bool -> Bool -> Bool
    || Platform -> CmmReg -> CmmExpr -> Bool
    regUsedIn Platform
    platform (LocalReg -> CmmReg
    CmmLocal  LocalReg
    r) CmmExpr
    expr)
                     Bool
    False CmmNode e x
    node

    -- Note [Sinking and calls]
    -- ~~~~~~~~~~~~~~~~~~~~~~~~
    --
    -- We have three kinds of calls: normal (CmmCall), safe foreign (CmmForeignCall)
    -- and unsafe foreign (CmmUnsafeForeignCall). We perform sinking pass after
    -- stack layout (see Note [Sinking after stack layout]) which leads to two
    -- invariants related to calls:
    --
    --   a) during stack layout phase all safe foreign calls are turned into
    --      unsafe foreign calls (see Note [Lower safe foreign calls]). This
    --      means that we will never encounter CmmForeignCall node when running
    --      sinking after stack layout
    --
    --   b) stack layout saves all variables live across a call on the stack
    --      just before making a call (remember we are not sinking assignments to
    --      stack):
    --
    --       L1:
    --          x = R1
    --          P64[Sp - 16] = L2
    --          P64[Sp - 8]  = x
    --          Sp = Sp - 16
    --          call f() returns L2
    --       L2:
    --
    --      We will attempt to sink { x = R1 } but we will detect conflict with
    --      { P64[Sp - 8]  = x } and hence we will drop { x = R1 } without even
    --      checking whether it conflicts with { call f() }. In this way we will
    --      never need to check any assignment conflicts with CmmCall. Remember
    --      that we still need to check for potential memory conflicts.
    --
    -- So the result is that we only need to worry about CmmUnsafeForeignCall nodes
    -- when checking conflicts (see Note [Unsafe foreign calls clobber caller-save registers]).
    -- This assumption holds only when we do sinking after stack layout. If we run
    -- it before stack layout we need to check for possible conflicts with all three
    -- kinds of calls. Our `conflicts` function does that by using a generic
    -- foldRegsDefd and foldRegsUsed functions defined in DefinerOfRegs and
    -- UserOfRegs typeclasses.
    --

    -- An abstraction of memory read or written.
    data AbsMem
      = NoMem            -- no memory accessed
      | AnyMem           -- arbitrary memory
      | HeapMem          -- definitely heap memory
      | StackMem         -- definitely stack memory
      | SpMem            -- <size>[Sp+n]
           {-# UNPACK #-} !Int
           {-# UNPACK #-} !Int

    -- Having SpMem is important because it lets us float loads from Sp
    -- past stores to Sp as long as they don't overlap, and this helps to
    -- unravel some long sequences of
    --    x1 = [Sp + 8]
    --    x2 = [Sp + 16]
    --    ...
    --    [Sp + 8]  = xi
    --    [Sp + 16] = xj
    --
    -- Note that SpMem is invalidated if Sp is changed, but the definition
    -- of 'conflicts' above handles that.

    -- ToDo: this won't currently fix the following commonly occurring code:
    --    x1 = [R1 + 8]
    --    x2 = [R1 + 16]
    --    ..
    --    [Hp - 8] = x1
    --    [Hp - 16] = x2
    --    ..

    -- because [R1 + 8] and [Hp - 8] are both HeapMem.  We know that
    -- assignments to [Hp + n] do not conflict with any other heap memory,
    -- but this is tricky to nail down.  What if we had
    --
    --   x = Hp + n
    --   [x] = ...
    --
    --  the store to [x] should be "new heap", not "old heap".
    --  Furthermore, you could imagine that if we started inlining
    --  functions in Cmm then there might well be reads of heap memory
    --  that was written in the same basic block.  To take advantage of
    --  non-aliasing of heap memory we will have to be more clever.

    -- Note [Foreign calls clobber heap]
    -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    --
    -- It is tempting to say that foreign calls clobber only
    -- non-heap/stack memory, but unfortunately we break this invariant in
    -- the RTS.  For example, in stg_catch_retry_frame we call
    -- stmCommitNestedTransaction() which modifies the contents of the
    -- TRec it is passed (this actually caused incorrect code to be
    -- generated).
    --
    -- Since the invariant is true for the majority of foreign calls,
    -- perhaps we ought to have a special annotation for calls that can
    -- modify heap/stack memory.  For now we just use the conservative
    -- definition here.
    --
    -- Some CallishMachOp imply a memory barrier e.g. AtomicRMW and
    -- therefore we should never float any memory operations across one of
    -- these calls.

    bothMems :: AbsMem -> AbsMem -> AbsMem
    bothMems :: AbsMem -> AbsMem -> AbsMem
    bothMems AbsMem
    NoMem    AbsMem
    x         = AbsMem
    x
    bothMems AbsMem
    x        AbsMem
    NoMem     = AbsMem
    x
    bothMems AbsMem
    HeapMem  AbsMem
    HeapMem   = AbsMem
    HeapMem
    bothMems AbsMem
    StackMem AbsMem
    StackMem     = AbsMem
    StackMem
    bothMems (SpMem Int
    o1 Int
    w1) (SpMem Int
    o2 Int
    w2)
      | Int
    o1 forall a. Eq a => a -> a -> Bool
    == Int
    o2  = Int -> Int -> AbsMem
    SpMem Int
    o1 (forall a. Ord a => a -> a -> a
    max Int
    w1 Int
    w2)
      | Bool
    otherwise = AbsMem
    StackMem
    bothMems SpMem{}  AbsMem
    StackMem  = AbsMem
    StackMem
    bothMems AbsMem
    StackMem SpMem{}   = AbsMem
    StackMem
    bothMems AbsMem
    _         AbsMem
    _        = AbsMem
    AnyMem

    memConflicts :: AbsMem -> AbsMem -> Bool
    memConflicts :: AbsMem -> AbsMem -> Bool
    memConflicts AbsMem
    NoMem      AbsMem
    _          = Bool
    False
    memConflicts AbsMem
    _          AbsMem
    NoMem      = Bool
    False
    memConflicts AbsMem
    HeapMem    AbsMem
    StackMem   = Bool
    False
    memConflicts AbsMem
    StackMem   AbsMem
    HeapMem    = Bool
    False
    memConflicts SpMem{}    AbsMem
    HeapMem    = Bool
    False
    memConflicts AbsMem
    HeapMem    SpMem{}    = Bool
    False
    memConflicts (SpMem Int
    o1 Int
    w1) (SpMem Int
    o2 Int
    w2)
      | Int
    o1 forall a. Ord a => a -> a -> Bool
    < Int
    o2   = Int
    o1 forall a. Num a => a -> a -> a
    + Int
    w1 forall a. Ord a => a -> a -> Bool
    > Int
    o2
      | Bool
    otherwise = Int
    o2 forall a. Num a => a -> a -> a
    + Int
    w2 forall a. Ord a => a -> a -> Bool
    > Int
    o1
    memConflicts AbsMem
    _         AbsMem
    _         = Bool
    True

    exprMem :: Platform -> CmmExpr -> AbsMem
    exprMem :: Platform -> CmmExpr -> AbsMem
    exprMem Platform
    platform (CmmLoad CmmExpr
    addr CmmType
    w AlignmentSpec
    _)  = AbsMem -> AbsMem -> AbsMem
    bothMems (Platform -> CmmExpr -> Width -> AbsMem
    loadAddr Platform
    platform CmmExpr
    addr (CmmType -> Width
    typeWidth CmmType
    w)) (Platform -> CmmExpr -> AbsMem
    exprMem Platform
    platform CmmExpr
    addr)
    exprMem Platform
    platform (CmmMachOp MachOp
    _ [CmmExpr]
    es)    = forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr AbsMem -> AbsMem -> AbsMem
    bothMems AbsMem
    NoMem (forall a b. (a -> b) -> [a] -> [b]
    map (Platform -> CmmExpr -> AbsMem
    exprMem Platform
    platform) [CmmExpr]
    es)
    exprMem Platform
    _        CmmExpr
    _                   = AbsMem
    NoMem

    loadAddr :: Platform -> CmmExpr -> Width -> AbsMem
    loadAddr :: Platform -> CmmExpr -> Width -> AbsMem
    loadAddr Platform
    platform CmmExpr
    e Width
    w =
      case CmmExpr
    e of
       CmmReg CmmReg
    r       -> Platform -> CmmReg -> Int -> Width -> AbsMem
    regAddr Platform
    platform CmmReg
    r Int
    0 Width
    w
       CmmRegOff CmmReg
    r Int
    i  -> Platform -> CmmReg -> Int -> Width -> AbsMem
    regAddr Platform
    platform CmmReg
    r Int
    i Width
    w
       CmmExpr
    _other | Platform -> CmmReg -> CmmExpr -> Bool
    regUsedIn Platform
    platform CmmReg
    spReg CmmExpr
    e -> AbsMem
    StackMem
              | Bool
    otherwise                  -> AbsMem
    AnyMem

    regAddr :: Platform -> CmmReg -> Int -> Width -> AbsMem
    regAddr :: Platform -> CmmReg -> Int -> Width -> AbsMem
    regAddr Platform
    _      (CmmGlobal GlobalReg
    Sp) Int
    i Width
    w = Int -> Int -> AbsMem
    SpMem Int
    i (Width -> Int
    widthInBytes Width
    w)
    regAddr Platform
    _      (CmmGlobal GlobalReg
    Hp) Int
    _ Width
    _ = AbsMem
    HeapMem
    regAddr Platform
    _      (CmmGlobal GlobalReg
    CurrentTSO) Int
    _ Width
    _ = AbsMem
    HeapMem -- important for PrimOps
    regAddr Platform
    platform CmmReg
    r Int
    _ Width
    _ | CmmType -> Bool
    isGcPtrType (Platform -> CmmReg -> CmmType
    cmmRegType Platform
    platform CmmReg
    r) = AbsMem
    HeapMem -- yay! GCPtr pays for itself
    regAddr Platform
    _      CmmReg
    _ Int
    _ Width
    _ = AbsMem
    AnyMem

    {-
    Note [Inline GlobalRegs?]
    ~~~~~~~~~~~~~~~~~~~~~~~~~

    Should we freely inline GlobalRegs?

    Actually it doesn't make a huge amount of difference either way, so we
    *do* currently treat GlobalRegs as "trivial" and inline them
    everywhere, but for what it's worth, here is what I discovered when I
    (SimonM) looked into this:

    Common sense says we should not inline GlobalRegs, because when we
    have

      x = R1

    the register allocator will coalesce this assignment, generating no
    code, and simply record the fact that x is bound to $rbx (or
    whatever).  Furthermore, if we were to sink this assignment, then the
    range of code over which R1 is live increases, and the range of code
    over which x is live decreases.  All things being equal, it is better
    for x to be live than R1, because R1 is a fixed register whereas x can
    live in any register.  So we should neither sink nor inline 'x = R1'.

    However, not inlining GlobalRegs can have surprising
    consequences. e.g. (cgrun020)

      c3EN:
          _s3DB::P64 = R1;
          _c3ES::P64 = _s3DB::P64 & 7;
          if (_c3ES::P64 >= 2) goto c3EU; else goto c3EV;
      c3EU:
          _s3DD::P64 = P64[_s3DB::P64 + 6];
          _s3DE::P64 = P64[_s3DB::P64 + 14];
          I64[Sp - 8] = c3F0;
          R1 = _s3DE::P64;
          P64[Sp] = _s3DD::P64;

    inlining the GlobalReg gives:

      c3EN:
          if (R1 & 7 >= 2) goto c3EU; else goto c3EV;
      c3EU:
          I64[Sp - 8] = c3F0;
          _s3DD::P64 = P64[R1 + 6];
          R1 = P64[R1 + 14];
          P64[Sp] = _s3DD::P64;

    but if we don't inline the GlobalReg, instead we get:

          _s3DB::P64 = R1;
          if (_s3DB::P64 & 7 >= 2) goto c3EU; else goto c3EV;
      c3EU:
          I64[Sp - 8] = c3F0;
          R1 = P64[_s3DB::P64 + 14];
          P64[Sp] = P64[_s3DB::P64 + 6];

    This looks better - we managed to inline _s3DD - but in fact it
    generates an extra reg-reg move:

    .Lc3EU:
            movq $c3F0_info,-8(%rbp)
            movq %rbx,%rax
            movq 14(%rbx),%rbx
            movq 6(%rax),%rax
            movq %rax,(%rbp)

    because _s3DB is now live across the R1 assignment, we lost the
    benefit of coalescing.

    Who is at fault here?  Perhaps if we knew that _s3DB was an alias for
    R1, then we would not sink a reference to _s3DB past the R1
    assignment.  Or perhaps we *should* do that - we might gain by sinking
    it, despite losing the coalescing opportunity.

    Sometimes not inlining global registers wins by virtue of the rule
    about not inlining into arguments of a foreign call, e.g. (T7163) this
    is what happens when we inlined F1:

          _s3L2::F32 = F1;
          _c3O3::F32 = %MO_F_Mul_W32(F1, 10.0 :: W32);
          (_s3L7::F32) = call "ccall" arg hints:  []  result hints:  [] rintFloat(_c3O3::F32);

    but if we don't inline F1:

          (_s3L7::F32) = call "ccall" arg hints:  []  result hints:  [] rintFloat(%MO_F_Mul_W32(_s3L2::F32,
                                                                                                10.0 :: W32));
    -}