    {-# LANGUAGE ScopedTypeVariables #-}
    {-# LANGUAGE TypeFamilies #-}
    {-# LANGUAGE DataKinds #-}

    module GHC.Wasm.ControlFlow.FromCmm
      ( structuredControl
      )
    where

    import GHC.Prelude hiding (succ)

    import Data.Function
    import Data.List (sortBy)
    import qualified Data.Tree as Tree

    import GHC.Cmm
    import GHC.Cmm.Dataflow.Block
    import GHC.Cmm.Dominators
    import GHC.Cmm.Dataflow.Graph
    import GHC.Cmm.Dataflow.Label
    import GHC.Cmm.Reducibility
    import GHC.Cmm.Switch

    import GHC.CmmToAsm.Wasm.Types

    import GHC.Platform
    import GHC.Types.Unique.Supply
    import GHC.Utils.Misc
    import GHC.Utils.Panic
    import GHC.Utils.Outputable ( Outputable, text, (<+>), ppr
                                , pprWithCommas
                                )

    import GHC.Wasm.ControlFlow

    {-|
    Module      : GHC.Wasm.ControlFlow.FromCmm
    Description : Translation of (reducible) Cmm control flow to WebAssembly

    Code in this module can translate any _reducible_ Cmm control-flow
    graph to the structured control flow that is required by WebAssembly.
    The algorithm is subtle and is described in detail in a draft paper
    to be found at https://www.cs.tufts.edu/~nr/pubs/relooper.pdf.
    -}

    --------------------- Abstraction of Cmm control flow -----------------------

    -- | Abstracts the kind of control flow we understand how to convert.
    -- A block can be left in one of four ways:
    --
    --   * Unconditionally
    --
    --   * Conditionally on a predicate of type `e`
    --
    --   * To a location determined by the value of a scrutinee of type `e`
    --
    --   * Not at all.

    data ControlFlow e = Unconditional Label
                       | Conditional e Label Label
                       | Switch { forall e. ControlFlow e -> e
    _scrutinee :: e
                                , forall e. ControlFlow e -> BrTableInterval
    _range :: BrTableInterval
                                , forall e. ControlFlow e -> [Maybe Label]
    _targets :: [Maybe Label] -- from 0
                                , forall e. ControlFlow e -> Maybe Label
    _defaultTarget :: Maybe Label
                                }
                       | TailCall e

    flowLeaving :: Platform -> CmmBlock -> ControlFlow CmmExpr
    flowLeaving :: Platform -> CmmBlock -> ControlFlow CmmExpr
    flowLeaving Platform
    platform CmmBlock
    b =
        case CmmBlock -> CmmNode O C
    forall (n :: Extensibility -> Extensibility -> *)
           (x :: Extensibility).
    Block n x C -> n O C
    lastNode CmmBlock
    b of
          CmmBranch Label
    l -> Label -> ControlFlow CmmExpr
    forall e. Label -> ControlFlow e
    Unconditional Label
    l
          CmmCondBranch CmmExpr
    c Label
    t Label
    f Maybe Bool
    _ -> CmmExpr -> Label -> Label -> ControlFlow CmmExpr
    forall e. e -> Label -> Label -> ControlFlow e
    Conditional CmmExpr
    c Label
    t Label
    f
          CmmSwitch CmmExpr
    e SwitchTargets
    targets ->
              let (Int
    offset, [Maybe Label]
    target_labels) = SwitchTargets -> (Int, [Maybe Label])
    switchTargetsToTable SwitchTargets
    targets
                  (Integer
    lo, Integer
    hi) = SwitchTargets -> (Integer, Integer)
    switchTargetsRange SwitchTargets
    targets
                  default_label :: Maybe Label
    default_label = SwitchTargets -> Maybe Label
    switchTargetsDefault SwitchTargets
    targets
                  scrutinee :: CmmExpr
    scrutinee = Platform -> CmmExpr -> CmmExpr
    smartExtend Platform
    platform (CmmExpr -> CmmExpr) -> CmmExpr -> CmmExpr
    forall a b. (a -> b) -> a -> b
    $ Platform -> CmmExpr -> Int -> CmmExpr
    smartPlus Platform
    platform CmmExpr
    e Int
    offset
                  range :: BrTableInterval
    range = Integer -> Integer -> BrTableInterval
    inclusiveInterval (Integer
    loInteger -> Integer -> Integer
    forall a. Num a => a -> a -> a
    +Int -> Integer
    forall a. Integral a => a -> Integer
    toInteger Int
    offset) (Integer
    hiInteger -> Integer -> Integer
    forall a. Num a => a -> a -> a
    +Int -> Integer
    forall a. Integral a => a -> Integer
    toInteger Int
    offset)
              in  CmmExpr
    -> BrTableInterval
    -> [Maybe Label]
    -> Maybe Label
    -> ControlFlow CmmExpr
    forall e.
    e
    -> BrTableInterval -> [Maybe Label] -> Maybe Label -> ControlFlow e
    Switch CmmExpr
    scrutinee BrTableInterval
    range [Maybe Label]
    target_labels Maybe Label
    default_label
          CmmCall { cml_target :: CmmNode O C -> CmmExpr
    cml_target = CmmExpr
    e } -> CmmExpr -> ControlFlow CmmExpr
    forall e. e -> ControlFlow e
    TailCall CmmExpr
    e
          CmmNode O C
    _ -> String -> ControlFlow CmmExpr
    forall a. HasCallStack => String -> a
    panic String
    "flowLeaving: unreachable"

    ----------------------- Evaluation contexts ------------------------------

    -- | The syntactic constructs in which Wasm code may be contained.
    -- A list of these constructs represents an evaluation context,
    -- which is used to determined what level of `br` instruction
    -- reaches a given label.

    data ContainingSyntax
        = BlockFollowedBy Label
        | LoopHeadedBy Label
        | IfThenElse (Maybe Label) -- ^ Carries the label that follows `if...end`, if any

    matchesFrame :: Label -> ContainingSyntax -> Bool
    matchesFrame :: Label -> ContainingSyntax -> Bool
    matchesFrame Label
    label (BlockFollowedBy Label
    l) = Label
    label Label -> Label -> Bool
    forall a. Eq a => a -> a -> Bool
    == Label
    l
    matchesFrame Label
    label (LoopHeadedBy Label
    l) = Label
    label Label -> Label -> Bool
    forall a. Eq a => a -> a -> Bool
    == Label
    l
    matchesFrame Label
    label (IfThenElse (Just Label
    l)) = Label
    label Label -> Label -> Bool
    forall a. Eq a => a -> a -> Bool
    == Label
    l
    matchesFrame Label
    _ ContainingSyntax
    _ = Bool
    False

    data Context = Context { Context -> [ContainingSyntax]
    enclosing :: [ContainingSyntax]
                           , Context -> Maybe Label
    fallthrough :: Maybe Label  -- the label can
                                                         -- be reached just by "falling through"
                                                         -- the hole
                           }

    instance Outputable Context where
      ppr :: Context -> SDoc
    ppr Context
    c | Just Label
    l <- Context -> Maybe Label
    fallthrough Context
    c =
                        (ContainingSyntax -> SDoc) -> [ContainingSyntax] -> SDoc
    forall a. (a -> SDoc) -> [a] -> SDoc
    pprWithCommas ContainingSyntax -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr (Context -> [ContainingSyntax]
    enclosing Context
    c) SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "fallthrough to" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> Label -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Label
    l
            | Bool
    otherwise = (ContainingSyntax -> SDoc) -> [ContainingSyntax] -> SDoc
    forall a. (a -> SDoc) -> [a] -> SDoc
    pprWithCommas ContainingSyntax -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr (Context -> [ContainingSyntax]
    enclosing Context
    c)

    emptyContext :: Context
    emptyContext :: Context
    emptyContext = [ContainingSyntax] -> Maybe Label -> Context
    Context [] Maybe Label
    forall a. Maybe a
    Nothing

    inside :: ContainingSyntax -> Context -> Context
    withFallthrough :: Context -> Label -> Context

    inside :: ContainingSyntax -> Context -> Context
    inside ContainingSyntax
    frame Context
    c = Context
    c { enclosing = frame : enclosing c }
    withFallthrough :: Context -> Label -> Context
    withFallthrough Context
    c Label
    l = Context
    c { fallthrough = Just l }

    type CmmActions = Block CmmNode O O

    type FT pre post = WasmFunctionType pre post

    returns :: FT '[] '[ 'I32]
    doesn'tReturn :: FT '[] '[]

    returns :: FT '[] '[ 'I32]
    returns = TypeList '[] -> TypeList '[ 'I32] -> FT '[] '[ 'I32]
    forall (pre :: [WasmType]) (post :: [WasmType]).
    TypeList pre -> TypeList post -> WasmFunctionType pre post
    WasmFunctionType TypeList '[]
    TypeListNil (WasmTypeTag 'I32 -> TypeList '[] -> TypeList '[ 'I32]
    forall (t :: WasmType) (ts :: [WasmType]).
    WasmTypeTag t -> TypeList ts -> TypeList (t : ts)
    TypeListCons WasmTypeTag 'I32
    TagI32 TypeList '[]
    TypeListNil)
    doesn'tReturn :: FT '[] '[]
    doesn'tReturn = TypeList '[] -> TypeList '[] -> FT '[] '[]
    forall (pre :: [WasmType]) (post :: [WasmType]).
    TypeList pre -> TypeList post -> WasmFunctionType pre post
    WasmFunctionType TypeList '[]
    TypeListNil TypeList '[]
    TypeListNil

    emptyPost :: FT pre post -> Bool
    emptyPost :: forall (pre :: [WasmType]) (post :: [WasmType]).
    FT pre post -> Bool
    emptyPost (WasmFunctionType TypeList pre
    _ TypeList post
    TypeListNil) = Bool
    True
    emptyPost WasmFunctionType pre post
    _ = Bool
    False

    ----------------------- Translation ------------------------------

    -- | Convert a Cmm CFG to WebAssembly's structured control flow.

    structuredControl :: forall expr stmt m .
                         Applicative m
                      => Platform  -- ^ needed for offset calculation
                      -> UniqSupply
                      -> (Label -> CmmExpr -> m expr) -- ^ translator for expressions
                      -> (Label -> CmmActions -> m stmt) -- ^ translator for straight-line code
                      -> CmmGraph -- ^ CFG to be translated
                      -> m (WasmControl stmt expr '[] '[ 'I32])
    structuredControl :: forall expr stmt (m :: * -> *).
    Applicative m =>
    Platform
    -> UniqSupply
    -> (Label -> CmmExpr -> m expr)
    -> (Label -> CmmActions -> m stmt)
    -> CmmGraph
    -> m (WasmControl stmt expr '[] '[ 'I32])
    structuredControl Platform
    platform UniqSupply
    us Label -> CmmExpr -> m expr
    txExpr Label -> CmmActions -> m stmt
    txBlock CmmGraph
    g' =
       FT '[] '[ 'I32]
    -> Tree CmmBlock
    -> Context
    -> m (WasmControl stmt expr '[] '[ 'I32])
    forall (post :: [WasmType]).
    FT '[] post
    -> Tree CmmBlock -> Context -> m (WasmControl stmt expr '[] post)
    doTree FT '[] '[ 'I32]
    returns Tree CmmBlock
    dominatorTree Context
    emptyContext
     where
       g :: CmmGraph
       g :: CmmGraph
    g = GraphWithDominators CmmNode -> CmmGraph
    forall (node :: Extensibility -> Extensibility -> *).
    GraphWithDominators node -> GenCmmGraph node
    gwd_graph GraphWithDominators CmmNode
    gwd

       gwd :: GraphWithDominators CmmNode
       gwd :: GraphWithDominators CmmNode
    gwd = UniqSupply
    -> UniqSM (GraphWithDominators CmmNode)
    -> GraphWithDominators CmmNode
    forall a. UniqSupply -> UniqSM a -> a
    initUs_ UniqSupply
    us (UniqSM (GraphWithDominators CmmNode)
     -> GraphWithDominators CmmNode)
    -> UniqSM (GraphWithDominators CmmNode)
    -> GraphWithDominators CmmNode
    forall a b. (a -> b) -> a -> b
    $ GraphWithDominators CmmNode -> UniqSM (GraphWithDominators CmmNode)
    asReducible (GraphWithDominators CmmNode
     -> UniqSM (GraphWithDominators CmmNode))
    -> GraphWithDominators CmmNode
    -> UniqSM (GraphWithDominators CmmNode)
    forall a b. (a -> b) -> a -> b
    $ CmmGraph -> GraphWithDominators CmmNode
    forall (node :: Extensibility -> Extensibility -> *).
    (NonLocal node, HasDebugCallStack) =>
    GenCmmGraph node -> GraphWithDominators node
    graphWithDominators CmmGraph
    g'

       dominatorTree :: Tree.Tree CmmBlock-- Dominator tree in which children are sorted
                                           -- with highest reverse-postorder number first
       dominatorTree :: Tree CmmBlock
    dominatorTree = (Label -> CmmBlock) -> Tree Label -> Tree CmmBlock
    forall a b. (a -> b) -> Tree a -> Tree b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap Label -> CmmBlock
    blockLabeled (Tree Label -> Tree CmmBlock) -> Tree Label -> Tree CmmBlock
    forall a b. (a -> b) -> a -> b
    $ Tree Label -> Tree Label
    sortTree (Tree Label -> Tree Label) -> Tree Label -> Tree Label
    forall a b. (a -> b) -> a -> b
    $ GraphWithDominators CmmNode -> Tree Label
    forall (node :: Extensibility -> Extensibility -> *).
    GraphWithDominators node -> Tree Label
    gwdDominatorTree GraphWithDominators CmmNode
    gwd

       doTree     :: FT '[] post -> Tree.Tree CmmBlock -> Context -> m (WasmControl stmt expr '[] post)
       nodeWithin :: forall post .
                     FT '[] post -> CmmBlock -> [Tree.Tree CmmBlock] -> Maybe Label
                                                       -> Context -> m (WasmControl stmt expr '[] post)
       doBranch   :: FT '[] post -> Label -> Label     -> Context -> m (WasmControl stmt expr '[] post)

       doTree :: forall (post :: [WasmType]).
    FT '[] post
    -> Tree CmmBlock -> Context -> m (WasmControl stmt expr '[] post)
    doTree FT '[] post
    fty (Tree.Node CmmBlock
    x [Tree CmmBlock]
    children) Context
    context =
           let codeForX :: Context -> m (WasmControl stmt expr '[] post)
    codeForX = FT '[] post
    -> CmmBlock
    -> [Tree CmmBlock]
    -> Maybe Label
    -> Context
    -> m (WasmControl stmt expr '[] post)
    forall (post :: [WasmType]).
    FT '[] post
    -> CmmBlock
    -> [Tree CmmBlock]
    -> Maybe Label
    -> Context
    -> m (WasmControl stmt expr '[] post)
    nodeWithin FT '[] post
    fty CmmBlock
    x [Tree CmmBlock]
    selectedChildren Maybe Label
    forall a. Maybe a
    Nothing
           in  if CmmBlock -> Bool
    isLoopHeader CmmBlock
    x then
                 FT '[] post
    -> WasmControl stmt expr '[] post -> WasmControl stmt expr '[] post
    forall (c :: [WasmType]) (d :: [WasmType]) a b.
    WasmFunctionType c d -> WasmControl a b c d -> WasmControl a b c d
    WasmLoop FT '[] post
    fty (WasmControl stmt expr '[] post -> WasmControl stmt expr '[] post)
    -> m (WasmControl stmt expr '[] post)
    -> m (WasmControl stmt expr '[] post)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Context -> m (WasmControl stmt expr '[] post)
    codeForX Context
    loopContext
               else
                 Context -> m (WasmControl stmt expr '[] post)
    codeForX Context
    context
         where selectedChildren :: [Tree CmmBlock]
    selectedChildren = case CmmBlock -> CmmNode O C
    forall (n :: Extensibility -> Extensibility -> *)
           (x :: Extensibility).
    Block n x C -> n O C
    lastNode CmmBlock
    x of
                                    CmmSwitch {} -> [Tree CmmBlock]
    children
                                       -- N.B. Unlike `if`, translation of Switch uses only labels.
                                    CmmNode O C
    _ -> (Tree CmmBlock -> Bool) -> [Tree CmmBlock] -> [Tree CmmBlock]
    forall a. (a -> Bool) -> [a] -> [a]
    filter Tree CmmBlock -> Bool
    hasMergeRoot [Tree CmmBlock]
    children
               loopContext :: Context
    loopContext = Label -> ContainingSyntax
    LoopHeadedBy (CmmBlock -> Label
    forall (x :: Extensibility). Block CmmNode C x -> Label
    forall (thing :: Extensibility -> Extensibility -> *)
           (x :: Extensibility).
    NonLocal thing =>
    thing C x -> Label
    entryLabel CmmBlock
    x) ContainingSyntax -> Context -> Context
    `inside` Context
    context
               hasMergeRoot :: Tree CmmBlock -> Bool
    hasMergeRoot = CmmBlock -> Bool
    isMergeNode (CmmBlock -> Bool)
    -> (Tree CmmBlock -> CmmBlock) -> Tree CmmBlock -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Tree CmmBlock -> CmmBlock
    forall a. Tree a -> a
    Tree.rootLabel

       nodeWithin :: forall (post :: [WasmType]).
    FT '[] post
    -> CmmBlock
    -> [Tree CmmBlock]
    -> Maybe Label
    -> Context
    -> m (WasmControl stmt expr '[] post)
    nodeWithin FT '[] post
    fty CmmBlock
    x (Tree CmmBlock
    y_n:[Tree CmmBlock]
    ys) (Just Label
    zlabel) Context
    context =
           FT '[] post
    -> WasmControl stmt expr '[] post -> WasmControl stmt expr '[] post
    forall (c :: [WasmType]) (d :: [WasmType]) a b.
    WasmFunctionType c d -> WasmControl a b c d -> WasmControl a b c d
    WasmBlock FT '[] post
    fty (WasmControl stmt expr '[] post -> WasmControl stmt expr '[] post)
    -> m (WasmControl stmt expr '[] post)
    -> m (WasmControl stmt expr '[] post)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> FT '[] post
    -> CmmBlock
    -> [Tree CmmBlock]
    -> Maybe Label
    -> Context
    -> m (WasmControl stmt expr '[] post)
    forall (post :: [WasmType]).
    FT '[] post
    -> CmmBlock
    -> [Tree CmmBlock]
    -> Maybe Label
    -> Context
    -> m (WasmControl stmt expr '[] post)
    nodeWithin FT '[] post
    fty CmmBlock
    x (Tree CmmBlock
    y_nTree CmmBlock -> [Tree CmmBlock] -> [Tree CmmBlock]
    forall a. a -> [a] -> [a]
    :[Tree CmmBlock]
    ys) Maybe Label
    forall a. Maybe a
    Nothing Context
    context'
         where context' :: Context
    context' = Label -> ContainingSyntax
    BlockFollowedBy Label
    zlabel ContainingSyntax -> Context -> Context
    `inside` Context
    context
       nodeWithin FT '[] post
    fty CmmBlock
    x (Tree CmmBlock
    y_n:[Tree CmmBlock]
    ys) Maybe Label
    Nothing Context
    context =
           FT '[] '[]
    -> CmmBlock
    -> [Tree CmmBlock]
    -> Maybe Label
    -> Context
    -> m (WasmControl stmt expr '[] '[])
    forall (post :: [WasmType]).
    FT '[] post
    -> CmmBlock
    -> [Tree CmmBlock]
    -> Maybe Label
    -> Context
    -> m (WasmControl stmt expr '[] post)
    nodeWithin FT '[] '[]
    doesn'tReturn CmmBlock
    x [Tree CmmBlock]
    ys (Label -> Maybe Label
    forall a. a -> Maybe a
    Just Label
    ylabel) (Context
    context Context -> Label -> Context
    `withFallthrough` Label
    ylabel) m (WasmControl stmt expr '[] '[])
    -> m (WasmControl stmt expr '[] post)
    -> m (WasmControl stmt expr '[] post)
    forall (m :: * -> *) s e (pre :: [WasmType]) (mid :: [WasmType])
           (post :: [WasmType]).
    Applicative m =>
    m (WasmControl s e pre mid)
    -> m (WasmControl s e mid post) -> m (WasmControl s e pre post)
    <<>>
           FT '[] post
    -> Tree CmmBlock -> Context -> m (WasmControl stmt expr '[] post)
    forall (post :: [WasmType]).
    FT '[] post
    -> Tree CmmBlock -> Context -> m (WasmControl stmt expr '[] post)
    doTree FT '[] post
    fty Tree CmmBlock
    y_n Context
    context
         where ylabel :: Label
    ylabel = Tree CmmBlock -> Label
    treeEntryLabel Tree CmmBlock
    y_n
       nodeWithin FT '[] post
    fty CmmBlock
    x [] (Just Label
    zlabel) Context
    context
         | Bool -> Bool
    not (CmmBlock -> Bool
    generatesIf CmmBlock
    x) =
             FT '[] post
    -> WasmControl stmt expr '[] post -> WasmControl stmt expr '[] post
    forall (c :: [WasmType]) (d :: [WasmType]) a b.
    WasmFunctionType c d -> WasmControl a b c d -> WasmControl a b c d
    WasmBlock FT '[] post
    fty (WasmControl stmt expr '[] post -> WasmControl stmt expr '[] post)
    -> m (WasmControl stmt expr '[] post)
    -> m (WasmControl stmt expr '[] post)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> FT '[] post
    -> CmmBlock
    -> [Tree CmmBlock]
    -> Maybe Label
    -> Context
    -> m (WasmControl stmt expr '[] post)
    forall (post :: [WasmType]).
    FT '[] post
    -> CmmBlock
    -> [Tree CmmBlock]
    -> Maybe Label
    -> Context
    -> m (WasmControl stmt expr '[] post)
    nodeWithin FT '[] post
    fty CmmBlock
    x [] Maybe Label
    forall a. Maybe a
    Nothing Context
    context'
         where context' :: Context
    context' = Label -> ContainingSyntax
    BlockFollowedBy Label
    zlabel ContainingSyntax -> Context -> Context
    `inside` Context
    context
       nodeWithin FT '[] post
    fty CmmBlock
    x [] Maybe Label
    maybeMarks Context
    context =
           Context -> m (WasmControl stmt expr '[] post)
    translationOfX Context
    context
         where xlabel :: Label
    xlabel = CmmBlock -> Label
    forall (x :: Extensibility). Block CmmNode C x -> Label
    forall (thing :: Extensibility -> Extensibility -> *)
           (x :: Extensibility).
    NonLocal thing =>
    thing C x -> Label
    entryLabel CmmBlock
    x

               translationOfX :: Context -> m (WasmControl stmt expr '[] post)
               translationOfX :: Context -> m (WasmControl stmt expr '[] post)
    translationOfX Context
    context =
                 (stmt -> WasmControl stmt expr '[] '[]
    forall a b (c :: [WasmType]). a -> WasmControl a b c c
    WasmActions (stmt -> WasmControl stmt expr '[] '[])
    -> m stmt -> m (WasmControl stmt expr '[] '[])
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Label -> CmmActions -> m stmt
    txBlock Label
    xlabel (CmmBlock -> CmmActions
    nodeBody CmmBlock
    x)) m (WasmControl stmt expr '[] '[])
    -> m (WasmControl stmt expr '[] post)
    -> m (WasmControl stmt expr '[] post)
    forall (m :: * -> *) s e (pre :: [WasmType]) (mid :: [WasmType])
           (post :: [WasmType]).
    Applicative m =>
    m (WasmControl s e pre mid)
    -> m (WasmControl s e mid post) -> m (WasmControl s e pre post)
    <<>>
                 case Platform -> CmmBlock -> ControlFlow CmmExpr
    flowLeaving Platform
    platform CmmBlock
    x of
                   Unconditional Label
    l -> FT '[] post
    -> Label -> Label -> Context -> m (WasmControl stmt expr '[] post)
    forall (post :: [WasmType]).
    FT '[] post
    -> Label -> Label -> Context -> m (WasmControl stmt expr '[] post)
    doBranch FT '[] post
    fty Label
    xlabel Label
    l Context
    context
                   Conditional CmmExpr
    e Label
    t Label
    f ->
                     FT '[] post
    -> expr
    -> WasmControl stmt expr '[] post
    -> WasmControl stmt expr '[] post
    -> WasmControl stmt expr '[] post
    forall (pre :: [WasmType]) (post :: [WasmType]) e s.
    WasmFunctionType pre post
    -> e
    -> WasmControl s e pre post
    -> WasmControl s e pre post
    -> WasmControl s e pre post
    WasmIf FT '[] post
    fty
                            (expr
     -> WasmControl stmt expr '[] post
     -> WasmControl stmt expr '[] post
     -> WasmControl stmt expr '[] post)
    -> m expr
    -> m (WasmControl stmt expr '[] post
          -> WasmControl stmt expr '[] post
          -> WasmControl stmt expr '[] post)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Label -> CmmExpr -> m expr
    txExpr Label
    xlabel CmmExpr
    e
                            m (WasmControl stmt expr '[] post
       -> WasmControl stmt expr '[] post
       -> WasmControl stmt expr '[] post)
    -> m (WasmControl stmt expr '[] post)
    -> m (WasmControl stmt expr '[] post
          -> WasmControl stmt expr '[] post)
    forall a b. m (a -> b) -> m a -> m b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> FT '[] post
    -> Label -> Label -> Context -> m (WasmControl stmt expr '[] post)
    forall (post :: [WasmType]).
    FT '[] post
    -> Label -> Label -> Context -> m (WasmControl stmt expr '[] post)
    doBranch FT '[] post
    fty Label
    xlabel Label
    t (Maybe Label -> ContainingSyntax
    IfThenElse Maybe Label
    maybeMarks ContainingSyntax -> Context -> Context
    `inside` Context
    context)
                            m (WasmControl stmt expr '[] post
       -> WasmControl stmt expr '[] post)
    -> m (WasmControl stmt expr '[] post)
    -> m (WasmControl stmt expr '[] post)
    forall a b. m (a -> b) -> m a -> m b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> FT '[] post
    -> Label -> Label -> Context -> m (WasmControl stmt expr '[] post)
    forall (post :: [WasmType]).
    FT '[] post
    -> Label -> Label -> Context -> m (WasmControl stmt expr '[] post)
    doBranch FT '[] post
    fty Label
    xlabel Label
    f (Maybe Label -> ContainingSyntax
    IfThenElse Maybe Label
    maybeMarks ContainingSyntax -> Context -> Context
    `inside` Context
    context)
                   TailCall CmmExpr
    e -> expr -> WasmControl stmt expr '[] post
    forall b a (c :: [WasmType]) (d :: [WasmType]).
    b -> WasmControl a b c d
    WasmTailCall (expr -> WasmControl stmt expr '[] post)
    -> m expr -> m (WasmControl stmt expr '[] post)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Label -> CmmExpr -> m expr
    txExpr Label
    xlabel CmmExpr
    e
                   Switch CmmExpr
    e BrTableInterval
    range [Maybe Label]
    targets Maybe Label
    default' ->
                       expr
    -> BrTableInterval
    -> [Int]
    -> Int
    -> WasmControl stmt expr '[] post
    forall b a (c :: [WasmType]) (d :: [WasmType]).
    b -> BrTableInterval -> [Int] -> Int -> WasmControl a b c d
    WasmBrTable (expr
     -> BrTableInterval
     -> [Int]
     -> Int
     -> WasmControl stmt expr '[] post)
    -> m expr
    -> m (BrTableInterval
          -> [Int] -> Int -> WasmControl stmt expr '[] post)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$>  Label -> CmmExpr -> m expr
    txExpr Label
    xlabel CmmExpr
    e
                                   m (BrTableInterval
       -> [Int] -> Int -> WasmControl stmt expr '[] post)
    -> BrTableInterval
    -> m ([Int] -> Int -> WasmControl stmt expr '[] post)
    forall (m :: * -> *) a b. Functor m => m (a -> b) -> a -> m b
    <$~> BrTableInterval
    range
                                   m ([Int] -> Int -> WasmControl stmt expr '[] post)
    -> [Int] -> m (Int -> WasmControl stmt expr '[] post)
    forall (m :: * -> *) a b. Functor m => m (a -> b) -> a -> m b
    <$~> (Maybe Label -> Int) -> [Maybe Label] -> [Int]
    forall a b. (a -> b) -> [a] -> [b]
    map Maybe Label -> Int
    switchIndex [Maybe Label]
    targets
                                   m (Int -> WasmControl stmt expr '[] post)
    -> Int -> m (WasmControl stmt expr '[] post)
    forall (m :: * -> *) a b. Functor m => m (a -> b) -> a -> m b
    <$~> Maybe Label -> Int
    switchIndex Maybe Label
    default'
                where switchIndex :: Maybe Label -> Int
                      switchIndex :: Maybe Label -> Int
    switchIndex Maybe Label
    Nothing = Int
    0 -- arbitrary; GHC won't go here
                      switchIndex (Just Label
    lbl) = Label -> [ContainingSyntax] -> Int
    index Label
    lbl (Context -> [ContainingSyntax]
    enclosing Context
    context)

       doBranch :: forall (post :: [WasmType]).
    FT '[] post
    -> Label -> Label -> Context -> m (WasmControl stmt expr '[] post)
    doBranch FT '[] post
    fty Label
    from Label
    to Context
    context
          | Label
    to Label -> Maybe Label -> Bool
    forall a. Eq a => a -> Maybe a -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` Context -> Maybe Label
    fallthrough Context
    context Bool -> Bool -> Bool
    && FT '[] post -> Bool
    forall (pre :: [WasmType]) (post :: [WasmType]).
    FT pre post -> Bool
    emptyPost FT '[] post
    fty = WasmControl stmt expr '[] post
    -> m (WasmControl stmt expr '[] post)
    forall a. a -> m a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure WasmControl stmt expr '[] post
    forall a b (c :: [WasmType]) (d :: [WasmType]). WasmControl a b c d
    WasmFallthrough
                    -- optimization: `br` is not needed, but it typechecks
                    -- only if nothing is expected to be left on the stack

          | Label -> Label -> Bool
    isBackward Label
    from Label
    to = WasmControl stmt expr '[] post
    -> m (WasmControl stmt expr '[] post)
    forall a. a -> m a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (WasmControl stmt expr '[] post
     -> m (WasmControl stmt expr '[] post))
    -> WasmControl stmt expr '[] post
    -> m (WasmControl stmt expr '[] post)
    forall a b. (a -> b) -> a -> b
    $ Int -> WasmControl stmt expr '[] post
    forall a b (c :: [WasmType]) (d :: [WasmType]).
    Int -> WasmControl a b c d
    WasmBr Int
    i -- continue
          | Label -> Bool
    isMergeLabel Label
    to = WasmControl stmt expr '[] post
    -> m (WasmControl stmt expr '[] post)
    forall a. a -> m a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (WasmControl stmt expr '[] post
     -> m (WasmControl stmt expr '[] post))
    -> WasmControl stmt expr '[] post
    -> m (WasmControl stmt expr '[] post)
    forall a b. (a -> b) -> a -> b
    $ Int -> WasmControl stmt expr '[] post
    forall a b (c :: [WasmType]) (d :: [WasmType]).
    Int -> WasmControl a b c d
    WasmBr Int
    i -- exit
          | Bool
    otherwise = FT '[] post
    -> Tree CmmBlock -> Context -> m (WasmControl stmt expr '[] post)
    forall (post :: [WasmType]).
    FT '[] post
    -> Tree CmmBlock -> Context -> m (WasmControl stmt expr '[] post)
    doTree FT '[] post
    fty (Label -> Tree CmmBlock
    subtreeAt Label
    to) Context
    context -- inline the code here
         where i :: Int
    i = Label -> [ContainingSyntax] -> Int
    index Label
    to (Context -> [ContainingSyntax]
    enclosing Context
    context)

       generatesIf :: CmmBlock -> Bool
       generatesIf :: CmmBlock -> Bool
    generatesIf CmmBlock
    x = case Platform -> CmmBlock -> ControlFlow CmmExpr
    flowLeaving Platform
    platform CmmBlock
    x of Conditional {} -> Bool
    True
                                                      ControlFlow CmmExpr
    _ -> Bool
    False

       ---- everything else is utility functions

       treeEntryLabel :: Tree.Tree CmmBlock -> Label
       treeEntryLabel :: Tree CmmBlock -> Label
    treeEntryLabel = CmmBlock -> Label
    forall (x :: Extensibility). Block CmmNode C x -> Label
    forall (thing :: Extensibility -> Extensibility -> *)
           (x :: Extensibility).
    NonLocal thing =>
    thing C x -> Label
    entryLabel (CmmBlock -> Label)
    -> (Tree CmmBlock -> CmmBlock) -> Tree CmmBlock -> Label
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Tree CmmBlock -> CmmBlock
    forall a. Tree a -> a
    Tree.rootLabel

       sortTree :: Tree.Tree Label -> Tree.Tree Label
        -- Sort highest rpnum first
       sortTree :: Tree Label -> Tree Label
    sortTree (Tree.Node Label
    label [Tree Label]
    children) =
          Label -> [Tree Label] -> Tree Label
    forall a. a -> [Tree a] -> Tree a
    Tree.Node Label
    label ([Tree Label] -> Tree Label) -> [Tree Label] -> Tree Label
    forall a b. (a -> b) -> a -> b
    $ (Tree Label -> Tree Label -> Ordering)
    -> [Tree Label] -> [Tree Label]
    forall a. (a -> a -> Ordering) -> [a] -> [a]
    sortBy ((RPNum -> RPNum -> Ordering) -> RPNum -> RPNum -> Ordering
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip RPNum -> RPNum -> Ordering
    forall a. Ord a => a -> a -> Ordering
    compare (RPNum -> RPNum -> Ordering)
    -> (Tree Label -> RPNum) -> Tree Label -> Tree Label -> Ordering
    forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
    `on` (Label -> RPNum
    rpnum (Label -> RPNum) -> (Tree Label -> Label) -> Tree Label -> RPNum
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Tree Label -> Label
    forall a. Tree a -> a
    Tree.rootLabel)) ([Tree Label] -> [Tree Label]) -> [Tree Label] -> [Tree Label]
    forall a b. (a -> b) -> a -> b
    $
                            (Tree Label -> Tree Label) -> [Tree Label] -> [Tree Label]
    forall a b. (a -> b) -> [a] -> [b]
    map Tree Label -> Tree Label
    sortTree [Tree Label]
    children

       subtreeAt :: Label -> Tree.Tree CmmBlock
       blockLabeled :: Label -> CmmBlock
       rpnum :: Label -> RPNum-- reverse postorder number of the labeled block
       isMergeLabel :: Label -> Bool
       isMergeNode :: CmmBlock -> Bool
       isLoopHeader :: CmmBlock -> Bool-- identify loop headers
        -- all nodes whose immediate dominator is the given block.
         -- They are produced with the largest RP number first,
         -- so the largest RP number is pushed on the context first.
       dominates :: Label -> Label -> Bool
        -- Domination relation (not just immediate domination)

       blockmap :: LabelMap CmmBlock
       GMany MaybeO C (Block CmmNode O C)
    NothingO LabelMap CmmBlock
    blockmap MaybeO C (Block CmmNode C O)
    NothingO = CmmGraph -> Graph' Block CmmNode C C
    forall (n :: Extensibility -> Extensibility -> *).
    GenCmmGraph n -> Graph n C C
    g_graph CmmGraph
    g

       blockLabeled :: Label -> CmmBlock
    blockLabeled Label
    l = Label -> LabelMap CmmBlock -> CmmBlock
    forall a. HasDebugCallStack => Label -> LabelMap a -> a
    findLabelIn Label
    l LabelMap CmmBlock
    blockmap

       rpblocks :: [CmmBlock]
       rpblocks :: [CmmBlock]
    rpblocks = LabelMap CmmBlock -> Label -> [CmmBlock]
    forall (block :: Extensibility -> Extensibility -> *).
    NonLocal block =>
    LabelMap (block C C) -> Label -> [block C C]
    revPostorderFrom LabelMap CmmBlock
    blockmap (CmmGraph -> Label
    forall (n :: Extensibility -> Extensibility -> *).
    GenCmmGraph n -> Label
    g_entry CmmGraph
    g)

       foldEdges :: forall a . (Label -> Label -> a -> a) -> a -> a
       foldEdges :: forall a. (Label -> Label -> a -> a) -> a -> a
    foldEdges Label -> Label -> a -> a
    f a
    a =
         (a -> (Label, Label) -> a) -> a -> [(Label, Label)] -> a
    forall b a. (b -> a -> b) -> b -> [a] -> b
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl (\a
    a (Label
    from, Label
    to) -> Label -> Label -> a -> a
    f Label
    from Label
    to a
    a)
               a
    a
               [(CmmBlock -> Label
    forall (x :: Extensibility). Block CmmNode C x -> Label
    forall (thing :: Extensibility -> Extensibility -> *)
           (x :: Extensibility).
    NonLocal thing =>
    thing C x -> Label
    entryLabel CmmBlock
    from, Label
    to) | CmmBlock
    from <- [CmmBlock]
    rpblocks, Label
    to <- CmmBlock -> [Label]
    forall (e :: Extensibility). Block CmmNode e C -> [Label]
    forall (thing :: Extensibility -> Extensibility -> *)
           (e :: Extensibility).
    NonLocal thing =>
    thing e C -> [Label]
    successors CmmBlock
    from]

       isMergeLabel :: Label -> Bool
    isMergeLabel Label
    l = Label -> LabelSet -> Bool
    setMember Label
    l LabelSet
    mergeBlockLabels
       isMergeNode :: CmmBlock -> Bool
    isMergeNode = Label -> Bool
    isMergeLabel (Label -> Bool) -> (CmmBlock -> Label) -> CmmBlock -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . CmmBlock -> Label
    forall (x :: Extensibility). Block CmmNode C x -> Label
    forall (thing :: Extensibility -> Extensibility -> *)
           (x :: Extensibility).
    NonLocal thing =>
    thing C x -> Label
    entryLabel

       isBackward :: Label -> Label -> Bool
       isBackward :: Label -> Label -> Bool
    isBackward Label
    from Label
    to = Label -> RPNum
    rpnum Label
    to RPNum -> RPNum -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Label -> RPNum
    rpnum Label
    from -- self-edge counts as a backward edge

       subtreeAt :: Label -> Tree CmmBlock
    subtreeAt Label
    label = Label -> LabelMap (Tree CmmBlock) -> Tree CmmBlock
    forall a. HasDebugCallStack => Label -> LabelMap a -> a
    findLabelIn Label
    label LabelMap (Tree CmmBlock)
    subtrees
       subtrees :: LabelMap (Tree.Tree CmmBlock)
       subtrees :: LabelMap (Tree CmmBlock)
    subtrees = LabelMap (Tree CmmBlock)
    -> Tree CmmBlock -> LabelMap (Tree CmmBlock)
    forall {thing :: Extensibility -> Extensibility -> *}
           {x :: Extensibility}.
    NonLocal thing =>
    LabelMap (Tree (thing C x))
    -> Tree (thing C x) -> LabelMap (Tree (thing C x))
    addSubtree LabelMap (Tree CmmBlock)
    forall v. LabelMap v
    mapEmpty Tree CmmBlock
    dominatorTree
         where addSubtree :: LabelMap (Tree (thing C x))
    -> Tree (thing C x) -> LabelMap (Tree (thing C x))
    addSubtree LabelMap (Tree (thing C x))
    map t :: Tree (thing C x)
    t@(Tree.Node thing C x
    root [Tree (thing C x)]
    children) =
                   (LabelMap (Tree (thing C x))
     -> Tree (thing C x) -> LabelMap (Tree (thing C x)))
    -> LabelMap (Tree (thing C x))
    -> [Tree (thing C x)]
    -> LabelMap (Tree (thing C x))
    forall b a. (b -> a -> b) -> b -> [a] -> b
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl LabelMap (Tree (thing C x))
    -> Tree (thing C x) -> LabelMap (Tree (thing C x))
    addSubtree (Label
    -> Tree (thing C x)
    -> LabelMap (Tree (thing C x))
    -> LabelMap (Tree (thing C x))
    forall v. Label -> v -> LabelMap v -> LabelMap v
    mapInsert (thing C x -> Label
    forall (x :: Extensibility). thing C x -> Label
    forall (thing :: Extensibility -> Extensibility -> *)
           (x :: Extensibility).
    NonLocal thing =>
    thing C x -> Label
    entryLabel thing C x
    root) Tree (thing C x)
    t LabelMap (Tree (thing C x))
    map) [Tree (thing C x)]
    children

       mergeBlockLabels :: LabelSet
       -- N.B. A block is a merge node if it is where control flow merges.
       -- That means it is entered by multiple control-flow edges, _except_
       -- back edges don't count.  There must be multiple paths that enter the
       -- block _without_ passing through the block itself.
       mergeBlockLabels :: LabelSet
    mergeBlockLabels =
           [Label] -> LabelSet
    setFromList [CmmBlock -> Label
    forall (x :: Extensibility). Block CmmNode C x -> Label
    forall (thing :: Extensibility -> Extensibility -> *)
           (x :: Extensibility).
    NonLocal thing =>
    thing C x -> Label
    entryLabel CmmBlock
    n | CmmBlock
    n <- [CmmBlock]
    rpblocks, [Label] -> Bool
    forall {a}. [a] -> Bool
    big (Label -> [Label]
    forwardPreds (CmmBlock -> Label
    forall (x :: Extensibility). Block CmmNode C x -> Label
    forall (thing :: Extensibility -> Extensibility -> *)
           (x :: Extensibility).
    NonLocal thing =>
    thing C x -> Label
    entryLabel CmmBlock
    n))]
        where big :: [a] -> Bool
    big [] = Bool
    False
              big [a
    _] = Bool
    False
              big (a
    _ : a
    _ : [a]
    _) = Bool
    True

              forwardPreds :: Label -> [Label] -- reachable predecessors of reachable blocks,
                                               -- via forward edges only
              forwardPreds :: Label -> [Label]
    forwardPreds = \Label
    l -> [Label] -> Label -> LabelMap [Label] -> [Label]
    forall a. a -> Label -> LabelMap a -> a
    mapFindWithDefault [] Label
    l LabelMap [Label]
    predmap
                  where predmap :: LabelMap [Label]
                        predmap :: LabelMap [Label]
    predmap = (Label -> Label -> LabelMap [Label] -> LabelMap [Label])
    -> LabelMap [Label] -> LabelMap [Label]
    forall a. (Label -> Label -> a -> a) -> a -> a
    foldEdges Label -> Label -> LabelMap [Label] -> LabelMap [Label]
    addForwardEdge LabelMap [Label]
    forall v. LabelMap v
    mapEmpty
                        addForwardEdge :: Label -> Label -> LabelMap [Label] -> LabelMap [Label]
    addForwardEdge Label
    from Label
    to LabelMap [Label]
    pm
                            | Label -> Label -> Bool
    isBackward Label
    from Label
    to = LabelMap [Label]
    pm
                            | Bool
    otherwise = ([Label] -> [Label])
    -> Label -> LabelMap [Label] -> LabelMap [Label]
    forall a. ([a] -> [a]) -> Label -> LabelMap [a] -> LabelMap [a]
    addToList (Label
    from Label -> [Label] -> [Label]
    forall a. a -> [a] -> [a]
    :) Label
    to LabelMap [Label]
    pm

       isLoopHeader :: CmmBlock -> Bool
    isLoopHeader = Label -> Bool
    isHeaderLabel (Label -> Bool) -> (CmmBlock -> Label) -> CmmBlock -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . CmmBlock -> Label
    forall (x :: Extensibility). Block CmmNode C x -> Label
    forall (thing :: Extensibility -> Extensibility -> *)
           (x :: Extensibility).
    NonLocal thing =>
    thing C x -> Label
    entryLabel
       isHeaderLabel :: Label -> Bool
    isHeaderLabel = (Label -> LabelSet -> Bool
    `setMember` LabelSet
    headers)  -- loop headers
          where headers :: LabelSet
                headers :: LabelSet
    headers = (CmmBlock -> LabelSet) -> LabelMap CmmBlock -> LabelSet
    forall m a. Monoid m => (a -> m) -> LabelMap a -> m
    forall (t :: * -> *) m a.
    (Foldable t, Monoid m) =>
    (a -> m) -> t a -> m
    foldMap CmmBlock -> LabelSet
    forall {thing :: Extensibility -> Extensibility -> *}.
    NonLocal thing =>
    thing C C -> LabelSet
    headersPointedTo LabelMap CmmBlock
    blockmap
                headersPointedTo :: thing C C -> LabelSet
    headersPointedTo thing C C
    block =
                    [Label] -> LabelSet
    setFromList [Label
    label | Label
    label <- thing C C -> [Label]
    forall (e :: Extensibility). thing e C -> [Label]
    forall (thing :: Extensibility -> Extensibility -> *)
           (e :: Extensibility).
    NonLocal thing =>
    thing e C -> [Label]
    successors thing C C
    block,
                                                  Label -> Label -> Bool
    dominates Label
    label (thing C C -> Label
    forall (x :: Extensibility). thing C x -> Label
    forall (thing :: Extensibility -> Extensibility -> *)
           (x :: Extensibility).
    NonLocal thing =>
    thing C x -> Label
    entryLabel thing C C
    block)]

       index :: Label -> [ContainingSyntax] -> Int
       index :: Label -> [ContainingSyntax] -> Int
    index Label
    _ [] = String -> Int
    forall a. HasCallStack => String -> a
    panic String
    "destination label not in evaluation context"
       index Label
    label (ContainingSyntax
    frame : [ContainingSyntax]
    context)
           | Label
    label Label -> ContainingSyntax -> Bool
    `matchesFrame` ContainingSyntax
    frame = Int
    0
           | Bool
    otherwise = Int
    1 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Label -> [ContainingSyntax] -> Int
    index Label
    label [ContainingSyntax]
    context

       rpnum :: Label -> RPNum
    rpnum = GraphWithDominators CmmNode -> Label -> RPNum
    forall (node :: Extensibility -> Extensibility -> *).
    HasDebugCallStack =>
    GraphWithDominators node -> Label -> RPNum
    gwdRPNumber GraphWithDominators CmmNode
    gwd
       dominates :: Label -> Label -> Bool
    dominates Label
    lbl Label
    blockname =
           Label
    lbl Label -> Label -> Bool
    forall a. Eq a => a -> a -> Bool
    == Label
    blockname Bool -> Bool -> Bool
    || Label -> DominatorSet -> Bool
    dominatorsMember Label
    lbl (GraphWithDominators CmmNode -> Label -> DominatorSet
    forall (node :: Extensibility -> Extensibility -> *).
    HasDebugCallStack =>
    GraphWithDominators node -> Label -> DominatorSet
    gwdDominatorsOf GraphWithDominators CmmNode
    gwd Label
    blockname)

    nodeBody :: CmmBlock -> CmmActions
    nodeBody :: CmmBlock -> CmmActions
    nodeBody (BlockCC CmmNode C O
    _first CmmActions
    middle CmmNode O C
    _last) = CmmActions
    middle

    -- | A CmmSwitch scrutinee may have any width, but a br_table operand
    -- must be exactly word sized, hence the extension here. (#22871)
    smartExtend :: Platform -> CmmExpr -> CmmExpr
    smartExtend :: Platform -> CmmExpr -> CmmExpr
    smartExtend Platform
    p CmmExpr
    e | Width
    w0 Width -> Width -> Bool
    forall a. Eq a => a -> a -> Bool
    == Width
    w1 = CmmExpr
    e
                    | Bool
    otherwise = MachOp -> [CmmExpr] -> CmmExpr
    CmmMachOp (Width -> Width -> MachOp
    MO_UU_Conv Width
    w0 Width
    w1) [CmmExpr
    e]
      where
        w0 :: Width
    w0 = Platform -> CmmExpr -> Width
    cmmExprWidth Platform
    p CmmExpr
    e
        w1 :: Width
    w1 = Platform -> Width
    wordWidth Platform
    p

    smartPlus :: Platform -> CmmExpr -> Int -> CmmExpr
    smartPlus :: Platform -> CmmExpr -> Int -> CmmExpr
    smartPlus Platform
    _ CmmExpr
    e Int
    0 = CmmExpr
    e
    smartPlus Platform
    platform CmmExpr
    e Int
    k =
        MachOp -> [CmmExpr] -> CmmExpr
    CmmMachOp (Width -> MachOp
    MO_Add Width
    width) [CmmExpr
    e, CmmLit -> CmmExpr
    CmmLit (Integer -> Width -> CmmLit
    CmmInt (Int -> Integer
    forall a. Integral a => a -> Integer
    toInteger Int
    k) Width
    width)]
      where width :: Width
    width = Platform -> CmmExpr -> Width
    cmmExprWidth Platform
    platform CmmExpr
    e

    addToList :: ([a] -> [a]) -> Label -> LabelMap [a] -> LabelMap [a]
    addToList :: forall a. ([a] -> [a]) -> Label -> LabelMap [a] -> LabelMap [a]
    addToList [a] -> [a]
    consx = (Maybe [a] -> Maybe [a]) -> Label -> LabelMap [a] -> LabelMap [a]
    forall v. (Maybe v -> Maybe v) -> Label -> LabelMap v -> LabelMap v
    mapAlter Maybe [a] -> Maybe [a]
    add
        where add :: Maybe [a] -> Maybe [a]
    add Maybe [a]
    Nothing = [a] -> Maybe [a]
    forall a. a -> Maybe a
    Just ([a] -> [a]
    consx [])
              add (Just [a]
    xs) = [a] -> Maybe [a]
    forall a. a -> Maybe a
    Just ([a] -> [a]
    consx [a]
    xs)

    ------------------------------------------------------------------
    --- everything below here is for diagnostics in case of panic

    instance Outputable ContainingSyntax where
        ppr :: ContainingSyntax -> SDoc
    ppr (BlockFollowedBy Label
    l) = String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "node" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> Label -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Label
    l
        ppr (LoopHeadedBy Label
    l) = String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "loop" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> Label -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Label
    l
        ppr (IfThenElse Maybe Label
    l) = String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "if-then-else" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> Maybe Label -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Maybe Label
    l

    findLabelIn :: HasDebugCallStack => Label -> LabelMap a -> a
    findLabelIn :: forall a. HasDebugCallStack => Label -> LabelMap a -> a
    findLabelIn Label
    lbl = a -> Label -> LabelMap a -> a
    forall a. a -> Label -> LabelMap a -> a
    mapFindWithDefault a
    failed Label
    lbl
      where failed :: a
    failed =
                String -> SDoc -> a
    forall a. HasCallStack => String -> SDoc -> a
    pprPanic String
    "label not found in control-flow graph" (Label -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Label
    lbl)

    infixl 4 <$~>
    (<$~>) :: Functor m => m (a -> b) -> a -> m b
    <$~> :: forall (m :: * -> *) a b. Functor m => m (a -> b) -> a -> m b
    (<$~>) m (a -> b)
    f a
    x = ((a -> b) -> b) -> m (a -> b) -> m b
    forall a b. (a -> b) -> m a -> m b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ((a -> b) -> a -> b
    forall a b. (a -> b) -> a -> b
    $ a
    x) m (a -> b)
    f

    (<<>>) :: forall m s e pre mid post
           . Applicative m
           => m (WasmControl s e pre mid)
           -> m (WasmControl s e mid post)
           -> m (WasmControl s e pre post)
    <<>> :: forall (m :: * -> *) s e (pre :: [WasmType]) (mid :: [WasmType])
           (post :: [WasmType]).
    Applicative m =>
    m (WasmControl s e pre mid)
    -> m (WasmControl s e mid post) -> m (WasmControl s e pre post)
    (<<>>) = (WasmControl s e pre mid
     -> WasmControl s e mid post -> WasmControl s e pre post)
    -> m (WasmControl s e pre mid)
    -> m (WasmControl s e mid post)
    -> m (WasmControl s e pre post)
    forall a b c. (a -> b -> c) -> m a -> m b -> m c
    forall (f :: * -> *) a b c.
    Applicative f =>
    (a -> b -> c) -> f a -> f b -> f c
    liftA2 WasmControl s e pre mid
    -> WasmControl s e mid post -> WasmControl s e pre post
    forall s e (pre :: [WasmType]) (mid :: [WasmType])
           (post :: [WasmType]).
    WasmControl s e pre mid
    -> WasmControl s e mid post -> WasmControl s e pre post
    (<>)