    {-# LANGUAGE CPP #-}
    {-# LANGUAGE GADTs #-}
    {-# LANGUAGE UndecidableInstances #-}
    {-# LANGUAGE LambdaCase #-}

    -- CmmNode type for representation using Hoopl graphs.

    module GHC.Cmm.Node (
         CmmNode(..), CmmFormal, CmmActual, CmmTickish,
         UpdFrameOffset, Convention(..),
         ForeignConvention(..), ForeignTarget(..), foreignTargetHints,
         CmmReturnInfo(..),
         mapExp, mapExpDeep, wrapRecExp, foldExp, foldExpDeep, wrapRecExpf,
         mapExpM, mapExpDeepM, wrapRecExpM, mapSuccessors, mapCollectSuccessors,

         -- * Tick scopes
         CmmTickScope(..), isTickSubScope, combineTickScopes,
      ) where

    import GHC.Prelude hiding (succ)

    import GHC.Platform.Regs
    import GHC.Cmm.CLabel
    import GHC.Cmm.Expr
    import GHC.Cmm.Switch
    import GHC.Data.FastString
    import GHC.Data.Pair
    import GHC.Types.ForeignCall
    import GHC.Utils.Outputable
    import GHC.Runtime.Heap.Layout
    import GHC.Types.Tickish (CmmTickish)
    import qualified GHC.Types.Unique as U
    import GHC.Types.Basic (FunctionOrData(..))

    import GHC.Platform
    import GHC.Cmm.Dataflow.Block
    import GHC.Cmm.Dataflow.Graph
    import GHC.Cmm.Dataflow.Label
    import Data.Foldable (toList)
    import Data.Functor.Classes (liftCompare)
    import Data.Maybe
    import Data.List (tails,sortBy)
    import GHC.Types.Unique (nonDetCmpUnique)
    import GHC.Utils.Constants (debugIsOn)

    ------------------------
    -- CmmNode

    #define ULabel {-# UNPACK #-} !Label

    data CmmNode e x where
      CmmEntry :: ULabel -> CmmTickScope -> CmmNode C O

      CmmComment :: FastString -> CmmNode O O

        -- Tick annotation, covering Cmm code in our tick scope. We only
        -- expect non-code @Tickish@ at this point (e.g. @SourceNote@).
        -- See Note [CmmTick scoping details]
      CmmTick :: !CmmTickish -> CmmNode O O

        -- Unwind pseudo-instruction, encoding stack unwinding
        -- instructions for a debugger. This describes how to reconstruct
        -- the "old" value of a register if we want to navigate the stack
        -- up one frame. Having unwind information for @Sp@ will allow the
        -- debugger to "walk" the stack.
        --
        -- See Note [What is this unwinding business?] in "GHC.Cmm.DebugBlock"
      CmmUnwind :: [(GlobalReg, Maybe CmmExpr)] -> CmmNode O O

      CmmAssign :: !CmmReg -> !CmmExpr -> CmmNode O O
        -- Assign to register

      CmmStore :: !CmmExpr -> !CmmExpr -> !AlignmentSpec -> CmmNode O O
        -- Assign to memory location.  Size is
        -- given by cmmExprType of the rhs.

      CmmUnsafeForeignCall ::       -- An unsafe foreign call;
                                    -- see Note [Foreign calls]
                                    -- Like a "fat machine instruction"; can occur
                                    -- in the middle of a block
          ForeignTarget ->          -- call target
          [CmmFormal] ->            -- zero or more results
          [CmmActual] ->            -- zero or more arguments
          CmmNode O O
          -- Semantics: clobbers any GlobalRegs for which callerSaves r == True
          -- See Note [Unsafe foreign calls clobber caller-save registers]
          --
          -- Invariant: the arguments and the ForeignTarget must not
          -- mention any registers for which GHC.Platform.callerSaves
          -- is True.  See Note [Register parameter passing].

      CmmBranch :: ULabel -> CmmNode O C
                                       -- Goto another block in the same procedure

      CmmCondBranch :: {                 -- conditional branch
          CmmNode 'Open 'Closed -> CmmExpr
    cml_pred :: CmmExpr,
          CmmNode 'Open 'Closed -> Label
    cml_true, CmmNode 'Open 'Closed -> Label
    cml_false :: ULabel,
          CmmNode 'Open 'Closed -> Maybe Bool
    cml_likely :: Maybe Bool       -- likely result of the conditional,
                                         -- if known
      } -> CmmNode O C

      CmmSwitch
        :: CmmExpr       -- Scrutinee, of some integral type
        -> SwitchTargets -- Cases. See Note [SwitchTargets]
        -> CmmNode O C

      CmmCall :: {                -- A native call or tail call
          CmmNode 'Open 'Closed -> CmmExpr
    cml_target :: CmmExpr,  -- never a CmmPrim to a CallishMachOp!

          CmmNode 'Open 'Closed -> Maybe Label
    cml_cont :: Maybe Label,
              -- Label of continuation (Nothing for return or tail call)
              --
              -- Note [Continuation BlockIds]
              -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~
              -- These BlockIds are called
              -- Continuation BlockIds, and are the only BlockIds that can
              -- occur in CmmExprs, namely as (CmmLit (CmmBlock b)) or
              -- (CmmStackSlot (Young b) _).

          CmmNode 'Open 'Closed -> [GlobalRegUse]
    cml_args_regs :: [GlobalRegUse],
              -- The argument GlobalRegs (Rx, Fx, Dx, Lx) that are passed
              -- to the call.  This is essential information for the
              -- native code generator's register allocator; without
              -- knowing which GlobalRegs are live it has to assume that
              -- they are all live.  This list should only include
              -- GlobalRegs that are mapped to real machine registers on
              -- the target platform.

          CmmNode 'Open 'Closed -> ByteOff
    cml_args :: ByteOff,
              -- Byte offset, from the *old* end of the Area associated with
              -- the Label (if cml_cont = Nothing, then Old area), of
              -- youngest outgoing arg.  Set the stack pointer to this before
              -- transferring control.
              -- (NB: an update frame might also have been stored in the Old
              --      area, but it'll be in an older part than the args.)

          CmmNode 'Open 'Closed -> ByteOff
    cml_ret_args :: ByteOff,
              -- For calls *only*, the byte offset for youngest returned value
              -- This is really needed at the *return* point rather than here
              -- at the call, but in practice it's convenient to record it here.

          CmmNode 'Open 'Closed -> ByteOff
    cml_ret_off :: ByteOff
            -- For calls *only*, the byte offset of the base of the frame that
            -- must be described by the info table for the return point.
            -- The older words are an update frames, which have their own
            -- info-table and layout information

            -- From a liveness point of view, the stack words older than
            -- cml_ret_off are treated as live, even if the sequel of
            -- the call goes into a loop.
      } -> CmmNode O C

      CmmForeignCall :: {           -- A safe foreign call; see Note [Foreign calls]
                                    -- Always the last node of a block
          CmmNode 'Open 'Closed -> ForeignTarget
    tgt   :: ForeignTarget,   -- call target and convention
          CmmNode 'Open 'Closed -> [CmmFormal]
    res   :: [CmmFormal],     -- zero or more results
          CmmNode 'Open 'Closed -> [CmmExpr]
    args  :: [CmmActual],     -- zero or more arguments; see Note [Register parameter passing]
          CmmNode 'Open 'Closed -> Label
    succ  :: ULabel,          -- Label of continuation
          CmmNode 'Open 'Closed -> ByteOff
    ret_args :: ByteOff,      -- same as cml_ret_args
          CmmNode 'Open 'Closed -> ByteOff
    ret_off :: ByteOff,       -- same as cml_ret_off
          CmmNode 'Open 'Closed -> Bool
    intrbl:: Bool             -- whether or not the call is interruptible
      } -> CmmNode O C

    instance OutputableP Platform (CmmNode e x) where
        pdoc :: Platform -> CmmNode e x -> SDoc
    pdoc = Platform -> CmmNode e x -> SDoc
    forall (e :: Extensibility) (x :: Extensibility).
    Platform -> CmmNode e x -> SDoc
    pprNode

    pprNode :: Platform -> CmmNode e x -> SDoc
    pprNode :: forall (e :: Extensibility) (x :: Extensibility).
    Platform -> CmmNode e x -> SDoc
    pprNode Platform
    platform CmmNode e x
    node = SDoc
    pp_node SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> SDoc
    pp_debug
      where
        pp_node :: SDoc
        pp_node :: SDoc
    pp_node = case CmmNode e x
    node of
          -- label:
          CmmEntry Label
    id CmmTickScope
    tscope ->
             ((SDocContext -> Bool) -> (Bool -> SDoc) -> SDoc
    forall a. (SDocContext -> a) -> (a -> SDoc) -> SDoc
    sdocOption SDocContext -> Bool
    sdocSuppressUniques ((Bool -> SDoc) -> SDoc) -> (Bool -> SDoc) -> SDoc
    forall a b. (a -> b) -> a -> b
    $ \case
                Bool
    True  -> String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "_lbl_"
                Bool
    False -> Label -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Label
    id
             )
             SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <> SDoc
    forall doc. IsLine doc => doc
    colon
             SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> (SDocContext -> Bool) -> SDoc -> SDoc
    ppUnlessOption SDocContext -> Bool
    sdocSuppressTicks (String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "//" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> CmmTickScope -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr CmmTickScope
    tscope)

          -- // text
          CmmComment FastString
    s -> String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "//" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> FastString -> SDoc
    forall doc. IsLine doc => FastString -> doc
    ftext FastString
    s

          -- //tick bla<...>
          CmmTick CmmTickish
    t -> (SDocContext -> Bool) -> SDoc -> SDoc
    ppUnlessOption SDocContext -> Bool
    sdocSuppressTicks
                         (String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "//tick" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> CmmTickish -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr CmmTickish
    t)

          -- unwind reg = expr;
          CmmUnwind [(GlobalReg, Maybe CmmExpr)]
    regs ->
              String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "unwind "
              SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <> [SDoc] -> SDoc
    commafy (((GlobalReg, Maybe CmmExpr) -> SDoc)
    -> [(GlobalReg, Maybe CmmExpr)] -> [SDoc]
    forall a b. (a -> b) -> [a] -> [b]
    map (\(GlobalReg
    r,Maybe CmmExpr
    e) -> GlobalReg -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr GlobalReg
    r SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> Char -> SDoc
    forall doc. IsLine doc => Char -> doc
    char Char
    '=' SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> Platform -> Maybe CmmExpr -> SDoc
    forall env a. OutputableP env a => env -> a -> SDoc
    pdoc Platform
    platform Maybe CmmExpr
    e) [(GlobalReg, Maybe CmmExpr)]
    regs) SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <> SDoc
    forall doc. IsLine doc => doc
    semi

          -- reg = expr;
          CmmAssign CmmReg
    reg CmmExpr
    expr -> CmmReg -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr CmmReg
    reg SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> SDoc
    forall doc. IsLine doc => doc
    equals SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> Platform -> CmmExpr -> SDoc
    forall env a. OutputableP env a => env -> a -> SDoc
    pdoc Platform
    platform CmmExpr
    expr SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <> SDoc
    forall doc. IsLine doc => doc
    semi

          -- rep[lv] = expr;
          CmmStore CmmExpr
    lv CmmExpr
    expr AlignmentSpec
    align -> SDoc
    rep SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <> SDoc
    align_mark SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc
    brackets (Platform -> CmmExpr -> SDoc
    forall env a. OutputableP env a => env -> a -> SDoc
    pdoc Platform
    platform CmmExpr
    lv) SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> SDoc
    forall doc. IsLine doc => doc
    equals SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> Platform -> CmmExpr -> SDoc
    forall env a. OutputableP env a => env -> a -> SDoc
    pdoc Platform
    platform CmmExpr
    expr SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <> SDoc
    forall doc. IsLine doc => doc
    semi
              where
                align_mark :: SDoc
    align_mark = case AlignmentSpec
    align of
                               AlignmentSpec
    Unaligned -> String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "^"
                               AlignmentSpec
    NaturallyAligned -> SDoc
    forall doc. IsOutput doc => doc
    empty
                rep :: SDoc
    rep = CmmType -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr ( Platform -> CmmExpr -> CmmType
    cmmExprType Platform
    platform CmmExpr
    expr )

          -- call "ccall" foo(x, y)[r1, r2];
          -- ToDo ppr volatile
          CmmUnsafeForeignCall ForeignTarget
    target [CmmFormal]
    results [CmmExpr]
    args ->
              [SDoc] -> SDoc
    forall doc. IsLine doc => [doc] -> doc
    hsep [ Bool -> SDoc -> SDoc
    forall doc. IsOutput doc => Bool -> doc -> doc
    ppUnless ([CmmFormal] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [CmmFormal]
    results) (SDoc -> SDoc) -> SDoc -> SDoc
    forall a b. (a -> b) -> a -> b
    $
                        SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc
    parens ([SDoc] -> SDoc
    commafy ([SDoc] -> SDoc) -> [SDoc] -> SDoc
    forall a b. (a -> b) -> a -> b
    $ (CmmFormal -> SDoc) -> [CmmFormal] -> [SDoc]
    forall a b. (a -> b) -> [a] -> [b]
    map CmmFormal -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr [CmmFormal]
    results) SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> SDoc
    forall doc. IsLine doc => doc
    equals,
                     String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "call",
                     Platform -> ForeignTarget -> SDoc
    forall env a. OutputableP env a => env -> a -> SDoc
    pdoc Platform
    platform ForeignTarget
    target SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc
    parens ([SDoc] -> SDoc
    commafy ([SDoc] -> SDoc) -> [SDoc] -> SDoc
    forall a b. (a -> b) -> a -> b
    $ (CmmExpr -> SDoc) -> [CmmExpr] -> [SDoc]
    forall a b. (a -> b) -> [a] -> [b]
    map (Platform -> CmmExpr -> SDoc
    forall env a. OutputableP env a => env -> a -> SDoc
    pdoc Platform
    platform) [CmmExpr]
    args) SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <> SDoc
    forall doc. IsLine doc => doc
    semi]

          -- goto label;
          CmmBranch Label
    ident -> String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "goto" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> Label -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Label
    ident SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <> SDoc
    forall doc. IsLine doc => doc
    semi

          -- if (expr) goto t; else goto f;
          CmmCondBranch CmmExpr
    expr Label
    t Label
    f Maybe Bool
    l ->
              [SDoc] -> SDoc
    forall doc. IsLine doc => [doc] -> doc
    hsep [ String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "if"
                   , SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc
    parens (Platform -> CmmExpr -> SDoc
    forall env a. OutputableP env a => env -> a -> SDoc
    pdoc Platform
    platform CmmExpr
    expr)
                   , case Maybe Bool
    l of
                       Maybe Bool
    Nothing -> SDoc
    forall doc. IsOutput doc => doc
    empty
                       Just Bool
    b -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc
    parens (String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "likely:" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> Bool -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Bool
    b)
                   , String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "goto"
                   , Label -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Label
    t SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <> SDoc
    forall doc. IsLine doc => doc
    semi
                   , String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "else goto"
                   , Label -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Label
    f SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <> SDoc
    forall doc. IsLine doc => doc
    semi
                   ]

          CmmSwitch CmmExpr
    expr SwitchTargets
    ids ->
              SDoc -> ByteOff -> SDoc -> SDoc
    hang ([SDoc] -> SDoc
    forall doc. IsLine doc => [doc] -> doc
    hsep [ String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "switch"
                         , SDoc
    range
                         , if CmmExpr -> Bool
    isTrivialCmmExpr CmmExpr
    expr
                           then Platform -> CmmExpr -> SDoc
    forall env a. OutputableP env a => env -> a -> SDoc
    pdoc Platform
    platform CmmExpr
    expr
                           else SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc
    parens (Platform -> CmmExpr -> SDoc
    forall env a. OutputableP env a => env -> a -> SDoc
    pdoc Platform
    platform CmmExpr
    expr)
                         , String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "{"
                         ])
                 ByteOff
    4 ([SDoc] -> SDoc
    forall doc. IsDoc doc => [doc] -> doc
    vcat (((NonEmpty Integer, Label) -> SDoc)
    -> [(NonEmpty Integer, Label)] -> [SDoc]
    forall a b. (a -> b) -> [a] -> [b]
    map (NonEmpty Integer, Label) -> SDoc
    forall {t :: * -> *} {a}.
    (Foldable t, Functor t, Outputable a) =>
    (t Integer, a) -> SDoc
    ppCase [(NonEmpty Integer, Label)]
    cases) SDoc -> SDoc -> SDoc
    forall doc. IsDoc doc => doc -> doc -> doc
    $$ SDoc
    def) SDoc -> SDoc -> SDoc
    forall doc. IsDoc doc => doc -> doc -> doc
    $$ SDoc
    forall doc. IsLine doc => doc
    rbrace
              where
                ([(NonEmpty Integer, Label)]
    cases, Maybe Label
    mbdef) = SwitchTargets -> ([(NonEmpty Integer, Label)], Maybe Label)
    switchTargetsFallThrough SwitchTargets
    ids
                ppCase :: (t Integer, a) -> SDoc
    ppCase (t Integer
    is,a
    l) = [SDoc] -> SDoc
    forall doc. IsLine doc => [doc] -> doc
    hsep
                                [ String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "case"
                                , [SDoc] -> SDoc
    commafy ([SDoc] -> SDoc) -> [SDoc] -> SDoc
    forall a b. (a -> b) -> a -> b
    $ t SDoc -> [SDoc]
    forall a. t a -> [a]
    forall (t :: * -> *) a. Foldable t => t a -> [a]
    toList (t SDoc -> [SDoc]) -> t SDoc -> [SDoc]
    forall a b. (a -> b) -> a -> b
    $ (Integer -> SDoc) -> t Integer -> t SDoc
    forall a b. (a -> b) -> t a -> t b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap Integer -> SDoc
    forall doc. IsLine doc => Integer -> doc
    integer t Integer
    is
                                , String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    ": goto"
                                , a -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr a
    l SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <> SDoc
    forall doc. IsLine doc => doc
    semi
                                ]
                def :: SDoc
    def | Just Label
    l <- Maybe Label
    mbdef = [SDoc] -> SDoc
    forall doc. IsLine doc => [doc] -> doc
    hsep
                                [ String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "default:"
                                , SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc
    braces (String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "goto" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> Label -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Label
    l SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <> SDoc
    forall doc. IsLine doc => doc
    semi)
                                ]
                    | Bool
    otherwise = SDoc
    forall doc. IsOutput doc => doc
    empty

                range :: SDoc
    range = SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc
    brackets (SDoc -> SDoc) -> SDoc -> SDoc
    forall a b. (a -> b) -> a -> b
    $ [SDoc] -> SDoc
    forall doc. IsLine doc => [doc] -> doc
    hsep [Integer -> SDoc
    forall doc. IsLine doc => Integer -> doc
    integer Integer
    lo, String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "..", Integer -> SDoc
    forall doc. IsLine doc => Integer -> doc
    integer Integer
    hi]
                  where (Integer
    lo,Integer
    hi) = SwitchTargets -> (Integer, Integer)
    switchTargetsRange SwitchTargets
    ids

          CmmCall CmmExpr
    tgt Maybe Label
    k [GlobalRegUse]
    regs ByteOff
    out ByteOff
    res ByteOff
    updfr_off ->
              [SDoc] -> SDoc
    forall doc. IsLine doc => [doc] -> doc
    hcat [ String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "call", SDoc
    forall doc. IsLine doc => doc
    space
                   , CmmExpr -> SDoc
    pprFun CmmExpr
    tgt, SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc
    parens ([GlobalRegUse] -> SDoc
    forall a. Outputable a => [a] -> SDoc
    interpp'SP [GlobalRegUse]
    regs), SDoc
    forall doc. IsLine doc => doc
    space
                   , SDoc
    returns SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+>
                     String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "args: " SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <> ByteOff -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr ByteOff
    out SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <> SDoc
    forall doc. IsLine doc => doc
    comma SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+>
                     String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "res: " SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <> ByteOff -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr ByteOff
    res SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <> SDoc
    forall doc. IsLine doc => doc
    comma SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+>
                     String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "upd: " SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <> ByteOff -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr ByteOff
    updfr_off
                   , SDoc
    forall doc. IsLine doc => doc
    semi ]
              where pprFun :: CmmExpr -> SDoc
    pprFun f :: CmmExpr
    f@(CmmLit CmmLit
    _) = Platform -> CmmExpr -> SDoc
    forall env a. OutputableP env a => env -> a -> SDoc
    pdoc Platform
    platform CmmExpr
    f
                    pprFun CmmExpr
    f = SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc
    parens (Platform -> CmmExpr -> SDoc
    forall env a. OutputableP env a => env -> a -> SDoc
    pdoc Platform
    platform CmmExpr
    f)

                    returns :: SDoc
    returns
                      | Just Label
    r <- Maybe Label
    k = String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "returns to" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> Label -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Label
    r SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <> SDoc
    forall doc. IsLine doc => doc
    comma
                      | Bool
    otherwise   = SDoc
    forall doc. IsOutput doc => doc
    empty

          CmmForeignCall {tgt :: CmmNode 'Open 'Closed -> ForeignTarget
    tgt=ForeignTarget
    t, res :: CmmNode 'Open 'Closed -> [CmmFormal]
    res=[CmmFormal]
    rs, args :: CmmNode 'Open 'Closed -> [CmmExpr]
    args=[CmmExpr]
    as, succ :: CmmNode 'Open 'Closed -> Label
    succ=Label
    s, ret_args :: CmmNode 'Open 'Closed -> ByteOff
    ret_args=ByteOff
    a, ret_off :: CmmNode 'Open 'Closed -> ByteOff
    ret_off=ByteOff
    u, intrbl :: CmmNode 'Open 'Closed -> Bool
    intrbl=Bool
    i} ->
              [SDoc] -> SDoc
    forall doc. IsLine doc => [doc] -> doc
    hcat ([SDoc] -> SDoc) -> [SDoc] -> SDoc
    forall a b. (a -> b) -> a -> b
    $ if Bool
    i then [String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "interruptible", SDoc
    forall doc. IsLine doc => doc
    space] else [] [SDoc] -> [SDoc] -> [SDoc]
    forall a. [a] -> [a] -> [a]
    ++
                   [ String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "foreign call", SDoc
    forall doc. IsLine doc => doc
    space
                   , Platform -> ForeignTarget -> SDoc
    forall env a. OutputableP env a => env -> a -> SDoc
    pdoc Platform
    platform ForeignTarget
    t, String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "(...)", SDoc
    forall doc. IsLine doc => doc
    space
                   , String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "returns to" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> Label -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Label
    s
                        SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "args:" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc
    parens (Platform -> [CmmExpr] -> SDoc
    forall env a. OutputableP env a => env -> a -> SDoc
    pdoc Platform
    platform [CmmExpr]
    as)
                        SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "ress:" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc
    parens ([CmmFormal] -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr [CmmFormal]
    rs)
                   , String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "ret_args:" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> ByteOff -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr ByteOff
    a
                   , String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "ret_off:" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> ByteOff -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr ByteOff
    u
                   , SDoc
    forall doc. IsLine doc => doc
    semi ]

        pp_debug :: SDoc
        pp_debug :: SDoc
    pp_debug =
          if Bool -> Bool
    not Bool
    debugIsOn then SDoc
    forall doc. IsOutput doc => doc
    empty
          else case CmmNode e x
    node of
                 CmmEntry {}             -> SDoc
    forall doc. IsOutput doc => doc
    empty -- Looks terrible with text "  // CmmEntry"
                 CmmComment {}           -> SDoc
    forall doc. IsOutput doc => doc
    empty -- Looks also terrible with text "  // CmmComment"
                 CmmTick {}              -> SDoc
    forall doc. IsOutput doc => doc
    empty
                 CmmUnwind {}            -> String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "  // CmmUnwind"
                 CmmAssign {}            -> String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "  // CmmAssign"
                 CmmStore {}             -> String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "  // CmmStore"
                 CmmUnsafeForeignCall {} -> String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "  // CmmUnsafeForeignCall"
                 CmmBranch {}            -> String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "  // CmmBranch"
                 CmmCondBranch {}        -> String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "  // CmmCondBranch"
                 CmmSwitch {}            -> String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "  // CmmSwitch"
                 CmmCall {}              -> String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "  // CmmCall"
                 CmmForeignCall {}       -> String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "  // CmmForeignCall"

        commafy :: [SDoc] -> SDoc
        commafy :: [SDoc] -> SDoc
    commafy [SDoc]
    xs = [SDoc] -> SDoc
    forall doc. IsLine doc => [doc] -> doc
    hsep ([SDoc] -> SDoc) -> [SDoc] -> SDoc
    forall a b. (a -> b) -> a -> b
    $ SDoc -> [SDoc] -> [SDoc]
    forall doc. IsLine doc => doc -> [doc] -> [doc]
    punctuate SDoc
    forall doc. IsLine doc => doc
    comma [SDoc]
    xs

    instance OutputableP Platform (Block CmmNode C C) where
        pdoc :: Platform -> Block CmmNode 'Closed 'Closed -> SDoc
    pdoc = Platform -> Block CmmNode 'Closed 'Closed -> SDoc
    Platform
    -> Block CmmNode 'Closed 'Closed -> IndexedCO 'Closed SDoc SDoc
    forall (x :: Extensibility) (e :: Extensibility).
    (IndexedCO x SDoc SDoc ~ SDoc) =>
    Platform -> Block CmmNode e x -> IndexedCO e SDoc SDoc
    pprBlock
    instance OutputableP Platform (Block CmmNode C O) where
        pdoc :: Platform -> Block CmmNode 'Closed 'Open -> SDoc
    pdoc = Platform -> Block CmmNode 'Closed 'Open -> SDoc
    Platform
    -> Block CmmNode 'Closed 'Open -> IndexedCO 'Closed SDoc SDoc
    forall (x :: Extensibility) (e :: Extensibility).
    (IndexedCO x SDoc SDoc ~ SDoc) =>
    Platform -> Block CmmNode e x -> IndexedCO e SDoc SDoc
    pprBlock
    instance OutputableP Platform (Block CmmNode O C) where
        pdoc :: Platform -> Block CmmNode 'Open 'Closed -> SDoc
    pdoc = Platform -> Block CmmNode 'Open 'Closed -> SDoc
    Platform
    -> Block CmmNode 'Open 'Closed -> IndexedCO 'Open SDoc SDoc
    forall (x :: Extensibility) (e :: Extensibility).
    (IndexedCO x SDoc SDoc ~ SDoc) =>
    Platform -> Block CmmNode e x -> IndexedCO e SDoc SDoc
    pprBlock
    instance OutputableP Platform (Block CmmNode O O) where
        pdoc :: Platform -> Block CmmNode 'Open 'Open -> SDoc
    pdoc = Platform -> Block CmmNode 'Open 'Open -> SDoc
    Platform -> Block CmmNode 'Open 'Open -> IndexedCO 'Open SDoc SDoc
    forall (x :: Extensibility) (e :: Extensibility).
    (IndexedCO x SDoc SDoc ~ SDoc) =>
    Platform -> Block CmmNode e x -> IndexedCO e SDoc SDoc
    pprBlock

    instance OutputableP Platform (Graph CmmNode e x) where
        pdoc :: Platform -> Graph CmmNode e x -> SDoc
    pdoc = Platform -> Graph CmmNode e x -> SDoc
    forall (e :: Extensibility) (x :: Extensibility).
    Platform -> Graph CmmNode e x -> SDoc
    pprGraph

    pprBlock :: IndexedCO x SDoc SDoc ~ SDoc
             => Platform -> Block CmmNode e x -> IndexedCO e SDoc SDoc
    pprBlock :: forall (x :: Extensibility) (e :: Extensibility).
    (IndexedCO x SDoc SDoc ~ SDoc) =>
    Platform -> Block CmmNode e x -> IndexedCO e SDoc SDoc
    pprBlock Platform
    platform Block CmmNode e x
    block
        = (CmmNode 'Closed 'Open -> SDoc -> SDoc,
     CmmNode 'Open 'Open -> SDoc -> SDoc,
     CmmNode 'Open 'Closed -> SDoc -> SDoc)
    -> forall (e :: Extensibility) (x :: Extensibility).
       Block CmmNode e x -> IndexedCO x SDoc SDoc -> IndexedCO e SDoc SDoc
    forall (n :: Extensibility -> Extensibility -> *) a b c.
    (n 'Closed 'Open -> b -> c, n 'Open 'Open -> b -> b,
     n 'Open 'Closed -> a -> b)
    -> forall (e :: Extensibility) (x :: Extensibility).
       Block n e x -> IndexedCO x a b -> IndexedCO e c b
    foldBlockNodesB3 ( SDoc -> SDoc -> SDoc
    forall doc. IsDoc doc => doc -> doc -> doc
    ($$) (SDoc -> SDoc -> SDoc)
    -> (CmmNode 'Closed 'Open -> SDoc)
    -> CmmNode 'Closed 'Open
    -> SDoc
    -> SDoc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Platform -> CmmNode 'Closed 'Open -> SDoc
    forall env a. OutputableP env a => env -> a -> SDoc
    pdoc Platform
    platform
                           , SDoc -> SDoc -> SDoc
    forall doc. IsDoc doc => doc -> doc -> doc
    ($$) (SDoc -> SDoc -> SDoc)
    -> (CmmNode 'Open 'Open -> SDoc)
    -> CmmNode 'Open 'Open
    -> SDoc
    -> SDoc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (ByteOff -> SDoc -> SDoc
    nest ByteOff
    4) (SDoc -> SDoc)
    -> (CmmNode 'Open 'Open -> SDoc) -> CmmNode 'Open 'Open -> SDoc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Platform -> CmmNode 'Open 'Open -> SDoc
    forall env a. OutputableP env a => env -> a -> SDoc
    pdoc Platform
    platform
                           , SDoc -> SDoc -> SDoc
    forall doc. IsDoc doc => doc -> doc -> doc
    ($$) (SDoc -> SDoc -> SDoc)
    -> (CmmNode 'Open 'Closed -> SDoc)
    -> CmmNode 'Open 'Closed
    -> SDoc
    -> SDoc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (ByteOff -> SDoc -> SDoc
    nest ByteOff
    4) (SDoc -> SDoc)
    -> (CmmNode 'Open 'Closed -> SDoc) -> CmmNode 'Open 'Closed -> SDoc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Platform -> CmmNode 'Open 'Closed -> SDoc
    forall env a. OutputableP env a => env -> a -> SDoc
    pdoc Platform
    platform
                           )
                           Block CmmNode e x
    block
                           SDoc
    IndexedCO x SDoc SDoc
    forall doc. IsOutput doc => doc
    empty

    pprGraph :: Platform -> Graph CmmNode e x -> SDoc
    pprGraph :: forall (e :: Extensibility) (x :: Extensibility).
    Platform -> Graph CmmNode e x -> SDoc
    pprGraph Platform
    platform = \case
       Graph CmmNode e x
    GNil                  -> SDoc
    forall doc. IsOutput doc => doc
    empty
       GUnit Block CmmNode 'Open 'Open
    block           -> Platform -> Block CmmNode 'Open 'Open -> SDoc
    forall env a. OutputableP env a => env -> a -> SDoc
    pdoc Platform
    platform Block CmmNode 'Open 'Open
    block
       GMany MaybeO e (Block CmmNode 'Open 'Closed)
    entry Body' LabelMap Block CmmNode
    body MaybeO x (Block CmmNode 'Closed 'Open)
    exit ->
             String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "{"
          SDoc -> SDoc -> SDoc
    forall doc. IsDoc doc => doc -> doc -> doc
    $$ ByteOff -> SDoc -> SDoc
    nest ByteOff
    2 (MaybeO e (Block CmmNode 'Open 'Closed) -> SDoc
    forall (e :: Extensibility) (x :: Extensibility)
           (ex :: Extensibility).
    OutputableP Platform (Block CmmNode e x) =>
    MaybeO ex (Block CmmNode e x) -> SDoc
    pprMaybeO MaybeO e (Block CmmNode 'Open 'Closed)
    entry SDoc -> SDoc -> SDoc
    forall doc. IsDoc doc => doc -> doc -> doc
    $$ ([SDoc] -> SDoc
    forall doc. IsDoc doc => [doc] -> doc
    vcat ([SDoc] -> SDoc) -> [SDoc] -> SDoc
    forall a b. (a -> b) -> a -> b
    $ (Block CmmNode 'Closed 'Closed -> SDoc)
    -> [Block CmmNode 'Closed 'Closed] -> [SDoc]
    forall a b. (a -> b) -> [a] -> [b]
    map (Platform -> Block CmmNode 'Closed 'Closed -> SDoc
    forall env a. OutputableP env a => env -> a -> SDoc
    pdoc Platform
    platform) ([Block CmmNode 'Closed 'Closed] -> [SDoc])
    -> [Block CmmNode 'Closed 'Closed] -> [SDoc]
    forall a b. (a -> b) -> a -> b
    $ Body' LabelMap Block CmmNode -> [Block CmmNode 'Closed 'Closed]
    forall (n :: Extensibility -> Extensibility -> *).
    Body LabelMap n -> [Block n 'Closed 'Closed]
    bodyToBlockList Body' LabelMap Block CmmNode
    body) SDoc -> SDoc -> SDoc
    forall doc. IsDoc doc => doc -> doc -> doc
    $$ MaybeO x (Block CmmNode 'Closed 'Open) -> SDoc
    forall (e :: Extensibility) (x :: Extensibility)
           (ex :: Extensibility).
    OutputableP Platform (Block CmmNode e x) =>
    MaybeO ex (Block CmmNode e x) -> SDoc
    pprMaybeO MaybeO x (Block CmmNode 'Closed 'Open)
    exit)
          SDoc -> SDoc -> SDoc
    forall doc. IsDoc doc => doc -> doc -> doc
    $$ String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "}"
          where pprMaybeO :: OutputableP Platform (Block CmmNode e x)
                          => MaybeO ex (Block CmmNode e x) -> SDoc
                pprMaybeO :: forall (e :: Extensibility) (x :: Extensibility)
           (ex :: Extensibility).
    OutputableP Platform (Block CmmNode e x) =>
    MaybeO ex (Block CmmNode e x) -> SDoc
    pprMaybeO MaybeO ex (Block CmmNode e x)
    NothingO = SDoc
    forall doc. IsOutput doc => doc
    empty
                pprMaybeO (JustO Block CmmNode e x
    block) = Platform -> Block CmmNode e x -> SDoc
    forall env a. OutputableP env a => env -> a -> SDoc
    pdoc Platform
    platform Block CmmNode e x
    block

    {- Note [Foreign calls]
    ~~~~~~~~~~~~~~~~~~~~~~~
    A CmmUnsafeForeignCall is used for *unsafe* foreign calls;
    a CmmForeignCall call is used for *safe* foreign calls.

    Unsafe ones are mostly easy: think of them as a "fat machine
    instruction".  In particular, they do *not* kill all live registers,
    just the registers they return to (there was a bit of code in GHC that
    conservatively assumed otherwise.)  However, see [Register parameter passing].

    Safe ones are trickier.  A safe foreign call
         r = f(x)
    ultimately expands to
         push "return address"      -- Never used to return to;
                                    -- just points an info table
         save registers into TSO
         call suspendThread
         r = f(x)                   -- Make the call
         call resumeThread
         restore registers
         pop "return address"
    We cannot "lower" a safe foreign call to this sequence of Cmms, because
    after we've saved Sp all the Cmm optimiser's assumptions are broken.

    Note that a safe foreign call needs an info table.

    So Safe Foreign Calls must remain as last nodes until the stack is
    made manifest in GHC.Cmm.LayoutStack, where they are lowered into the above
    sequence.
    -}

    {- Note [Unsafe foreign calls clobber caller-save registers]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    A foreign call is defined to clobber any GlobalRegs that are mapped to
    caller-saves machine registers (according to the prevailing C ABI).
    GHC.StgToCmm.Utils.callerSaves tells you which GlobalRegs are caller-saves.

    This is a design choice that makes it easier to generate code later.
    We could instead choose to say that foreign calls do *not* clobber
    caller-saves regs, but then we would have to figure out which regs
    were live across the call later and insert some saves/restores.

    Furthermore when we generate code we never have any GlobalRegs live
    across a call, because they are always copied-in to LocalRegs and
    copied-out again before making a call/jump.  So all we have to do is
    avoid any code motion that would make a caller-saves GlobalReg live
    across a foreign call during subsequent optimisations.
    -}

    {- Note [Register parameter passing]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    On certain architectures, some registers are utilized for parameter
    passing in the C calling convention.  For example, in x86-64 Linux
    convention, rdi, rsi, rdx and rcx (as well as r8 and r9) may be used for
    argument passing.  These are registers R3-R6, which our generated
    code may also be using; as a result, it's necessary to save these
    values before doing a foreign call.  This is done during initial
    code generation in callerSaveVolatileRegs in GHC.StgToCmm.Utils.

    However, one result of doing this is that the contents of these registers may
    mysteriously change if referenced inside the arguments.  This is dangerous, so
    you'll need to disable inlining much in the same way is done in GHC.Cmm.Sink
    currently.  We should fix this!
    -}

    ---------------------------------------------
    -- Eq instance of CmmNode

    deriving instance Eq (CmmNode e x)

    ----------------------------------------------
    -- Hoopl instances of CmmNode

    instance NonLocal CmmNode where
      entryLabel :: forall (x :: Extensibility). CmmNode 'Closed x -> Label
    entryLabel (CmmEntry Label
    l CmmTickScope
    _) = Label
    l

      successors :: forall (e :: Extensibility). CmmNode e 'Closed -> [Label]
    successors (CmmBranch Label
    l) = [Label
    l]
      successors (CmmCondBranch {cml_true :: CmmNode 'Open 'Closed -> Label
    cml_true=Label
    t, cml_false :: CmmNode 'Open 'Closed -> Label
    cml_false=Label
    f}) = [Label
    f, Label
    t] -- meets layout constraint
      successors (CmmSwitch CmmExpr
    _ SwitchTargets
    ids) = SwitchTargets -> [Label]
    switchTargetsToList SwitchTargets
    ids
      successors (CmmCall {cml_cont :: CmmNode 'Open 'Closed -> Maybe Label
    cml_cont=Maybe Label
    l}) = Maybe Label -> [Label]
    forall a. Maybe a -> [a]
    maybeToList Maybe Label
    l
      successors (CmmForeignCall {succ :: CmmNode 'Open 'Closed -> Label
    succ=Label
    l}) = [Label
    l]

    --------------------------------------------------
    -- Various helper types

    type CmmActual = CmmExpr
    type CmmFormal = LocalReg

    type UpdFrameOffset = ByteOff

    -- | A convention maps a list of values (function arguments or return
    -- values) to registers or stack locations.
    data Convention
      = NativeDirectCall
           -- ^ top-level Haskell functions use @NativeDirectCall@, which
           -- maps arguments to registers starting with R2, according to
           -- how many registers are available on the platform.  This
           -- convention ignores R1, because for a top-level function call
           -- the function closure is implicit, and doesn't need to be passed.
      | NativeNodeCall
           -- ^ non-top-level Haskell functions, which pass the address of
           -- the function closure in R1 (regardless of whether R1 is a
           -- real register or not), and the rest of the arguments in
           -- registers or on the stack.
      | NativeReturn
           -- ^ a native return.  The convention for returns depends on
           -- how many values are returned: for just one value returned,
           -- the appropriate register is used (R1, F1, etc.). regardless
           -- of whether it is a real register or not.  For multiple
           -- values returned, they are mapped to registers or the stack.
      | Slow
           -- ^ Slow entry points: all args pushed on the stack
      | GC
           -- ^ Entry to the garbage collector: uses the node reg!
           -- (TODO: I don't think we need this --SDM)
      deriving( Convention -> Convention -> Bool
    (Convention -> Convention -> Bool)
    -> (Convention -> Convention -> Bool) -> Eq Convention
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: Convention -> Convention -> Bool
    == :: Convention -> Convention -> Bool
    $c/= :: Convention -> Convention -> Bool
    /= :: Convention -> Convention -> Bool
    Eq )

    data ForeignConvention
      = ForeignConvention
            CCallConv               -- Which foreign-call convention
            [ForeignHint]           -- Extra info about the args
            [ForeignHint]           -- Extra info about the result
            CmmReturnInfo
      deriving ForeignConvention -> ForeignConvention -> Bool
    (ForeignConvention -> ForeignConvention -> Bool)
    -> (ForeignConvention -> ForeignConvention -> Bool)
    -> Eq ForeignConvention
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: ForeignConvention -> ForeignConvention -> Bool
    == :: ForeignConvention -> ForeignConvention -> Bool
    $c/= :: ForeignConvention -> ForeignConvention -> Bool
    /= :: ForeignConvention -> ForeignConvention -> Bool
    Eq

    instance Outputable ForeignConvention where
        ppr :: ForeignConvention -> SDoc
    ppr = ForeignConvention -> SDoc
    pprForeignConvention

    pprForeignConvention :: ForeignConvention -> SDoc
    pprForeignConvention :: ForeignConvention -> SDoc
    pprForeignConvention (ForeignConvention CCallConv
    c [ForeignHint]
    args [ForeignHint]
    res CmmReturnInfo
    ret) =
        SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc
    doubleQuotes (CCallConv -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr CCallConv
    c) SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "arg hints: " SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> [ForeignHint] -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr [ForeignHint]
    args SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    " result hints: " SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> [ForeignHint] -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr [ForeignHint]
    res SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> CmmReturnInfo -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr CmmReturnInfo
    ret

    data CmmReturnInfo
      = CmmMayReturn
      | CmmNeverReturns
      deriving ( CmmReturnInfo -> CmmReturnInfo -> Bool
    (CmmReturnInfo -> CmmReturnInfo -> Bool)
    -> (CmmReturnInfo -> CmmReturnInfo -> Bool) -> Eq CmmReturnInfo
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: CmmReturnInfo -> CmmReturnInfo -> Bool
    == :: CmmReturnInfo -> CmmReturnInfo -> Bool
    $c/= :: CmmReturnInfo -> CmmReturnInfo -> Bool
    /= :: CmmReturnInfo -> CmmReturnInfo -> Bool
    Eq )

    instance Outputable CmmReturnInfo where
        ppr :: CmmReturnInfo -> SDoc
    ppr = CmmReturnInfo -> SDoc
    pprReturnInfo

    pprReturnInfo :: CmmReturnInfo -> SDoc
    pprReturnInfo :: CmmReturnInfo -> SDoc
    pprReturnInfo CmmReturnInfo
    CmmMayReturn = SDoc
    forall doc. IsOutput doc => doc
    empty
    pprReturnInfo CmmReturnInfo
    CmmNeverReturns = String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "never returns"

    data ForeignTarget        -- The target of a foreign call
      = ForeignTarget                -- A foreign procedure
            CmmExpr                  -- Its address
            ForeignConvention        -- Its calling convention
      | PrimTarget            -- A possibly-side-effecting machine operation
            CallishMachOp            -- Which one
      deriving ForeignTarget -> ForeignTarget -> Bool
    (ForeignTarget -> ForeignTarget -> Bool)
    -> (ForeignTarget -> ForeignTarget -> Bool) -> Eq ForeignTarget
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: ForeignTarget -> ForeignTarget -> Bool
    == :: ForeignTarget -> ForeignTarget -> Bool
    $c/= :: ForeignTarget -> ForeignTarget -> Bool
    /= :: ForeignTarget -> ForeignTarget -> Bool
    Eq

    instance OutputableP Platform ForeignTarget where
        pdoc :: Platform -> ForeignTarget -> SDoc
    pdoc = Platform -> ForeignTarget -> SDoc
    pprForeignTarget

    pprForeignTarget :: Platform -> ForeignTarget -> SDoc
    pprForeignTarget :: Platform -> ForeignTarget -> SDoc
    pprForeignTarget Platform
    platform (ForeignTarget CmmExpr
    fn ForeignConvention
    c) =
        ForeignConvention -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr ForeignConvention
    c SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> CmmExpr -> SDoc
    ppr_target CmmExpr
    fn
      where
        ppr_target :: CmmExpr -> SDoc
        ppr_target :: CmmExpr -> SDoc
    ppr_target t :: CmmExpr
    t@(CmmLit CmmLit
    _) = Platform -> CmmExpr -> SDoc
    forall env a. OutputableP env a => env -> a -> SDoc
    pdoc Platform
    platform CmmExpr
    t
        ppr_target CmmExpr
    fn'          = SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc
    parens (Platform -> CmmExpr -> SDoc
    forall env a. OutputableP env a => env -> a -> SDoc
    pdoc Platform
    platform CmmExpr
    fn')
    pprForeignTarget Platform
    platform (PrimTarget CallishMachOp
    op)
     -- HACK: We're just using a ForeignLabel to get this printed, the label
     --       might not really be foreign.
     = Platform -> CLabel -> SDoc
    forall env a. OutputableP env a => env -> a -> SDoc
    pdoc Platform
    platform
                   (FastString -> ForeignLabelSource -> FunctionOrData -> CLabel
    mkForeignLabel
                              (String -> FastString
    mkFastString (CallishMachOp -> String
    forall a. Show a => a -> String
    show CallishMachOp
    op))
                              ForeignLabelSource
    ForeignLabelInThisPackage FunctionOrData
    IsFunction)

    instance Outputable Convention where
      ppr :: Convention -> SDoc
    ppr = Convention -> SDoc
    pprConvention

    pprConvention :: Convention -> SDoc
    pprConvention :: Convention -> SDoc
    pprConvention (NativeNodeCall   {}) = String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "<native-node-call-convention>"
    pprConvention (NativeDirectCall {}) = String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "<native-direct-call-convention>"
    pprConvention (NativeReturn {})     = String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "<native-ret-convention>"
    pprConvention  Convention
    Slow                 = String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "<slow-convention>"
    pprConvention  Convention
    GC                   = String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "<gc-convention>"

    foreignTargetHints :: ForeignTarget -> ([ForeignHint], [ForeignHint])
    foreignTargetHints :: ForeignTarget -> ([ForeignHint], [ForeignHint])
    foreignTargetHints ForeignTarget
    target
      = ( [ForeignHint]
    res_hints [ForeignHint] -> [ForeignHint] -> [ForeignHint]
    forall a. [a] -> [a] -> [a]
    ++ ForeignHint -> [ForeignHint]
    forall a. a -> [a]
    repeat ForeignHint
    NoHint
        , [ForeignHint]
    arg_hints [ForeignHint] -> [ForeignHint] -> [ForeignHint]
    forall a. [a] -> [a] -> [a]
    ++ ForeignHint -> [ForeignHint]
    forall a. a -> [a]
    repeat ForeignHint
    NoHint )
      where
        ([ForeignHint]
    res_hints, [ForeignHint]
    arg_hints) =
           case ForeignTarget
    target of
              PrimTarget CallishMachOp
    op -> CallishMachOp -> ([ForeignHint], [ForeignHint])
    callishMachOpHints CallishMachOp
    op
              ForeignTarget CmmExpr
    _ (ForeignConvention CCallConv
    _ [ForeignHint]
    arg_hints [ForeignHint]
    res_hints CmmReturnInfo
    _) ->
                 ([ForeignHint]
    res_hints, [ForeignHint]
    arg_hints)

    --------------------------------------------------
    -- Instances of register and slot users / definers

    instance UserOfRegs LocalReg (CmmNode e x) where
      {-# INLINEABLE foldRegsUsed #-}
      foldRegsUsed :: forall b.
    Platform -> (b -> CmmFormal -> b) -> b -> CmmNode e x -> b
    foldRegsUsed Platform
    platform b -> CmmFormal -> b
    f !b
    z CmmNode e x
    n = case CmmNode e x
    n of
        CmmAssign CmmReg
    _ CmmExpr
    expr -> (b -> CmmFormal -> b) -> b -> CmmExpr -> b
    forall a b.
    UserOfRegs CmmFormal a =>
    (b -> CmmFormal -> b) -> b -> a -> b
    fold b -> CmmFormal -> b
    f b
    z CmmExpr
    expr
        CmmStore CmmExpr
    addr CmmExpr
    rval AlignmentSpec
    _ -> (b -> CmmFormal -> b) -> b -> CmmExpr -> b
    forall a b.
    UserOfRegs CmmFormal a =>
    (b -> CmmFormal -> b) -> b -> a -> b
    fold b -> CmmFormal -> b
    f ((b -> CmmFormal -> b) -> b -> CmmExpr -> b
    forall a b.
    UserOfRegs CmmFormal a =>
    (b -> CmmFormal -> b) -> b -> a -> b
    fold b -> CmmFormal -> b
    f b
    z CmmExpr
    addr) CmmExpr
    rval
        CmmUnsafeForeignCall ForeignTarget
    t [CmmFormal]
    _ [CmmExpr]
    args -> (b -> CmmFormal -> b) -> b -> [CmmExpr] -> b
    forall a b.
    UserOfRegs CmmFormal a =>
    (b -> CmmFormal -> b) -> b -> a -> b
    fold b -> CmmFormal -> b
    f ((b -> CmmFormal -> b) -> b -> ForeignTarget -> b
    forall a b.
    UserOfRegs CmmFormal a =>
    (b -> CmmFormal -> b) -> b -> a -> b
    fold b -> CmmFormal -> b
    f b
    z ForeignTarget
    t) [CmmExpr]
    args
        CmmCondBranch CmmExpr
    expr Label
    _ Label
    _ Maybe Bool
    _ -> (b -> CmmFormal -> b) -> b -> CmmExpr -> b
    forall a b.
    UserOfRegs CmmFormal a =>
    (b -> CmmFormal -> b) -> b -> a -> b
    fold b -> CmmFormal -> b
    f b
    z CmmExpr
    expr
        CmmSwitch CmmExpr
    expr SwitchTargets
    _ -> (b -> CmmFormal -> b) -> b -> CmmExpr -> b
    forall a b.
    UserOfRegs CmmFormal a =>
    (b -> CmmFormal -> b) -> b -> a -> b
    fold b -> CmmFormal -> b
    f b
    z CmmExpr
    expr
        CmmCall {cml_target :: CmmNode 'Open 'Closed -> CmmExpr
    cml_target=CmmExpr
    tgt} -> (b -> CmmFormal -> b) -> b -> CmmExpr -> b
    forall a b.
    UserOfRegs CmmFormal a =>
    (b -> CmmFormal -> b) -> b -> a -> b
    fold b -> CmmFormal -> b
    f b
    z CmmExpr
    tgt
        CmmForeignCall {tgt :: CmmNode 'Open 'Closed -> ForeignTarget
    tgt=ForeignTarget
    tgt, args :: CmmNode 'Open 'Closed -> [CmmExpr]
    args=[CmmExpr]
    args} -> (b -> CmmFormal -> b) -> b -> [CmmExpr] -> b
    forall a b.
    UserOfRegs CmmFormal a =>
    (b -> CmmFormal -> b) -> b -> a -> b
    fold b -> CmmFormal -> b
    f ((b -> CmmFormal -> b) -> b -> ForeignTarget -> b
    forall a b.
    UserOfRegs CmmFormal a =>
    (b -> CmmFormal -> b) -> b -> a -> b
    fold b -> CmmFormal -> b
    f b
    z ForeignTarget
    tgt) [CmmExpr]
    args
        CmmNode e x
    _ -> b
    z
        where fold :: forall a b. UserOfRegs LocalReg a
                   => (b -> LocalReg -> b) -> b -> a -> b
              fold :: forall a b.
    UserOfRegs CmmFormal a =>
    (b -> CmmFormal -> b) -> b -> a -> b
    fold b -> CmmFormal -> b
    f b
    z a
    n = Platform -> (b -> CmmFormal -> b) -> b -> a -> b
    forall b. Platform -> (b -> CmmFormal -> b) -> b -> a -> b
    forall r a b.
    UserOfRegs r a =>
    Platform -> (b -> r -> b) -> b -> a -> b
    foldRegsUsed Platform
    platform b -> CmmFormal -> b
    f b
    z a
    n

    instance UserOfRegs GlobalRegUse (CmmNode e x) where
      {-# INLINEABLE foldRegsUsed #-}
      foldRegsUsed :: forall b.
    Platform -> (b -> GlobalRegUse -> b) -> b -> CmmNode e x -> b
    foldRegsUsed Platform
    platform b -> GlobalRegUse -> b
    f !b
    z CmmNode e x
    n = case CmmNode e x
    n of
        CmmAssign CmmReg
    _ CmmExpr
    expr -> (b -> GlobalRegUse -> b) -> b -> CmmExpr -> b
    forall a b.
    UserOfRegs GlobalRegUse a =>
    (b -> GlobalRegUse -> b) -> b -> a -> b
    fold b -> GlobalRegUse -> b
    f b
    z CmmExpr
    expr
        CmmStore CmmExpr
    addr CmmExpr
    rval AlignmentSpec
    _ -> (b -> GlobalRegUse -> b) -> b -> CmmExpr -> b
    forall a b.
    UserOfRegs GlobalRegUse a =>
    (b -> GlobalRegUse -> b) -> b -> a -> b
    fold b -> GlobalRegUse -> b
    f ((b -> GlobalRegUse -> b) -> b -> CmmExpr -> b
    forall a b.
    UserOfRegs GlobalRegUse a =>
    (b -> GlobalRegUse -> b) -> b -> a -> b
    fold b -> GlobalRegUse -> b
    f b
    z CmmExpr
    addr) CmmExpr
    rval
        CmmUnsafeForeignCall ForeignTarget
    t [CmmFormal]
    _ [CmmExpr]
    args -> (b -> GlobalRegUse -> b) -> b -> [CmmExpr] -> b
    forall a b.
    UserOfRegs GlobalRegUse a =>
    (b -> GlobalRegUse -> b) -> b -> a -> b
    fold b -> GlobalRegUse -> b
    f ((b -> GlobalRegUse -> b) -> b -> ForeignTarget -> b
    forall a b.
    UserOfRegs GlobalRegUse a =>
    (b -> GlobalRegUse -> b) -> b -> a -> b
    fold b -> GlobalRegUse -> b
    f b
    z ForeignTarget
    t) [CmmExpr]
    args
        CmmCondBranch CmmExpr
    expr Label
    _ Label
    _ Maybe Bool
    _ -> (b -> GlobalRegUse -> b) -> b -> CmmExpr -> b
    forall a b.
    UserOfRegs GlobalRegUse a =>
    (b -> GlobalRegUse -> b) -> b -> a -> b
    fold b -> GlobalRegUse -> b
    f b
    z CmmExpr
    expr
        CmmSwitch CmmExpr
    expr SwitchTargets
    _ -> (b -> GlobalRegUse -> b) -> b -> CmmExpr -> b
    forall a b.
    UserOfRegs GlobalRegUse a =>
    (b -> GlobalRegUse -> b) -> b -> a -> b
    fold b -> GlobalRegUse -> b
    f b
    z CmmExpr
    expr
        CmmCall {cml_target :: CmmNode 'Open 'Closed -> CmmExpr
    cml_target=CmmExpr
    tgt, cml_args_regs :: CmmNode 'Open 'Closed -> [GlobalRegUse]
    cml_args_regs=[GlobalRegUse]
    args} -> (b -> GlobalRegUse -> b) -> b -> CmmExpr -> b
    forall a b.
    UserOfRegs GlobalRegUse a =>
    (b -> GlobalRegUse -> b) -> b -> a -> b
    fold b -> GlobalRegUse -> b
    f ((b -> GlobalRegUse -> b) -> b -> [GlobalRegUse] -> b
    forall a b.
    UserOfRegs GlobalRegUse a =>
    (b -> GlobalRegUse -> b) -> b -> a -> b
    fold b -> GlobalRegUse -> b
    f b
    z [GlobalRegUse]
    args) CmmExpr
    tgt
        CmmForeignCall {tgt :: CmmNode 'Open 'Closed -> ForeignTarget
    tgt=ForeignTarget
    tgt, args :: CmmNode 'Open 'Closed -> [CmmExpr]
    args=[CmmExpr]
    args} -> (b -> GlobalRegUse -> b) -> b -> [CmmExpr] -> b
    forall a b.
    UserOfRegs GlobalRegUse a =>
    (b -> GlobalRegUse -> b) -> b -> a -> b
    fold b -> GlobalRegUse -> b
    f ((b -> GlobalRegUse -> b) -> b -> ForeignTarget -> b
    forall a b.
    UserOfRegs GlobalRegUse a =>
    (b -> GlobalRegUse -> b) -> b -> a -> b
    fold b -> GlobalRegUse -> b
    f b
    z ForeignTarget
    tgt) [CmmExpr]
    args
        CmmNode e x
    _ -> b
    z
        where fold :: forall a b.  UserOfRegs GlobalRegUse a
                   => (b -> GlobalRegUse -> b) -> b -> a -> b
              fold :: forall a b.
    UserOfRegs GlobalRegUse a =>
    (b -> GlobalRegUse -> b) -> b -> a -> b
    fold b -> GlobalRegUse -> b
    f b
    z a
    n = Platform -> (b -> GlobalRegUse -> b) -> b -> a -> b
    forall b. Platform -> (b -> GlobalRegUse -> b) -> b -> a -> b
    forall r a b.
    UserOfRegs r a =>
    Platform -> (b -> r -> b) -> b -> a -> b
    foldRegsUsed Platform
    platform b -> GlobalRegUse -> b
    f b
    z a
    n
    instance (Ord r, UserOfRegs r CmmReg) => UserOfRegs r ForeignTarget where
      -- The (Ord r) in the context is necessary here
      -- See Note [Recursive superclasses] in GHC.Tc.TyCl.Instance
      {-# INLINEABLE foldRegsUsed #-}
      foldRegsUsed :: forall b. Platform -> (b -> r -> b) -> b -> ForeignTarget -> b
    foldRegsUsed Platform
    _        b -> r -> b
    _ !b
    z (PrimTarget CallishMachOp
    _)      = b
    z
      foldRegsUsed Platform
    platform b -> r -> b
    f !b
    z (ForeignTarget CmmExpr
    e ForeignConvention
    _) = Platform -> (b -> r -> b) -> b -> CmmExpr -> b
    forall b. Platform -> (b -> r -> b) -> b -> CmmExpr -> b
    forall r a b.
    UserOfRegs r a =>
    Platform -> (b -> r -> b) -> b -> a -> b
    foldRegsUsed Platform
    platform b -> r -> b
    f b
    z CmmExpr
    e

    instance DefinerOfRegs LocalReg (CmmNode e x) where
      {-# INLINEABLE foldRegsDefd #-}
      foldRegsDefd :: forall b.
    Platform -> (b -> CmmFormal -> b) -> b -> CmmNode e x -> b
    foldRegsDefd Platform
    platform b -> CmmFormal -> b
    f !b
    z CmmNode e x
    n = case CmmNode e x
    n of
        CmmAssign CmmReg
    lhs CmmExpr
    _ -> (b -> CmmFormal -> b) -> b -> CmmReg -> b
    forall a b.
    DefinerOfRegs CmmFormal a =>
    (b -> CmmFormal -> b) -> b -> a -> b
    fold b -> CmmFormal -> b
    f b
    z CmmReg
    lhs
        CmmUnsafeForeignCall ForeignTarget
    _ [CmmFormal]
    fs [CmmExpr]
    _ -> (b -> CmmFormal -> b) -> b -> [CmmFormal] -> b
    forall a b.
    DefinerOfRegs CmmFormal a =>
    (b -> CmmFormal -> b) -> b -> a -> b
    fold b -> CmmFormal -> b
    f b
    z [CmmFormal]
    fs
        CmmForeignCall {res :: CmmNode 'Open 'Closed -> [CmmFormal]
    res=[CmmFormal]
    res} -> (b -> CmmFormal -> b) -> b -> [CmmFormal] -> b
    forall a b.
    DefinerOfRegs CmmFormal a =>
    (b -> CmmFormal -> b) -> b -> a -> b
    fold b -> CmmFormal -> b
    f b
    z [CmmFormal]
    res
        CmmNode e x
    _ -> b
    z
        where fold :: forall a b. DefinerOfRegs LocalReg a
                   => (b -> LocalReg -> b) -> b -> a -> b
              fold :: forall a b.
    DefinerOfRegs CmmFormal a =>
    (b -> CmmFormal -> b) -> b -> a -> b
    fold b -> CmmFormal -> b
    f b
    z a
    n = Platform -> (b -> CmmFormal -> b) -> b -> a -> b
    forall b. Platform -> (b -> CmmFormal -> b) -> b -> a -> b
    forall r a b.
    DefinerOfRegs r a =>
    Platform -> (b -> r -> b) -> b -> a -> b
    foldRegsDefd Platform
    platform b -> CmmFormal -> b
    f b
    z a
    n

    instance DefinerOfRegs GlobalRegUse (CmmNode e x) where
      {-# INLINEABLE foldRegsDefd #-}
      foldRegsDefd :: forall b.
    Platform -> (b -> GlobalRegUse -> b) -> b -> CmmNode e x -> b
    foldRegsDefd Platform
    platform b -> GlobalRegUse -> b
    f !b
    z CmmNode e x
    n = case CmmNode e x
    n of
        CmmAssign CmmReg
    lhs CmmExpr
    _ -> (b -> GlobalRegUse -> b) -> b -> CmmReg -> b
    forall a b.
    DefinerOfRegs GlobalRegUse a =>
    (b -> GlobalRegUse -> b) -> b -> a -> b
    fold b -> GlobalRegUse -> b
    f b
    z CmmReg
    lhs
        CmmUnsafeForeignCall ForeignTarget
    tgt [CmmFormal]
    _ [CmmExpr]
    _  -> (b -> GlobalRegUse -> b) -> b -> [GlobalRegUse] -> b
    forall a b.
    DefinerOfRegs GlobalRegUse a =>
    (b -> GlobalRegUse -> b) -> b -> a -> b
    fold b -> GlobalRegUse -> b
    f b
    z (ForeignTarget -> [GlobalRegUse]
    foreignTargetRegs ForeignTarget
    tgt)
        CmmCall        {} -> (b -> GlobalRegUse -> b) -> b -> [GlobalRegUse] -> b
    forall a b.
    DefinerOfRegs GlobalRegUse a =>
    (b -> GlobalRegUse -> b) -> b -> a -> b
    fold b -> GlobalRegUse -> b
    f b
    z [GlobalRegUse]
    activeRegs
        CmmForeignCall {} -> (b -> GlobalRegUse -> b) -> b -> [GlobalRegUse] -> b
    forall a b.
    DefinerOfRegs GlobalRegUse a =>
    (b -> GlobalRegUse -> b) -> b -> a -> b
    fold b -> GlobalRegUse -> b
    f b
    z [GlobalRegUse]
    activeRegs
                          -- See Note [Safe foreign calls clobber STG registers]
        CmmNode e x
    _ -> b
    z
        where fold :: forall a b. DefinerOfRegs GlobalRegUse a
                   => (b -> GlobalRegUse -> b) -> b -> a -> b
              fold :: forall a b.
    DefinerOfRegs GlobalRegUse a =>
    (b -> GlobalRegUse -> b) -> b -> a -> b
    fold b -> GlobalRegUse -> b
    f b
    z a
    n = Platform -> (b -> GlobalRegUse -> b) -> b -> a -> b
    forall b. Platform -> (b -> GlobalRegUse -> b) -> b -> a -> b
    forall r a b.
    DefinerOfRegs r a =>
    Platform -> (b -> r -> b) -> b -> a -> b
    foldRegsDefd Platform
    platform b -> GlobalRegUse -> b
    f b
    z a
    n

              activeRegs :: [GlobalRegUse]
              activeRegs :: [GlobalRegUse]
    activeRegs = (GlobalReg -> GlobalRegUse) -> [GlobalReg] -> [GlobalRegUse]
    forall a b. (a -> b) -> [a] -> [b]
    map (\ GlobalReg
    r -> GlobalReg -> CmmType -> GlobalRegUse
    GlobalRegUse GlobalReg
    r (Platform -> GlobalReg -> CmmType
    globalRegSpillType Platform
    platform GlobalReg
    r)) ([GlobalReg] -> [GlobalRegUse]) -> [GlobalReg] -> [GlobalRegUse]
    forall a b. (a -> b) -> a -> b
    $ Platform -> [GlobalReg]
    activeStgRegs Platform
    platform
              activeCallerSavesRegs :: [GlobalRegUse]
    activeCallerSavesRegs = (GlobalRegUse -> Bool) -> [GlobalRegUse] -> [GlobalRegUse]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (Platform -> GlobalReg -> Bool
    callerSaves Platform
    platform (GlobalReg -> Bool)
    -> (GlobalRegUse -> GlobalReg) -> GlobalRegUse -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . GlobalRegUse -> GlobalReg
    globalRegUse_reg) [GlobalRegUse]
    activeRegs

              foreignTargetRegs :: ForeignTarget -> [GlobalRegUse]
    foreignTargetRegs (ForeignTarget CmmExpr
    _ (ForeignConvention CCallConv
    _ [ForeignHint]
    _ [ForeignHint]
    _ CmmReturnInfo
    CmmNeverReturns)) = []
              foreignTargetRegs ForeignTarget
    _ = [GlobalRegUse]
    activeCallerSavesRegs

    -- Note [Safe foreign calls clobber STG registers]
    -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    -- During stack layout phase every safe foreign call is expanded into a block
    -- that contains unsafe foreign call (instead of safe foreign call) and ends
    -- with a normal call (See Note [Foreign calls]). This means that we must
    -- treat safe foreign call as if it was a normal call (because eventually it
    -- will be). This is important if we try to run sinking pass before stack
    -- layout phase. Consider this example of what might go wrong (this is cmm
    -- code from stablename001 test). Here is code after common block elimination
    -- (before stack layout):
    --
    --  c1q6:
    --      _s1pf::P64 = R1;
    --      _c1q8::I64 = performMajorGC;
    --      I64[(young<c1q9> + 8)] = c1q9;
    --      foreign call "ccall" arg hints:  []  result hints:  [] (_c1q8::I64)(...)
    --                   returns to c1q9 args: ([]) ress: ([])ret_args: 8ret_off: 8;
    --  c1q9:
    --      I64[(young<c1qb> + 8)] = c1qb;
    --      R1 = _s1pc::P64;
    --      call stg_makeStableName#(R1) returns to c1qb, args: 8, res: 8, upd: 8;
    --
    -- If we run sinking pass now (still before stack layout) we will get this:
    --
    --  c1q6:
    --      I64[(young<c1q9> + 8)] = c1q9;
    --      foreign call "ccall" arg hints:  []  result hints:  [] performMajorGC(...)
    --                   returns to c1q9 args: ([]) ress: ([])ret_args: 8ret_off: 8;
    --  c1q9:
    --      I64[(young<c1qb> + 8)] = c1qb;
    --      _s1pf::P64 = R1;         <------ _s1pf sunk past safe foreign call
    --      R1 = _s1pc::P64;
    --      call stg_makeStableName#(R1) returns to c1qb, args: 8, res: 8, upd: 8;
    --
    -- Notice that _s1pf was sunk past a foreign call. When we run stack layout
    -- safe call to performMajorGC will be turned into:
    --
    --  c1q6:
    --      _s1pc::P64 = P64[Sp + 8];
    --      I64[Sp - 8] = c1q9;
    --      Sp = Sp - 8;
    --      I64[I64[CurrentTSO + 24] + 16] = Sp;
    --      P64[CurrentNursery + 8] = Hp + 8;
    --      (_u1qI::I64) = call "ccall" arg hints:  [PtrHint,]
    --                           result hints:  [PtrHint] suspendThread(BaseReg, 0);
    --      call "ccall" arg hints:  []  result hints:  [] performMajorGC();
    --      (_u1qJ::I64) = call "ccall" arg hints:  [PtrHint]
    --                           result hints:  [PtrHint] resumeThread(_u1qI::I64);
    --      BaseReg = _u1qJ::I64;
    --      _u1qK::P64 = CurrentTSO;
    --      _u1qL::P64 = I64[_u1qK::P64 + 24];
    --      Sp = I64[_u1qL::P64 + 16];
    --      SpLim = _u1qL::P64 + 192;
    --      HpAlloc = 0;
    --      Hp = I64[CurrentNursery + 8] - 8;
    --      HpLim = I64[CurrentNursery] + (%MO_SS_Conv_W32_W64(I32[CurrentNursery + 48]) * 4096 - 1);
    --      call (I64[Sp])() returns to c1q9, args: 8, res: 8, upd: 8;
    --  c1q9:
    --      I64[(young<c1qb> + 8)] = c1qb;
    --      _s1pf::P64 = R1;         <------ INCORRECT!
    --      R1 = _s1pc::P64;
    --      call stg_makeStableName#(R1) returns to c1qb, args: 8, res: 8, upd: 8;
    --
    -- Notice that c1q6 now ends with a call. Sinking _s1pf::P64 = R1 past that
    -- call is clearly incorrect. This is what would happen if we assumed that
    -- safe foreign call has the same semantics as unsafe foreign call. To prevent
    -- this we need to treat safe foreign call as if was normal call.

    -----------------------------------
    -- mapping Expr in GHC.Cmm.Node

    mapForeignTarget :: (CmmExpr -> CmmExpr) -> ForeignTarget -> ForeignTarget
    mapForeignTarget :: (CmmExpr -> CmmExpr) -> ForeignTarget -> ForeignTarget
    mapForeignTarget CmmExpr -> CmmExpr
    exp   (ForeignTarget CmmExpr
    e ForeignConvention
    c) = CmmExpr -> ForeignConvention -> ForeignTarget
    ForeignTarget (CmmExpr -> CmmExpr
    exp CmmExpr
    e) ForeignConvention
    c
    mapForeignTarget CmmExpr -> CmmExpr
    _   m :: ForeignTarget
    m@(PrimTarget CallishMachOp
    _)      = ForeignTarget
    m

    wrapRecExp :: (CmmExpr -> CmmExpr) -> CmmExpr -> CmmExpr
    -- Take a transformer on expressions and apply it recursively.
    -- (wrapRecExp f e) first recursively applies itself to sub-expressions of e
    --                  then  uses f to rewrite the resulting expression
    wrapRecExp :: (CmmExpr -> CmmExpr) -> CmmExpr -> CmmExpr
    wrapRecExp CmmExpr -> CmmExpr
    f (CmmMachOp MachOp
    op [CmmExpr]
    es)       = CmmExpr -> CmmExpr
    f (MachOp -> [CmmExpr] -> CmmExpr
    CmmMachOp MachOp
    op ([CmmExpr] -> CmmExpr) -> [CmmExpr] -> CmmExpr
    forall a b. (a -> b) -> a -> b
    $ (CmmExpr -> CmmExpr) -> [CmmExpr] -> [CmmExpr]
    forall a b. (a -> b) -> [a] -> [b]
    map ((CmmExpr -> CmmExpr) -> CmmExpr -> CmmExpr
    wrapRecExp CmmExpr -> CmmExpr
    f) [CmmExpr]
    es)
    wrapRecExp CmmExpr -> CmmExpr
    f (CmmLoad CmmExpr
    addr CmmType
    ty AlignmentSpec
    align) = CmmExpr -> CmmExpr
    f (CmmExpr -> CmmType -> AlignmentSpec -> CmmExpr
    CmmLoad ((CmmExpr -> CmmExpr) -> CmmExpr -> CmmExpr
    wrapRecExp CmmExpr -> CmmExpr
    f CmmExpr
    addr) CmmType
    ty AlignmentSpec
    align)
    wrapRecExp CmmExpr -> CmmExpr
    f CmmExpr
    e                       = CmmExpr -> CmmExpr
    f CmmExpr
    e

    mapExp :: (CmmExpr -> CmmExpr) -> CmmNode e x -> CmmNode e x
    mapExp :: forall (e :: Extensibility) (x :: Extensibility).
    (CmmExpr -> CmmExpr) -> CmmNode e x -> CmmNode e x
    mapExp CmmExpr -> CmmExpr
    _ f :: CmmNode e x
    f@(CmmEntry{})                          = CmmNode e x
    f
    mapExp CmmExpr -> CmmExpr
    _ m :: CmmNode e x
    m@(CmmComment FastString
    _)                        = CmmNode e x
    m
    mapExp CmmExpr -> CmmExpr
    _ m :: CmmNode e x
    m@(CmmTick CmmTickish
    _)                           = CmmNode e x
    m
    mapExp CmmExpr -> CmmExpr
    f   (CmmUnwind [(GlobalReg, Maybe CmmExpr)]
    regs)                      = [(GlobalReg, Maybe CmmExpr)] -> CmmNode 'Open 'Open
    CmmUnwind (((GlobalReg, Maybe CmmExpr) -> (GlobalReg, Maybe CmmExpr))
    -> [(GlobalReg, Maybe CmmExpr)] -> [(GlobalReg, Maybe CmmExpr)]
    forall a b. (a -> b) -> [a] -> [b]
    map ((Maybe CmmExpr -> Maybe CmmExpr)
    -> (GlobalReg, Maybe CmmExpr) -> (GlobalReg, Maybe CmmExpr)
    forall a b. (a -> b) -> (GlobalReg, a) -> (GlobalReg, b)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ((CmmExpr -> CmmExpr) -> Maybe CmmExpr -> Maybe CmmExpr
    forall a b. (a -> b) -> Maybe a -> Maybe b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap CmmExpr -> CmmExpr
    f)) [(GlobalReg, Maybe CmmExpr)]
    regs)
    mapExp CmmExpr -> CmmExpr
    f   (CmmAssign CmmReg
    r CmmExpr
    e)                       = CmmReg -> CmmExpr -> CmmNode 'Open 'Open
    CmmAssign CmmReg
    r (CmmExpr -> CmmExpr
    f CmmExpr
    e)
    mapExp CmmExpr -> CmmExpr
    f   (CmmStore CmmExpr
    addr CmmExpr
    e AlignmentSpec
    align)               = CmmExpr -> CmmExpr -> AlignmentSpec -> CmmNode 'Open 'Open
    CmmStore (CmmExpr -> CmmExpr
    f CmmExpr
    addr) (CmmExpr -> CmmExpr
    f CmmExpr
    e) AlignmentSpec
    align
    mapExp CmmExpr -> CmmExpr
    f   (CmmUnsafeForeignCall ForeignTarget
    tgt [CmmFormal]
    fs [CmmExpr]
    as)      = ForeignTarget -> [CmmFormal] -> [CmmExpr] -> CmmNode 'Open 'Open
    CmmUnsafeForeignCall ((CmmExpr -> CmmExpr) -> ForeignTarget -> ForeignTarget
    mapForeignTarget CmmExpr -> CmmExpr
    f ForeignTarget
    tgt) [CmmFormal]
    fs ((CmmExpr -> CmmExpr) -> [CmmExpr] -> [CmmExpr]
    forall a b. (a -> b) -> [a] -> [b]
    map CmmExpr -> CmmExpr
    f [CmmExpr]
    as)
    mapExp CmmExpr -> CmmExpr
    _ l :: CmmNode e x
    l@(CmmBranch Label
    _)                         = CmmNode e x
    l
    mapExp CmmExpr -> CmmExpr
    f   (CmmCondBranch CmmExpr
    e Label
    ti Label
    fi Maybe Bool
    l)             = CmmExpr -> Label -> Label -> Maybe Bool -> CmmNode 'Open 'Closed
    CmmCondBranch (CmmExpr -> CmmExpr
    f CmmExpr
    e) Label
    ti Label
    fi Maybe Bool
    l
    mapExp CmmExpr -> CmmExpr
    f   (CmmSwitch CmmExpr
    e SwitchTargets
    ids)                     = CmmExpr -> SwitchTargets -> CmmNode 'Open 'Closed
    CmmSwitch (CmmExpr -> CmmExpr
    f CmmExpr
    e) SwitchTargets
    ids
    mapExp CmmExpr -> CmmExpr
    f   n :: CmmNode e x
    n@CmmCall {cml_target :: CmmNode 'Open 'Closed -> CmmExpr
    cml_target=CmmExpr
    tgt}            = CmmNode e x
    n{cml_target = f tgt}
    mapExp CmmExpr -> CmmExpr
    f   (CmmForeignCall ForeignTarget
    tgt [CmmFormal]
    fs [CmmExpr]
    as Label
    succ ByteOff
    ret_args ByteOff
    updfr Bool
    intrbl) = ForeignTarget
    -> [CmmFormal]
    -> [CmmExpr]
    -> Label
    -> ByteOff
    -> ByteOff
    -> Bool
    -> CmmNode 'Open 'Closed
    CmmForeignCall ((CmmExpr -> CmmExpr) -> ForeignTarget -> ForeignTarget
    mapForeignTarget CmmExpr -> CmmExpr
    f ForeignTarget
    tgt) [CmmFormal]
    fs ((CmmExpr -> CmmExpr) -> [CmmExpr] -> [CmmExpr]
    forall a b. (a -> b) -> [a] -> [b]
    map CmmExpr -> CmmExpr
    f [CmmExpr]
    as) Label
    succ ByteOff
    ret_args ByteOff
    updfr Bool
    intrbl

    mapExpDeep :: (CmmExpr -> CmmExpr) -> CmmNode e x -> CmmNode e x
    mapExpDeep :: forall (e :: Extensibility) (x :: Extensibility).
    (CmmExpr -> CmmExpr) -> CmmNode e x -> CmmNode e x
    mapExpDeep CmmExpr -> CmmExpr
    f = (CmmExpr -> CmmExpr) -> CmmNode e x -> CmmNode e x
    forall (e :: Extensibility) (x :: Extensibility).
    (CmmExpr -> CmmExpr) -> CmmNode e x -> CmmNode e x
    mapExp ((CmmExpr -> CmmExpr) -> CmmNode e x -> CmmNode e x)
    -> (CmmExpr -> CmmExpr) -> CmmNode e x -> CmmNode e x
    forall a b. (a -> b) -> a -> b
    $ (CmmExpr -> CmmExpr) -> CmmExpr -> CmmExpr
    wrapRecExp CmmExpr -> CmmExpr
    f

    ------------------------------------------------------------------------
    -- mapping Expr in GHC.Cmm.Node, but not performing allocation if no changes

    mapForeignTargetM :: (CmmExpr -> Maybe CmmExpr) -> ForeignTarget -> Maybe ForeignTarget
    mapForeignTargetM :: (CmmExpr -> Maybe CmmExpr) -> ForeignTarget -> Maybe ForeignTarget
    mapForeignTargetM CmmExpr -> Maybe CmmExpr
    f (ForeignTarget CmmExpr
    e ForeignConvention
    c) = (\CmmExpr
    x -> CmmExpr -> ForeignConvention -> ForeignTarget
    ForeignTarget CmmExpr
    x ForeignConvention
    c) (CmmExpr -> ForeignTarget) -> Maybe CmmExpr -> Maybe ForeignTarget
    forall a b. (a -> b) -> Maybe a -> Maybe b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    `fmap` CmmExpr -> Maybe CmmExpr
    f CmmExpr
    e
    mapForeignTargetM CmmExpr -> Maybe CmmExpr
    _ (PrimTarget CallishMachOp
    _)      = Maybe ForeignTarget
    forall a. Maybe a
    Nothing

    wrapRecExpM :: (CmmExpr -> Maybe CmmExpr) -> (CmmExpr -> Maybe CmmExpr)
    -- (wrapRecExpM f e) first recursively applies itself to sub-expressions of e
    --                   then  gives f a chance to rewrite the resulting expression
    wrapRecExpM :: (CmmExpr -> Maybe CmmExpr) -> CmmExpr -> Maybe CmmExpr
    wrapRecExpM CmmExpr -> Maybe CmmExpr
    f n :: CmmExpr
    n@(CmmMachOp MachOp
    op [CmmExpr]
    es)       = Maybe CmmExpr
    -> ([CmmExpr] -> Maybe CmmExpr) -> Maybe [CmmExpr] -> Maybe CmmExpr
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe (CmmExpr -> Maybe CmmExpr
    f CmmExpr
    n) (CmmExpr -> Maybe CmmExpr
    f (CmmExpr -> Maybe CmmExpr)
    -> ([CmmExpr] -> CmmExpr) -> [CmmExpr] -> Maybe CmmExpr
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . MachOp -> [CmmExpr] -> CmmExpr
    CmmMachOp MachOp
    op)    ((CmmExpr -> Maybe CmmExpr) -> [CmmExpr] -> Maybe [CmmExpr]
    forall a. (a -> Maybe a) -> [a] -> Maybe [a]
    mapListM ((CmmExpr -> Maybe CmmExpr) -> CmmExpr -> Maybe CmmExpr
    wrapRecExpM CmmExpr -> Maybe CmmExpr
    f) [CmmExpr]
    es)
    wrapRecExpM CmmExpr -> Maybe CmmExpr
    f n :: CmmExpr
    n@(CmmLoad CmmExpr
    addr CmmType
    ty AlignmentSpec
    align) = Maybe CmmExpr
    -> (CmmExpr -> Maybe CmmExpr) -> Maybe CmmExpr -> Maybe CmmExpr
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe (CmmExpr -> Maybe CmmExpr
    f CmmExpr
    n) (\CmmExpr
    addr' -> CmmExpr -> Maybe CmmExpr
    f (CmmExpr -> Maybe CmmExpr) -> CmmExpr -> Maybe CmmExpr
    forall a b. (a -> b) -> a -> b
    $ CmmExpr -> CmmType -> AlignmentSpec -> CmmExpr
    CmmLoad CmmExpr
    addr' CmmType
    ty AlignmentSpec
    align) ((CmmExpr -> Maybe CmmExpr) -> CmmExpr -> Maybe CmmExpr
    wrapRecExpM CmmExpr -> Maybe CmmExpr
    f CmmExpr
    addr)
    wrapRecExpM CmmExpr -> Maybe CmmExpr
    f CmmExpr
    e                         = CmmExpr -> Maybe CmmExpr
    f CmmExpr
    e

    mapExpM :: (CmmExpr -> Maybe CmmExpr) -> CmmNode e x -> Maybe (CmmNode e x)
    mapExpM :: forall (e :: Extensibility) (x :: Extensibility).
    (CmmExpr -> Maybe CmmExpr) -> CmmNode e x -> Maybe (CmmNode e x)
    mapExpM CmmExpr -> Maybe CmmExpr
    _ (CmmEntry{})              = Maybe (CmmNode e x)
    forall a. Maybe a
    Nothing
    mapExpM CmmExpr -> Maybe CmmExpr
    _ (CmmComment FastString
    _)            = Maybe (CmmNode e x)
    forall a. Maybe a
    Nothing
    mapExpM CmmExpr -> Maybe CmmExpr
    _ (CmmTick CmmTickish
    _)               = Maybe (CmmNode e x)
    forall a. Maybe a
    Nothing
    mapExpM CmmExpr -> Maybe CmmExpr
    f (CmmUnwind [(GlobalReg, Maybe CmmExpr)]
    regs)          = [(GlobalReg, Maybe CmmExpr)] -> CmmNode e x
    [(GlobalReg, Maybe CmmExpr)] -> CmmNode 'Open 'Open
    CmmUnwind ([(GlobalReg, Maybe CmmExpr)] -> CmmNode e x)
    -> Maybe [(GlobalReg, Maybe CmmExpr)] -> Maybe (CmmNode e x)
    forall a b. (a -> b) -> Maybe a -> Maybe b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    `fmap` ((GlobalReg, Maybe CmmExpr) -> Maybe (GlobalReg, Maybe CmmExpr))
    -> [(GlobalReg, Maybe CmmExpr)]
    -> Maybe [(GlobalReg, Maybe CmmExpr)]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM (\(GlobalReg
    r,Maybe CmmExpr
    e) -> (CmmExpr -> Maybe CmmExpr)
    -> Maybe CmmExpr -> Maybe (Maybe CmmExpr)
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> Maybe a -> m (Maybe b)
    mapM CmmExpr -> Maybe CmmExpr
    f Maybe CmmExpr
    e Maybe (Maybe CmmExpr)
    -> (Maybe CmmExpr -> Maybe (GlobalReg, Maybe CmmExpr))
    -> Maybe (GlobalReg, Maybe CmmExpr)
    forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= \Maybe CmmExpr
    e' -> (GlobalReg, Maybe CmmExpr) -> Maybe (GlobalReg, Maybe CmmExpr)
    forall a. a -> Maybe a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (GlobalReg
    r,Maybe CmmExpr
    e')) [(GlobalReg, Maybe CmmExpr)]
    regs
    mapExpM CmmExpr -> Maybe CmmExpr
    f (CmmAssign CmmReg
    r CmmExpr
    e)           = CmmReg -> CmmExpr -> CmmNode 'Open 'Open
    CmmAssign CmmReg
    r (CmmExpr -> CmmNode e x) -> Maybe CmmExpr -> Maybe (CmmNode e x)
    forall a b. (a -> b) -> Maybe a -> Maybe b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    `fmap` CmmExpr -> Maybe CmmExpr
    f CmmExpr
    e
    mapExpM CmmExpr -> Maybe CmmExpr
    f (CmmStore CmmExpr
    addr CmmExpr
    e AlignmentSpec
    align)   = (\ (Pair CmmExpr
    addr' CmmExpr
    e') -> CmmExpr -> CmmExpr -> AlignmentSpec -> CmmNode 'Open 'Open
    CmmStore CmmExpr
    addr' CmmExpr
    e' AlignmentSpec
    align) (Pair CmmExpr -> CmmNode e x)
    -> Maybe (Pair CmmExpr) -> Maybe (CmmNode e x)
    forall a b. (a -> b) -> Maybe a -> Maybe b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    `fmap` (CmmExpr -> Maybe CmmExpr) -> Pair CmmExpr -> Maybe (Pair CmmExpr)
    forall (t :: * -> *) (f :: * -> *) a b.
    (Traversable t, Applicative f) =>
    (a -> f b) -> t a -> f (t b)
    forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> Pair a -> f (Pair b)
    traverse CmmExpr -> Maybe CmmExpr
    f (CmmExpr -> CmmExpr -> Pair CmmExpr
    forall a. a -> a -> Pair a
    Pair CmmExpr
    addr CmmExpr
    e)
    mapExpM CmmExpr -> Maybe CmmExpr
    _ (CmmBranch Label
    _)             = Maybe (CmmNode e x)
    forall a. Maybe a
    Nothing
    mapExpM CmmExpr -> Maybe CmmExpr
    f (CmmCondBranch CmmExpr
    e Label
    ti Label
    fi Maybe Bool
    l) = (\CmmExpr
    x -> CmmExpr -> Label -> Label -> Maybe Bool -> CmmNode 'Open 'Closed
    CmmCondBranch CmmExpr
    x Label
    ti Label
    fi Maybe Bool
    l) (CmmExpr -> CmmNode e x) -> Maybe CmmExpr -> Maybe (CmmNode e x)
    forall a b. (a -> b) -> Maybe a -> Maybe b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    `fmap` CmmExpr -> Maybe CmmExpr
    f CmmExpr
    e
    mapExpM CmmExpr -> Maybe CmmExpr
    f (CmmSwitch CmmExpr
    e SwitchTargets
    tbl)         = (\CmmExpr
    x -> CmmExpr -> SwitchTargets -> CmmNode 'Open 'Closed
    CmmSwitch CmmExpr
    x SwitchTargets
    tbl)       (CmmExpr -> CmmNode e x) -> Maybe CmmExpr -> Maybe (CmmNode e x)
    forall a b. (a -> b) -> Maybe a -> Maybe b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    `fmap` CmmExpr -> Maybe CmmExpr
    f CmmExpr
    e
    mapExpM CmmExpr -> Maybe CmmExpr
    f (CmmCall CmmExpr
    tgt Maybe Label
    mb_id [GlobalRegUse]
    r ByteOff
    o ByteOff
    i ByteOff
    s) = (\CmmExpr
    x -> CmmExpr
    -> Maybe Label
    -> [GlobalRegUse]
    -> ByteOff
    -> ByteOff
    -> ByteOff
    -> CmmNode 'Open 'Closed
    CmmCall CmmExpr
    x Maybe Label
    mb_id [GlobalRegUse]
    r ByteOff
    o ByteOff
    i ByteOff
    s) (CmmExpr -> CmmNode e x) -> Maybe CmmExpr -> Maybe (CmmNode e x)
    forall a b. (a -> b) -> Maybe a -> Maybe b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    `fmap` CmmExpr -> Maybe CmmExpr
    f CmmExpr
    tgt
    mapExpM CmmExpr -> Maybe CmmExpr
    f (CmmUnsafeForeignCall ForeignTarget
    tgt [CmmFormal]
    fs [CmmExpr]
    as)
        = case (CmmExpr -> Maybe CmmExpr) -> ForeignTarget -> Maybe ForeignTarget
    mapForeignTargetM CmmExpr -> Maybe CmmExpr
    f ForeignTarget
    tgt of
            Just ForeignTarget
    tgt' -> CmmNode e x -> Maybe (CmmNode e x)
    forall a. a -> Maybe a
    Just (ForeignTarget -> [CmmFormal] -> [CmmExpr] -> CmmNode 'Open 'Open
    CmmUnsafeForeignCall ForeignTarget
    tgt' [CmmFormal]
    fs ((CmmExpr -> Maybe CmmExpr) -> [CmmExpr] -> [CmmExpr]
    forall a. (a -> Maybe a) -> [a] -> [a]
    mapListJ CmmExpr -> Maybe CmmExpr
    f [CmmExpr]
    as))
            Maybe ForeignTarget
    Nothing   -> (\[CmmExpr]
    xs -> ForeignTarget -> [CmmFormal] -> [CmmExpr] -> CmmNode 'Open 'Open
    CmmUnsafeForeignCall ForeignTarget
    tgt [CmmFormal]
    fs [CmmExpr]
    xs) ([CmmExpr] -> CmmNode e x)
    -> Maybe [CmmExpr] -> Maybe (CmmNode e x)
    forall a b. (a -> b) -> Maybe a -> Maybe b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    `fmap` (CmmExpr -> Maybe CmmExpr) -> [CmmExpr] -> Maybe [CmmExpr]
    forall a. (a -> Maybe a) -> [a] -> Maybe [a]
    mapListM CmmExpr -> Maybe CmmExpr
    f [CmmExpr]
    as
    mapExpM CmmExpr -> Maybe CmmExpr
    f (CmmForeignCall ForeignTarget
    tgt [CmmFormal]
    fs [CmmExpr]
    as Label
    succ ByteOff
    ret_args ByteOff
    updfr Bool
    intrbl)
        = case (CmmExpr -> Maybe CmmExpr) -> ForeignTarget -> Maybe ForeignTarget
    mapForeignTargetM CmmExpr -> Maybe CmmExpr
    f ForeignTarget
    tgt of
            Just ForeignTarget
    tgt' -> CmmNode e x -> Maybe (CmmNode e x)
    forall a. a -> Maybe a
    Just (ForeignTarget
    -> [CmmFormal]
    -> [CmmExpr]
    -> Label
    -> ByteOff
    -> ByteOff
    -> Bool
    -> CmmNode 'Open 'Closed
    CmmForeignCall ForeignTarget
    tgt' [CmmFormal]
    fs ((CmmExpr -> Maybe CmmExpr) -> [CmmExpr] -> [CmmExpr]
    forall a. (a -> Maybe a) -> [a] -> [a]
    mapListJ CmmExpr -> Maybe CmmExpr
    f [CmmExpr]
    as) Label
    succ ByteOff
    ret_args ByteOff
    updfr Bool
    intrbl)
            Maybe ForeignTarget
    Nothing   -> (\[CmmExpr]
    xs -> ForeignTarget
    -> [CmmFormal]
    -> [CmmExpr]
    -> Label
    -> ByteOff
    -> ByteOff
    -> Bool
    -> CmmNode 'Open 'Closed
    CmmForeignCall ForeignTarget
    tgt [CmmFormal]
    fs [CmmExpr]
    xs Label
    succ ByteOff
    ret_args ByteOff
    updfr Bool
    intrbl) ([CmmExpr] -> CmmNode e x)
    -> Maybe [CmmExpr] -> Maybe (CmmNode e x)
    forall a b. (a -> b) -> Maybe a -> Maybe b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    `fmap` (CmmExpr -> Maybe CmmExpr) -> [CmmExpr] -> Maybe [CmmExpr]
    forall a. (a -> Maybe a) -> [a] -> Maybe [a]
    mapListM CmmExpr -> Maybe CmmExpr
    f [CmmExpr]
    as

    -- share as much as possible
    mapListM :: (a -> Maybe a) -> [a] -> Maybe [a]
    mapListM :: forall a. (a -> Maybe a) -> [a] -> Maybe [a]
    mapListM a -> Maybe a
    f [a]
    xs = let (Bool
    b, [a]
    r) = (a -> Maybe a) -> [a] -> (Bool, [a])
    forall a. (a -> Maybe a) -> [a] -> (Bool, [a])
    mapListT a -> Maybe a
    f [a]
    xs
                    in if Bool
    b then [a] -> Maybe [a]
    forall a. a -> Maybe a
    Just [a]
    r else Maybe [a]
    forall a. Maybe a
    Nothing

    mapListJ :: (a -> Maybe a) -> [a] -> [a]
    mapListJ :: forall a. (a -> Maybe a) -> [a] -> [a]
    mapListJ a -> Maybe a
    f [a]
    xs = (Bool, [a]) -> [a]
    forall a b. (a, b) -> b
    snd ((a -> Maybe a) -> [a] -> (Bool, [a])
    forall a. (a -> Maybe a) -> [a] -> (Bool, [a])
    mapListT a -> Maybe a
    f [a]
    xs)

    mapListT :: (a -> Maybe a) -> [a] -> (Bool, [a])
    mapListT :: forall a. (a -> Maybe a) -> [a] -> (Bool, [a])
    mapListT a -> Maybe a
    f [a]
    xs = (([a], a, Maybe a) -> (Bool, [a]) -> (Bool, [a]))
    -> (Bool, [a]) -> [([a], a, Maybe a)] -> (Bool, [a])
    forall a b. (a -> b -> b) -> b -> [a] -> b
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr ([a], a, Maybe a) -> (Bool, [a]) -> (Bool, [a])
    forall {a}. ([a], a, Maybe a) -> (Bool, [a]) -> (Bool, [a])
    g (Bool
    False, []) ([[a]] -> [a] -> [Maybe a] -> [([a], a, Maybe a)]
    forall a b c. [a] -> [b] -> [c] -> [(a, b, c)]
    zip3 ([a] -> [[a]]
    forall a. [a] -> [[a]]
    tails [a]
    xs) [a]
    xs ((a -> Maybe a) -> [a] -> [Maybe a]
    forall a b. (a -> b) -> [a] -> [b]
    map a -> Maybe a
    f [a]
    xs))
        where g :: ([a], a, Maybe a) -> (Bool, [a]) -> (Bool, [a])
    g ([a]
    _,   a
    y, Maybe a
    Nothing) (Bool
    True, [a]
    ys)  = (Bool
    True,  a
    ya -> [a] -> [a]
    forall a. a -> [a] -> [a]
    :[a]
    ys)
              g ([a]
    _,   a
    _, Just a
    y)  (Bool
    True, [a]
    ys)  = (Bool
    True,  a
    ya -> [a] -> [a]
    forall a. a -> [a] -> [a]
    :[a]
    ys)
              g ([a]
    ys', a
    _, Maybe a
    Nothing) (Bool
    False, [a]
    _)  = (Bool
    False, [a]
    ys')
              g ([a]
    _,   a
    _, Just a
    y)  (Bool
    False, [a]
    ys) = (Bool
    True,  a
    ya -> [a] -> [a]
    forall a. a -> [a] -> [a]
    :[a]
    ys)

    mapExpDeepM :: (CmmExpr -> Maybe CmmExpr) -> CmmNode e x -> Maybe (CmmNode e x)
    mapExpDeepM :: forall (e :: Extensibility) (x :: Extensibility).
    (CmmExpr -> Maybe CmmExpr) -> CmmNode e x -> Maybe (CmmNode e x)
    mapExpDeepM CmmExpr -> Maybe CmmExpr
    f = (CmmExpr -> Maybe CmmExpr) -> CmmNode e x -> Maybe (CmmNode e x)
    forall (e :: Extensibility) (x :: Extensibility).
    (CmmExpr -> Maybe CmmExpr) -> CmmNode e x -> Maybe (CmmNode e x)
    mapExpM ((CmmExpr -> Maybe CmmExpr) -> CmmNode e x -> Maybe (CmmNode e x))
    -> (CmmExpr -> Maybe CmmExpr) -> CmmNode e x -> Maybe (CmmNode e x)
    forall a b. (a -> b) -> a -> b
    $ (CmmExpr -> Maybe CmmExpr) -> CmmExpr -> Maybe CmmExpr
    wrapRecExpM CmmExpr -> Maybe CmmExpr
    f

    -----------------------------------
    -- folding Expr in GHC.Cmm.Node

    foldExpForeignTarget :: (CmmExpr -> z -> z) -> ForeignTarget -> z -> z
    foldExpForeignTarget :: forall z. (CmmExpr -> z -> z) -> ForeignTarget -> z -> z
    foldExpForeignTarget CmmExpr -> z -> z
    exp (ForeignTarget CmmExpr
    e ForeignConvention
    _) z
    z = CmmExpr -> z -> z
    exp CmmExpr
    e z
    z
    foldExpForeignTarget CmmExpr -> z -> z
    _   (PrimTarget CallishMachOp
    _)      z
    z = z
    z

    -- Take a folder on expressions and apply it recursively.
    -- Specifically (wrapRecExpf f e z) deals with CmmMachOp and CmmLoad
    -- itself, delegating all the other CmmExpr forms to 'f'.
    wrapRecExpf :: (CmmExpr -> z -> z) -> CmmExpr -> z -> z
    wrapRecExpf :: forall z. (CmmExpr -> z -> z) -> CmmExpr -> z -> z
    wrapRecExpf CmmExpr -> z -> z
    f e :: CmmExpr
    e@(CmmMachOp MachOp
    _ [CmmExpr]
    es)   z
    z = (CmmExpr -> z -> z) -> z -> [CmmExpr] -> z
    forall a b. (a -> b -> b) -> b -> [a] -> b
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr ((CmmExpr -> z -> z) -> CmmExpr -> z -> z
    forall z. (CmmExpr -> z -> z) -> CmmExpr -> z -> z
    wrapRecExpf CmmExpr -> z -> z
    f) (CmmExpr -> z -> z
    f CmmExpr
    e z
    z) [CmmExpr]
    es
    wrapRecExpf CmmExpr -> z -> z
    f e :: CmmExpr
    e@(CmmLoad CmmExpr
    addr CmmType
    _ AlignmentSpec
    _) z
    z = (CmmExpr -> z -> z) -> CmmExpr -> z -> z
    forall z. (CmmExpr -> z -> z) -> CmmExpr -> z -> z
    wrapRecExpf CmmExpr -> z -> z
    f CmmExpr
    addr (CmmExpr -> z -> z
    f CmmExpr
    e z
    z)
    wrapRecExpf CmmExpr -> z -> z
    f CmmExpr
    e                    z
    z = CmmExpr -> z -> z
    f CmmExpr
    e z
    z

    foldExp :: (CmmExpr -> z -> z) -> CmmNode e x -> z -> z
    foldExp :: forall z (e :: Extensibility) (x :: Extensibility).
    (CmmExpr -> z -> z) -> CmmNode e x -> z -> z
    foldExp CmmExpr -> z -> z
    _ (CmmEntry {}) z
    z                         = z
    z
    foldExp CmmExpr -> z -> z
    _ (CmmComment {}) z
    z                       = z
    z
    foldExp CmmExpr -> z -> z
    _ (CmmTick {}) z
    z                          = z
    z
    foldExp CmmExpr -> z -> z
    f (CmmUnwind [(GlobalReg, Maybe CmmExpr)]
    xs) z
    z                        = (Maybe CmmExpr -> z -> z) -> z -> [Maybe CmmExpr] -> z
    forall a b. (a -> b -> b) -> b -> [a] -> b
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr ((z -> z) -> (CmmExpr -> z -> z) -> Maybe CmmExpr -> z -> z
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe z -> z
    forall a. a -> a
    id CmmExpr -> z -> z
    f) z
    z (((GlobalReg, Maybe CmmExpr) -> Maybe CmmExpr)
    -> [(GlobalReg, Maybe CmmExpr)] -> [Maybe CmmExpr]
    forall a b. (a -> b) -> [a] -> [b]
    map (GlobalReg, Maybe CmmExpr) -> Maybe CmmExpr
    forall a b. (a, b) -> b
    snd [(GlobalReg, Maybe CmmExpr)]
    xs)
    foldExp CmmExpr -> z -> z
    f (CmmAssign CmmReg
    _ CmmExpr
    e) z
    z                       = CmmExpr -> z -> z
    f CmmExpr
    e z
    z
    foldExp CmmExpr -> z -> z
    f (CmmStore CmmExpr
    addr CmmExpr
    e AlignmentSpec
    _) z
    z                   = CmmExpr -> z -> z
    f CmmExpr
    addr (z -> z) -> z -> z
    forall a b. (a -> b) -> a -> b
    $ CmmExpr -> z -> z
    f CmmExpr
    e z
    z
    foldExp CmmExpr -> z -> z
    f (CmmUnsafeForeignCall ForeignTarget
    t [CmmFormal]
    _ [CmmExpr]
    as) z
    z         = (CmmExpr -> z -> z) -> z -> [CmmExpr] -> z
    forall a b. (a -> b -> b) -> b -> [a] -> b
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr CmmExpr -> z -> z
    f ((CmmExpr -> z -> z) -> ForeignTarget -> z -> z
    forall z. (CmmExpr -> z -> z) -> ForeignTarget -> z -> z
    foldExpForeignTarget CmmExpr -> z -> z
    f ForeignTarget
    t z
    z) [CmmExpr]
    as
    foldExp CmmExpr -> z -> z
    _ (CmmBranch Label
    _) z
    z                         = z
    z
    foldExp CmmExpr -> z -> z
    f (CmmCondBranch CmmExpr
    e Label
    _ Label
    _ Maybe Bool
    _) z
    z               = CmmExpr -> z -> z
    f CmmExpr
    e z
    z
    foldExp CmmExpr -> z -> z
    f (CmmSwitch CmmExpr
    e SwitchTargets
    _) z
    z                       = CmmExpr -> z -> z
    f CmmExpr
    e z
    z
    foldExp CmmExpr -> z -> z
    f (CmmCall {cml_target :: CmmNode 'Open 'Closed -> CmmExpr
    cml_target=CmmExpr
    tgt}) z
    z            = CmmExpr -> z -> z
    f CmmExpr
    tgt z
    z
    foldExp CmmExpr -> z -> z
    f (CmmForeignCall {tgt :: CmmNode 'Open 'Closed -> ForeignTarget
    tgt=ForeignTarget
    tgt, args :: CmmNode 'Open 'Closed -> [CmmExpr]
    args=[CmmExpr]
    args}) z
    z = (CmmExpr -> z -> z) -> z -> [CmmExpr] -> z
    forall a b. (a -> b -> b) -> b -> [a] -> b
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr CmmExpr -> z -> z
    f ((CmmExpr -> z -> z) -> ForeignTarget -> z -> z
    forall z. (CmmExpr -> z -> z) -> ForeignTarget -> z -> z
    foldExpForeignTarget CmmExpr -> z -> z
    f ForeignTarget
    tgt z
    z) [CmmExpr]
    args

    foldExpDeep :: (CmmExpr -> z -> z) -> CmmNode e x -> z -> z
    foldExpDeep :: forall z (e :: Extensibility) (x :: Extensibility).
    (CmmExpr -> z -> z) -> CmmNode e x -> z -> z
    foldExpDeep CmmExpr -> z -> z
    f = (CmmExpr -> z -> z) -> CmmNode e x -> z -> z
    forall z (e :: Extensibility) (x :: Extensibility).
    (CmmExpr -> z -> z) -> CmmNode e x -> z -> z
    foldExp ((CmmExpr -> z -> z) -> CmmExpr -> z -> z
    forall z. (CmmExpr -> z -> z) -> CmmExpr -> z -> z
    wrapRecExpf CmmExpr -> z -> z
    f)

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

    mapSuccessors :: (Label -> Label) -> CmmNode O C -> CmmNode O C
    mapSuccessors :: (Label -> Label) -> CmmNode 'Open 'Closed -> CmmNode 'Open 'Closed
    mapSuccessors Label -> Label
    f (CmmBranch Label
    bid)         = Label -> CmmNode 'Open 'Closed
    CmmBranch (Label -> Label
    f Label
    bid)
    mapSuccessors Label -> Label
    f (CmmCondBranch CmmExpr
    p Label
    y Label
    n Maybe Bool
    l) = CmmExpr -> Label -> Label -> Maybe Bool -> CmmNode 'Open 'Closed
    CmmCondBranch CmmExpr
    p (Label -> Label
    f Label
    y) (Label -> Label
    f Label
    n) Maybe Bool
    l
    mapSuccessors Label -> Label
    f (CmmSwitch CmmExpr
    e SwitchTargets
    ids)       = CmmExpr -> SwitchTargets -> CmmNode 'Open 'Closed
    CmmSwitch CmmExpr
    e ((Label -> Label) -> SwitchTargets -> SwitchTargets
    mapSwitchTargets Label -> Label
    f SwitchTargets
    ids)
    mapSuccessors Label -> Label
    _ CmmNode 'Open 'Closed
    n = CmmNode 'Open 'Closed
    n

    mapCollectSuccessors :: forall a. (Label -> (Label,a)) -> CmmNode O C
                         -> (CmmNode O C, [a])
    mapCollectSuccessors :: forall a.
    (Label -> (Label, a))
    -> CmmNode 'Open 'Closed -> (CmmNode 'Open 'Closed, [a])
    mapCollectSuccessors Label -> (Label, a)
    f (CmmBranch Label
    bid)
      = let (Label
    bid', a
    acc) = Label -> (Label, a)
    f Label
    bid in (Label -> CmmNode 'Open 'Closed
    CmmBranch Label
    bid', [a
    acc])
    mapCollectSuccessors Label -> (Label, a)
    f (CmmCondBranch CmmExpr
    p Label
    y Label
    n Maybe Bool
    l)
      = let (Label
    bidt, a
    acct) = Label -> (Label, a)
    f Label
    y
            (Label
    bidf, a
    accf) = Label -> (Label, a)
    f Label
    n
        in  (CmmExpr -> Label -> Label -> Maybe Bool -> CmmNode 'Open 'Closed
    CmmCondBranch CmmExpr
    p Label
    bidt Label
    bidf Maybe Bool
    l, [a
    accf, a
    acct])
    mapCollectSuccessors Label -> (Label, a)
    f (CmmSwitch CmmExpr
    e SwitchTargets
    ids)
      = let lbls :: [Label]
    lbls = SwitchTargets -> [Label]
    switchTargetsToList SwitchTargets
    ids :: [Label]
            lblMap :: LabelMap (Label, a)
    lblMap = [(Label, (Label, a))] -> LabelMap (Label, a)
    forall v. [(Label, v)] -> LabelMap v
    mapFromList ([(Label, (Label, a))] -> LabelMap (Label, a))
    -> [(Label, (Label, a))] -> LabelMap (Label, a)
    forall a b. (a -> b) -> a -> b
    $ [Label] -> [(Label, a)] -> [(Label, (Label, a))]
    forall a b. [a] -> [b] -> [(a, b)]
    zip [Label]
    lbls ((Label -> (Label, a)) -> [Label] -> [(Label, a)]
    forall a b. (a -> b) -> [a] -> [b]
    map Label -> (Label, a)
    f [Label]
    lbls) :: LabelMap (Label, a)
        in ( CmmExpr -> SwitchTargets -> CmmNode 'Open 'Closed
    CmmSwitch CmmExpr
    e
              ((Label -> Label) -> SwitchTargets -> SwitchTargets
    mapSwitchTargets
                (\Label
    l -> (Label, a) -> Label
    forall a b. (a, b) -> a
    fst ((Label, a) -> Label) -> (Label, a) -> Label
    forall a b. (a -> b) -> a -> b
    $ (Label, a) -> Label -> LabelMap (Label, a) -> (Label, a)
    forall a. a -> Label -> LabelMap a -> a
    mapFindWithDefault (String -> (Label, a)
    forall a. HasCallStack => String -> a
    error String
    "impossible") Label
    l LabelMap (Label, a)
    lblMap) SwitchTargets
    ids)
              , ((Label, a) -> a) -> [(Label, a)] -> [a]
    forall a b. (a -> b) -> [a] -> [b]
    map (Label, a) -> a
    forall a b. (a, b) -> b
    snd (LabelMap (Label, a) -> [(Label, a)]
    forall a. LabelMap a -> [a]
    mapElems LabelMap (Label, a)
    lblMap)
            )
    mapCollectSuccessors Label -> (Label, a)
    _ CmmNode 'Open 'Closed
    n = (CmmNode 'Open 'Closed
    n, [])

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

    -- | Tick scope identifier, allowing us to reason about what
    -- annotations in a Cmm block should scope over. We especially take
    -- care to allow optimisations to reorganise blocks without losing
    -- tick association in the process.
    data CmmTickScope
      = GlobalScope
        -- ^ The global scope is the "root" of the scope graph. Every
        -- scope is a sub-scope of the global scope. It doesn't make sense
        -- to add ticks to this scope. On the other hand, this means that
        -- setting this scope on a block means no ticks apply to it.

      | SubScope !U.Unique CmmTickScope
        -- ^ Constructs a new sub-scope to an existing scope. This allows
        -- us to translate Core-style scoping rules (see @tickishScoped@)
        -- into the Cmm world. Suppose the following code:
        --
        --   tick<1> case ... of
        --             A -> tick<2> ...
        --             B -> tick<3> ...
        --
        -- We want the top-level tick annotation to apply to blocks
        -- generated for the A and B alternatives. We can achieve that by
        -- generating tick<1> into a block with scope a, while the code
        -- for alternatives A and B gets generated into sub-scopes a/b and
        -- a/c respectively.

      | CombinedScope CmmTickScope CmmTickScope
        -- ^ A combined scope scopes over everything that the two given
        -- scopes cover. It is therefore a sub-scope of either scope. This
        -- is required for optimisations. Consider common block elimination:
        --
        --   A -> tick<2> case ... of
        --     C -> [common]
        --   B -> tick<3> case ... of
        --     D -> [common]
        --
        -- We will generate code for the C and D alternatives, and figure
        -- out afterwards that it's actually common code. Scoping rules
        -- dictate that the resulting common block needs to be covered by
        -- both tick<2> and tick<3>, therefore we need to construct a
        -- scope that is a child to *both* scope. Now we can do that - if
        -- we assign the scopes a/c and b/d to the common-ed up blocks,
        -- the new block could have a combined tick scope a/c+b/d, which
        -- both tick<2> and tick<3> apply to.

    -- Note [CmmTick scoping details]
    -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    -- The scope of a @CmmTick@ is given by the @CmmEntry@ node of the
    -- same block. Note that as a result of this, optimisations making
    -- tick scopes more specific can *reduce* the amount of code a tick
    -- scopes over. Fixing this would require a separate @CmmTickScope@
    -- field for @CmmTick@. Right now we do not do this simply because I
    -- couldn't find an example where it actually mattered -- multiple
    -- blocks within the same scope generally jump to each other, which
    -- prevents common block elimination from happening in the first
    -- place. But this is no strong reason, so if Cmm optimisations become
    -- more involved in future this might have to be revisited.

    -- | Output all scope paths.
    scopeToPaths :: CmmTickScope -> [[U.Unique]]
    scopeToPaths :: CmmTickScope -> [[Unique]]
    scopeToPaths CmmTickScope
    GlobalScope           = [[]]
    scopeToPaths (SubScope Unique
    u CmmTickScope
    s)        = ([Unique] -> [Unique]) -> [[Unique]] -> [[Unique]]
    forall a b. (a -> b) -> [a] -> [b]
    map (Unique
    uUnique -> [Unique] -> [Unique]
    forall a. a -> [a] -> [a]
    :) (CmmTickScope -> [[Unique]]
    scopeToPaths CmmTickScope
    s)
    scopeToPaths (CombinedScope CmmTickScope
    s1 CmmTickScope
    s2) = CmmTickScope -> [[Unique]]
    scopeToPaths CmmTickScope
    s1 [[Unique]] -> [[Unique]] -> [[Unique]]
    forall a. [a] -> [a] -> [a]
    ++ CmmTickScope -> [[Unique]]
    scopeToPaths CmmTickScope
    s2

    -- | Returns the head uniques of the scopes. This is based on the
    -- assumption that the @Unique@ of @SubScope@ identifies the
    -- underlying super-scope. Used for efficient equality and comparison,
    -- see below.
    scopeUniques :: CmmTickScope -> [U.Unique]
    scopeUniques :: CmmTickScope -> [Unique]
    scopeUniques CmmTickScope
    GlobalScope           = []
    scopeUniques (SubScope Unique
    u CmmTickScope
    _)        = [Unique
    u]
    scopeUniques (CombinedScope CmmTickScope
    s1 CmmTickScope
    s2) = CmmTickScope -> [Unique]
    scopeUniques CmmTickScope
    s1 [Unique] -> [Unique] -> [Unique]
    forall a. [a] -> [a] -> [a]
    ++ CmmTickScope -> [Unique]
    scopeUniques CmmTickScope
    s2

    -- Equality and order is based on the head uniques defined above. We
    -- take care to short-cut the (extremely) common cases.
    instance Eq CmmTickScope where
      CmmTickScope
    GlobalScope    == :: CmmTickScope -> CmmTickScope -> Bool
    == CmmTickScope
    GlobalScope     = Bool
    True
      CmmTickScope
    GlobalScope    == CmmTickScope
    _               = Bool
    False
      CmmTickScope
    _              == CmmTickScope
    GlobalScope     = Bool
    False
      (SubScope Unique
    u CmmTickScope
    _) == (SubScope Unique
    u' CmmTickScope
    _) = Unique
    u Unique -> Unique -> Bool
    forall a. Eq a => a -> a -> Bool
    == Unique
    u'
      (SubScope Unique
    _ CmmTickScope
    _) == CmmTickScope
    _               = Bool
    False
      CmmTickScope
    _              == (SubScope Unique
    _ CmmTickScope
    _)  = Bool
    False
      CmmTickScope
    scope          == CmmTickScope
    scope'          =
        (Unique -> Unique -> Ordering) -> [Unique] -> [Unique]
    forall a. (a -> a -> Ordering) -> [a] -> [a]
    sortBy Unique -> Unique -> Ordering
    nonDetCmpUnique (CmmTickScope -> [Unique]
    scopeUniques CmmTickScope
    scope) [Unique] -> [Unique] -> Bool
    forall a. Eq a => a -> a -> Bool
    ==
        (Unique -> Unique -> Ordering) -> [Unique] -> [Unique]
    forall a. (a -> a -> Ordering) -> [a] -> [a]
    sortBy Unique -> Unique -> Ordering
    nonDetCmpUnique (CmmTickScope -> [Unique]
    scopeUniques CmmTickScope
    scope')
        -- This is still deterministic because
        -- the order is the same for equal lists

    -- This is non-deterministic but we do not currently support deterministic
    -- code-generation. See Note [Unique Determinism and code generation]
    -- See Note [No Ord for Unique]
    instance Ord CmmTickScope where
      compare :: CmmTickScope -> CmmTickScope -> Ordering
    compare CmmTickScope
    GlobalScope    CmmTickScope
    GlobalScope     = Ordering
    EQ
      compare CmmTickScope
    GlobalScope    CmmTickScope
    _               = Ordering
    LT
      compare CmmTickScope
    _              CmmTickScope
    GlobalScope     = Ordering
    GT
      compare (SubScope Unique
    u CmmTickScope
    _) (SubScope Unique
    u' CmmTickScope
    _) = Unique -> Unique -> Ordering
    nonDetCmpUnique Unique
    u Unique
    u'
      compare CmmTickScope
    scope CmmTickScope
    scope'                   = (Unique -> Unique -> Ordering) -> [Unique] -> [Unique] -> Ordering
    forall a b. (a -> b -> Ordering) -> [a] -> [b] -> Ordering
    forall (f :: * -> *) a b.
    Ord1 f =>
    (a -> b -> Ordering) -> f a -> f b -> Ordering
    liftCompare Unique -> Unique -> Ordering
    nonDetCmpUnique
         ((Unique -> Unique -> Ordering) -> [Unique] -> [Unique]
    forall a. (a -> a -> Ordering) -> [a] -> [a]
    sortBy Unique -> Unique -> Ordering
    nonDetCmpUnique ([Unique] -> [Unique]) -> [Unique] -> [Unique]
    forall a b. (a -> b) -> a -> b
    $ CmmTickScope -> [Unique]
    scopeUniques CmmTickScope
    scope)
         ((Unique -> Unique -> Ordering) -> [Unique] -> [Unique]
    forall a. (a -> a -> Ordering) -> [a] -> [a]
    sortBy Unique -> Unique -> Ordering
    nonDetCmpUnique ([Unique] -> [Unique]) -> [Unique] -> [Unique]
    forall a b. (a -> b) -> a -> b
    $ CmmTickScope -> [Unique]
    scopeUniques CmmTickScope
    scope')

    instance Outputable CmmTickScope where
      ppr :: CmmTickScope -> SDoc
    ppr CmmTickScope
    GlobalScope     = String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "global"
      ppr (SubScope Unique
    us CmmTickScope
    GlobalScope)
                          = Unique -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Unique
    us
      ppr (SubScope Unique
    us CmmTickScope
    s) = CmmTickScope -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr CmmTickScope
    s SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <> Char -> SDoc
    forall doc. IsLine doc => Char -> doc
    char Char
    '/' SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <> Unique -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Unique
    us
      ppr CmmTickScope
    combined        = 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 (Char -> SDoc
    forall doc. IsLine doc => Char -> doc
    char Char
    '+') ([SDoc] -> [SDoc]) -> [SDoc] -> [SDoc]
    forall a b. (a -> b) -> a -> b
    $
                            ([Unique] -> SDoc) -> [[Unique]] -> [SDoc]
    forall a b. (a -> b) -> [a] -> [b]
    map ([SDoc] -> SDoc
    forall doc. IsLine doc => [doc] -> doc
    hcat ([SDoc] -> SDoc) -> ([Unique] -> [SDoc]) -> [Unique] -> SDoc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . SDoc -> [SDoc] -> [SDoc]
    forall doc. IsLine doc => doc -> [doc] -> [doc]
    punctuate (Char -> SDoc
    forall doc. IsLine doc => Char -> doc
    char Char
    '/') ([SDoc] -> [SDoc]) -> ([Unique] -> [SDoc]) -> [Unique] -> [SDoc]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Unique -> SDoc) -> [Unique] -> [SDoc]
    forall a b. (a -> b) -> [a] -> [b]
    map Unique -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr ([Unique] -> [SDoc])
    -> ([Unique] -> [Unique]) -> [Unique] -> [SDoc]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Unique] -> [Unique]
    forall a. [a] -> [a]
    reverse) ([[Unique]] -> [SDoc]) -> [[Unique]] -> [SDoc]
    forall a b. (a -> b) -> a -> b
    $
                            CmmTickScope -> [[Unique]]
    scopeToPaths CmmTickScope
    combined

    -- | Checks whether two tick scopes are sub-scopes of each other. True
    -- if the two scopes are equal.
    isTickSubScope :: CmmTickScope -> CmmTickScope -> Bool
    isTickSubScope :: CmmTickScope -> CmmTickScope -> Bool
    isTickSubScope = CmmTickScope -> CmmTickScope -> Bool
    cmp
      where cmp :: CmmTickScope -> CmmTickScope -> Bool
    cmp CmmTickScope
    _              CmmTickScope
    GlobalScope             = Bool
    True
            cmp CmmTickScope
    GlobalScope    CmmTickScope
    _                       = Bool
    False
            cmp (CombinedScope CmmTickScope
    s1 CmmTickScope
    s2) CmmTickScope
    s'               = CmmTickScope -> CmmTickScope -> Bool
    cmp CmmTickScope
    s1 CmmTickScope
    s' Bool -> Bool -> Bool
    && CmmTickScope -> CmmTickScope -> Bool
    cmp CmmTickScope
    s2 CmmTickScope
    s'
            cmp CmmTickScope
    s              (CombinedScope CmmTickScope
    s1' CmmTickScope
    s2') = CmmTickScope -> CmmTickScope -> Bool
    cmp CmmTickScope
    s CmmTickScope
    s1' Bool -> Bool -> Bool
    || CmmTickScope -> CmmTickScope -> Bool
    cmp CmmTickScope
    s CmmTickScope
    s2'
            cmp (SubScope Unique
    u CmmTickScope
    s) s' :: CmmTickScope
    s'@(SubScope Unique
    u' CmmTickScope
    _)      = Unique
    u Unique -> Unique -> Bool
    forall a. Eq a => a -> a -> Bool
    == Unique
    u' Bool -> Bool -> Bool
    || CmmTickScope -> CmmTickScope -> Bool
    cmp CmmTickScope
    s CmmTickScope
    s'

    -- | Combine two tick scopes. The new scope should be sub-scope of
    -- both parameters. We simplify automatically if one tick scope is a
    -- sub-scope of the other already.
    combineTickScopes :: CmmTickScope -> CmmTickScope -> CmmTickScope
    combineTickScopes :: CmmTickScope -> CmmTickScope -> CmmTickScope
    combineTickScopes CmmTickScope
    s1 CmmTickScope
    s2
      | CmmTickScope
    s1 CmmTickScope -> CmmTickScope -> Bool
    `isTickSubScope` CmmTickScope
    s2 = CmmTickScope
    s1
      | CmmTickScope
    s2 CmmTickScope -> CmmTickScope -> Bool
    `isTickSubScope` CmmTickScope
    s1 = CmmTickScope
    s2
      | Bool
    otherwise              = CmmTickScope -> CmmTickScope -> CmmTickScope
    CombinedScope CmmTickScope
    s1 CmmTickScope
    s2