    {-# LANGUAGE DataKinds #-}
    {-# LANGUAGE OverloadedStrings #-}
    {-# LANGUAGE Strict #-}
    {-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}

    module GHC.CmmToAsm.Wasm (ncgWasm) where

    import Data.ByteString.Builder
    import Data.ByteString.Lazy.Char8 (unpack)
    import Data.Maybe
    import Data.Semigroup
    import GHC.Cmm
    import GHC.Cmm.ContFlowOpt
    import GHC.Cmm.GenericOpt
    import GHC.CmmToAsm.Config
    import GHC.CmmToAsm.Wasm.Asm
    import GHC.CmmToAsm.Wasm.FromCmm
    import GHC.CmmToAsm.Wasm.Types
    import GHC.Data.Stream (Stream, StreamS (..), runStream)
    import GHC.Driver.DynFlags
    import GHC.Platform
    import GHC.Prelude
    import GHC.Settings
    import GHC.Types.Unique.Supply
    import GHC.Unit
    import GHC.Utils.Logger
    import GHC.Utils.Outputable (text)
    import System.IO

    ncgWasm ::
      NCGConfig ->
      Logger ->
      Platform ->
      ToolSettings ->
      UniqSupply ->
      ModLocation ->
      Handle ->
      Stream IO RawCmmGroup a ->
      IO a
    ncgWasm :: forall a.
    NCGConfig
    -> Logger
    -> Platform
    -> ToolSettings
    -> UniqSupply
    -> ModLocation
    -> Handle
    -> Stream IO RawCmmGroup a
    -> IO a
    ncgWasm NCGConfig
    ncg_config Logger
    logger Platform
    platform ToolSettings
    ts UniqSupply
    us ModLocation
    loc Handle
    h Stream IO RawCmmGroup a
    cmms = do
      (r, s) <- NCGConfig
    -> Platform
    -> UniqSupply
    -> Stream IO RawCmmGroup a
    -> IO (a, WasmCodeGenState 'I32)
    forall a.
    NCGConfig
    -> Platform
    -> UniqSupply
    -> Stream IO RawCmmGroup a
    -> IO (a, WasmCodeGenState 'I32)
    streamCmmGroups NCGConfig
    ncg_config Platform
    platform UniqSupply
    us Stream IO RawCmmGroup a
    cmms
      outputWasm $ "# " <> string7 (fromJust $ ml_hs_file loc) <> "\n\n"
      outputWasm $ execWasmAsmM do_tail_call $ asmTellEverything TagI32 s
      pure r
      where
        -- See Note [WasmTailCall]
        do_tail_call :: Bool
    do_tail_call = ToolSettings -> Bool
    doTailCall ToolSettings
    ts

        outputWasm :: Builder -> IO ()
    outputWasm Builder
    builder = do
          Logger -> DumpFlag -> String -> DumpFormat -> SDoc -> IO ()
    putDumpFileMaybe
            Logger
    logger
            DumpFlag
    Opt_D_dump_asm
            String
    "Asm Code"
            DumpFormat
    FormatASM
            (String -> SDoc
    forall doc. IsLine doc => String -> doc
    text (String -> SDoc)
    -> (LazyByteString -> String) -> LazyByteString -> SDoc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . LazyByteString -> String
    unpack (LazyByteString -> SDoc) -> LazyByteString -> SDoc
    forall a b. (a -> b) -> a -> b
    $ Builder -> LazyByteString
    toLazyByteString Builder
    builder)
          Handle -> Builder -> IO ()
    hPutBuilder Handle
    h Builder
    builder

    streamCmmGroups ::
      NCGConfig ->
      Platform ->
      UniqSupply ->
      Stream IO RawCmmGroup a ->
      IO (a, WasmCodeGenState 'I32)
    streamCmmGroups :: forall a.
    NCGConfig
    -> Platform
    -> UniqSupply
    -> Stream IO RawCmmGroup a
    -> IO (a, WasmCodeGenState 'I32)
    streamCmmGroups NCGConfig
    ncg_config Platform
    platform UniqSupply
    us Stream IO RawCmmGroup a
    cmms =
      WasmCodeGenState 'I32
    -> StreamS IO RawCmmGroup a -> IO (a, WasmCodeGenState 'I32)
    go (Platform -> UniqSupply -> WasmCodeGenState 'I32
    forall (w :: WasmType).
    Platform -> UniqSupply -> WasmCodeGenState w
    initialWasmCodeGenState Platform
    platform UniqSupply
    us) (StreamS IO RawCmmGroup a -> IO (a, WasmCodeGenState 'I32))
    -> StreamS IO RawCmmGroup a -> IO (a, WasmCodeGenState 'I32)
    forall a b. (a -> b) -> a -> b
    $ Stream IO RawCmmGroup a -> StreamS IO RawCmmGroup a
    forall (m :: * -> *) r' r.
    Applicative m =>
    Stream m r' r -> StreamS m r' r
    runStream Stream IO RawCmmGroup a
    cmms
      where
        go :: WasmCodeGenState 'I32
    -> StreamS IO RawCmmGroup a -> IO (a, WasmCodeGenState 'I32)
    go WasmCodeGenState 'I32
    s (Done a
    r) = (a, WasmCodeGenState 'I32) -> IO (a, WasmCodeGenState 'I32)
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (a
    r, WasmCodeGenState 'I32
    s)
        go WasmCodeGenState 'I32
    s (Effect IO (StreamS IO RawCmmGroup a)
    m) = IO (StreamS IO RawCmmGroup a)
    m IO (StreamS IO RawCmmGroup a)
    -> (StreamS IO RawCmmGroup a -> IO (a, WasmCodeGenState 'I32))
    -> IO (a, WasmCodeGenState 'I32)
    forall a b. IO a -> (a -> IO b) -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= WasmCodeGenState 'I32
    -> StreamS IO RawCmmGroup a -> IO (a, WasmCodeGenState 'I32)
    go WasmCodeGenState 'I32
    s
        go WasmCodeGenState 'I32
    s (Yield RawCmmGroup
    decls StreamS IO RawCmmGroup a
    k) = WasmCodeGenState 'I32
    -> StreamS IO RawCmmGroup a -> IO (a, WasmCodeGenState 'I32)
    go (WasmCodeGenM 'I32 ()
    -> WasmCodeGenState 'I32 -> WasmCodeGenState 'I32
    forall (w :: WasmType) a.
    WasmCodeGenM w a -> WasmCodeGenState w -> WasmCodeGenState w
    wasmExecM (RawCmmGroup -> WasmCodeGenM 'I32 ()
    forall (w :: WasmType). RawCmmGroup -> WasmCodeGenM w ()
    onCmmGroup (RawCmmGroup -> WasmCodeGenM 'I32 ())
    -> RawCmmGroup -> WasmCodeGenM 'I32 ()
    forall a b. (a -> b) -> a -> b
    $ (GenCmmDecl RawCmmStatics (LabelMap RawCmmStatics) CmmGraph
     -> GenCmmDecl RawCmmStatics (LabelMap RawCmmStatics) CmmGraph)
    -> RawCmmGroup -> RawCmmGroup
    forall a b. (a -> b) -> [a] -> [b]
    map GenCmmDecl RawCmmStatics (LabelMap RawCmmStatics) CmmGraph
    -> GenCmmDecl RawCmmStatics (LabelMap RawCmmStatics) CmmGraph
    opt RawCmmGroup
    decls) WasmCodeGenState 'I32
    s) StreamS IO RawCmmGroup a
    k
          where
            -- Run the generic cmm optimizations like other NCGs, followed
            -- by a late control-flow optimization pass that does shrink
            -- the CFG block count in some cases.
            opt :: GenCmmDecl RawCmmStatics (LabelMap RawCmmStatics) CmmGraph
    -> GenCmmDecl RawCmmStatics (LabelMap RawCmmStatics) CmmGraph
    opt GenCmmDecl RawCmmStatics (LabelMap RawCmmStatics) CmmGraph
    decl = case GenCmmDecl RawCmmStatics (LabelMap RawCmmStatics) CmmGraph
    decl of
              CmmData {} -> GenCmmDecl RawCmmStatics (LabelMap RawCmmStatics) CmmGraph
    decl
              CmmProc {} -> LabelMap RawCmmStatics
    -> CLabel
    -> [GlobalReg]
    -> CmmGraph
    -> GenCmmDecl RawCmmStatics (LabelMap RawCmmStatics) CmmGraph
    forall d h g. h -> CLabel -> [GlobalReg] -> g -> GenCmmDecl d h g
    CmmProc LabelMap RawCmmStatics
    info CLabel
    lbl [GlobalReg]
    live (CmmGraph
     -> GenCmmDecl RawCmmStatics (LabelMap RawCmmStatics) CmmGraph)
    -> CmmGraph
    -> GenCmmDecl RawCmmStatics (LabelMap RawCmmStatics) CmmGraph
    forall a b. (a -> b) -> a -> b
    $ Bool -> CmmGraph -> CmmGraph
    cmmCfgOpts Bool
    False CmmGraph
    graph
                where
                  (CmmProc LabelMap RawCmmStatics
    info CLabel
    lbl [GlobalReg]
    live CmmGraph
    graph, [CLabel]
    _) = NCGConfig
    -> GenCmmDecl RawCmmStatics (LabelMap RawCmmStatics) CmmGraph
    -> (GenCmmDecl RawCmmStatics (LabelMap RawCmmStatics) CmmGraph,
        [CLabel])
    cmmToCmm NCGConfig
    ncg_config GenCmmDecl RawCmmStatics (LabelMap RawCmmStatics) CmmGraph
    decl

    doTailCall :: ToolSettings -> Bool
    doTailCall :: ToolSettings -> Bool
    doTailCall ToolSettings
    ts = String -> Option
    Option String
    "-mtail-call" Option -> [Option] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [Option]
    as_args
      where
        (String
    _, [Option]
    as_args) = ToolSettings -> (String, [Option])
    toolSettings_pgm_a ToolSettings
    ts