    {-# LANGUAGE DataKinds #-}
    {-# LANGUAGE DerivingVia #-}
    {-# LANGUAGE GADTs #-}
    {-# LANGUAGE GeneralizedNewtypeDeriving #-}
    {-# LANGUAGE RankNTypes #-}
    {-# LANGUAGE RecordWildCards #-}
    {-# LANGUAGE ScopedTypeVariables #-}
    {-# LANGUAGE StandaloneDeriving #-}
    {-# LANGUAGE Strict #-}
    {-# LANGUAGE TypeFamilyDependencies #-}
    {-# LANGUAGE UnboxedTuples #-}
    {-# LANGUAGE UndecidableInstances #-}

    module GHC.CmmToAsm.Wasm.Types
      ( WasmType (..),
        WasmTypeTag (..),
        SomeWasmType (..),
        TypeList (..),
        someWasmTypesFromTypeList,
        WasmFunctionType (..),
        SymName (..),
        SymVisibility (..),
        SymKind (..),
        DataSectionKind (..),
        DataSectionContent (..),
        DataSection (..),
        GlobalInfo,
        LocalInfo,
        FuncBody (..),
        Signage (..),
        WasmInstr (..),
        WasmExpr (..),
        SomeWasmExpr (..),
        WasmStatements (..),
        WasmControl (..),
        BrTableInterval (..),
        wasmControlCast,
        WasmCodeGenState (..),
        initialWasmCodeGenState,
        WasmCodeGenM (..),
        wasmGetsM,
        wasmPlatformM,
        wasmWordTypeM,
        wasmWordCmmTypeM,
        wasmStateM,
        wasmModifyM,
        wasmExecM,
      )
    where

    import Control.Applicative
    import Data.ByteString (ByteString)
    import Data.Coerce
    import Data.Functor
    import qualified GHC.Data.Word64Set as WS
    import Data.Kind
    import Data.String
    import Data.Type.Equality
    import Data.Word
    import GHC.Cmm
    import GHC.Data.FastString
    import GHC.Float
    import GHC.Platform
    import GHC.Prelude
    import GHC.Types.Basic
    import GHC.Types.Unique
    import GHC.Types.Unique.FM
    import GHC.Types.Unique.Map
    import GHC.Types.Unique.Supply
    import GHC.Utils.Monad.State.Strict
    import GHC.Utils.Outputable hiding ((<>))
    import Unsafe.Coerce

    -- | WebAssembly type of a WebAssembly value that WebAssembly code
    -- could either expect on the evaluation stack or leave on the
    -- evaluation stack.
    data WasmType = I32 | I64 | F32 | F64

    -- | Singleton type useful for programming with `WasmType` at the type
    -- level.
    data WasmTypeTag :: WasmType -> Type where
      TagI32 :: WasmTypeTag 'I32
      TagI64 :: WasmTypeTag 'I64
      TagF32 :: WasmTypeTag 'F32
      TagF64 :: WasmTypeTag 'F64

    deriving instance Show (WasmTypeTag t)

    instance TestEquality WasmTypeTag where
      WasmTypeTag a
    TagI32 testEquality :: forall (a :: WasmType) (b :: WasmType).
    WasmTypeTag a -> WasmTypeTag b -> Maybe (a :~: b)
    `testEquality` WasmTypeTag b
    TagI32 = (a :~: b) -> Maybe (a :~: b)
    forall a. a -> Maybe a
    Just a :~: a
    a :~: b
    forall {k} (a :: k). a :~: a
    Refl
      WasmTypeTag a
    TagI64 `testEquality` WasmTypeTag b
    TagI64 = (a :~: b) -> Maybe (a :~: b)
    forall a. a -> Maybe a
    Just a :~: a
    a :~: b
    forall {k} (a :: k). a :~: a
    Refl
      WasmTypeTag a
    TagF32 `testEquality` WasmTypeTag b
    TagF32 = (a :~: b) -> Maybe (a :~: b)
    forall a. a -> Maybe a
    Just a :~: a
    a :~: b
    forall {k} (a :: k). a :~: a
    Refl
      WasmTypeTag a
    TagF64 `testEquality` WasmTypeTag b
    TagF64 = (a :~: b) -> Maybe (a :~: b)
    forall a. a -> Maybe a
    Just a :~: a
    a :~: b
    forall {k} (a :: k). a :~: a
    Refl
      WasmTypeTag a
    _ `testEquality` WasmTypeTag b
    _ = Maybe (a :~: b)
    forall a. Maybe a
    Nothing

    data SomeWasmType where
      SomeWasmType :: WasmTypeTag t -> SomeWasmType

    instance Eq SomeWasmType where
      SomeWasmType WasmTypeTag t
    ty0 == :: SomeWasmType -> SomeWasmType -> Bool
    == SomeWasmType WasmTypeTag t
    ty1
        | Just t :~: t
    Refl <- WasmTypeTag t
    ty0 WasmTypeTag t -> WasmTypeTag t -> Maybe (t :~: t)
    forall {k} (f :: k -> *) (a :: k) (b :: k).
    TestEquality f =>
    f a -> f b -> Maybe (a :~: b)
    forall (a :: WasmType) (b :: WasmType).
    WasmTypeTag a -> WasmTypeTag b -> Maybe (a :~: b)
    `testEquality` WasmTypeTag t
    ty1 = Bool
    True
        | Bool
    otherwise = Bool
    False

    -- | List of WebAssembly types used to describe the sequence of
    -- WebAssembly values that a block of code may expect on the stack or
    -- leave on the stack.
    data TypeList :: [WasmType] -> Type where
      TypeListNil :: TypeList '[]
      TypeListCons :: WasmTypeTag t -> TypeList ts -> TypeList (t : ts)

    someWasmTypesFromTypeList :: TypeList ts -> [SomeWasmType]
    someWasmTypesFromTypeList :: forall (ts :: [WasmType]). TypeList ts -> [SomeWasmType]
    someWasmTypesFromTypeList TypeList ts
    TypeListNil = []
    someWasmTypesFromTypeList (WasmTypeTag t
    ty `TypeListCons` TypeList ts
    tys) =
      WasmTypeTag t -> SomeWasmType
    forall (t :: WasmType). WasmTypeTag t -> SomeWasmType
    SomeWasmType WasmTypeTag t
    ty SomeWasmType -> [SomeWasmType] -> [SomeWasmType]
    forall a. a -> [a] -> [a]
    : TypeList ts -> [SomeWasmType]
    forall (ts :: [WasmType]). TypeList ts -> [SomeWasmType]
    someWasmTypesFromTypeList TypeList ts
    tys

    -- | The type of a WebAssembly function, loop, block, or conditional.
    -- This type says what values the code expects to pop off the stack
    -- and what values it promises to push.  The WebAssembly standard
    -- requires that this type appear explicitly in the code.
    data WasmFunctionType pre post = WasmFunctionType {forall (pre :: [WasmType]) (post :: [WasmType]).
    WasmFunctionType pre post -> TypeList pre
    ft_pops :: TypeList pre, forall (pre :: [WasmType]) (post :: [WasmType]).
    WasmFunctionType pre post -> TypeList post
    ft_pushes :: TypeList post}

    -- | For simplicity, we record other metadata in 'WasmCodeGenState' by
    -- need, instead of carrying them along with 'SymName'.
    newtype SymName = SymName FastString
      deriving (SymName -> SymName -> Bool
    (SymName -> SymName -> Bool)
    -> (SymName -> SymName -> Bool) -> Eq SymName
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: SymName -> SymName -> Bool
    == :: SymName -> SymName -> Bool
    $c/= :: SymName -> SymName -> Bool
    /= :: SymName -> SymName -> Bool
    Eq, String -> SymName
    (String -> SymName) -> IsString SymName
    forall a. (String -> a) -> IsString a
    $cfromString :: String -> SymName
    fromString :: String -> SymName
    IsString, Int -> SymName -> ShowS
    [SymName] -> ShowS
    SymName -> String
    (Int -> SymName -> ShowS)
    -> (SymName -> String) -> ([SymName] -> ShowS) -> Show SymName
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> SymName -> ShowS
    showsPrec :: Int -> SymName -> ShowS
    $cshow :: SymName -> String
    show :: SymName -> String
    $cshowList :: [SymName] -> ShowS
    showList :: [SymName] -> ShowS
    Show, SymName -> Unique
    (SymName -> Unique) -> Uniquable SymName
    forall a. (a -> Unique) -> Uniquable a
    $cgetUnique :: SymName -> Unique
    getUnique :: SymName -> Unique
    Uniquable) via FastString
      deriving (Eq SymName
    Eq SymName =>
    (SymName -> SymName -> Ordering)
    -> (SymName -> SymName -> Bool)
    -> (SymName -> SymName -> Bool)
    -> (SymName -> SymName -> Bool)
    -> (SymName -> SymName -> Bool)
    -> (SymName -> SymName -> SymName)
    -> (SymName -> SymName -> SymName)
    -> Ord SymName
    SymName -> SymName -> Bool
    SymName -> SymName -> Ordering
    SymName -> SymName -> SymName
    forall a.
    Eq a =>
    (a -> a -> Ordering)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> a)
    -> (a -> a -> a)
    -> Ord a
    $ccompare :: SymName -> SymName -> Ordering
    compare :: SymName -> SymName -> Ordering
    $c< :: SymName -> SymName -> Bool
    < :: SymName -> SymName -> Bool
    $c<= :: SymName -> SymName -> Bool
    <= :: SymName -> SymName -> Bool
    $c> :: SymName -> SymName -> Bool
    > :: SymName -> SymName -> Bool
    $c>= :: SymName -> SymName -> Bool
    >= :: SymName -> SymName -> Bool
    $cmax :: SymName -> SymName -> SymName
    max :: SymName -> SymName -> SymName
    $cmin :: SymName -> SymName -> SymName
    min :: SymName -> SymName -> SymName
    Ord) via LexicalFastString

    data SymVisibility
      = -- | Not defined in the current compilation unit.
        --
        -- @[ undefined binding=global vis=default ]@
        SymUndefined
      | -- | Defined, not visible to other compilation units.
        --
        -- @[ binding=local vis=default ]@
        SymStatic
      | -- | Defined, visible to other compilation units.
        --
        -- Adds @.hidden@ & @.globl@ directives in the output assembly.
        --
        -- @[ binding=global vis=hidden ]@
        SymDefault

    -- | Represents whether a symbol is a data symbol or a function
    -- symbol. Unlike linkers for other targets, @wasm-ld@ does panic at
    -- link-time if it finds symbol kind inconsistency between the
    -- definition site and other use sites.
    --
    -- Currently we solely rely on 'isCFunctionLabel' to determine a
    -- symbol's kind, but it does take extra effort to make it work. The
    -- main source of inconsistency arises from hand-written Cmm sources,
    -- where it's possible to refer to external entities like @xxx_info@
    -- and @xxx_closure@ without explicit @import CLOSURE@ declarations.
    -- The Cmm parser will implicitly assume those are foreign function
    -- labels, and then this will break the WebAssembly backend. #22368
    -- provides more context on this issue.
    --
    -- tl;dr for any GHC contributor that accidentally triggers @wasm-ld@
    -- errors when hacking Cmm: whatever data symbols are used in new
    -- code, just add the corresponding @import CLOSURE@ declarations at
    -- the top of that Cmm file.
    data SymKind = SymData | SymFunc
      deriving (SymKind -> SymKind -> Bool
    (SymKind -> SymKind -> Bool)
    -> (SymKind -> SymKind -> Bool) -> Eq SymKind
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: SymKind -> SymKind -> Bool
    == :: SymKind -> SymKind -> Bool
    $c/= :: SymKind -> SymKind -> Bool
    /= :: SymKind -> SymKind -> Bool
    Eq)

    -- | WebAssembly doesn't really have proper read-only memory regions
    -- yet. Neverthless we add the .rodata logic here, wasm-ld will
    -- aggregate all .rodata sections into a single one, which adds
    -- possibility for runtime checks later, either via a customized
    -- runtime, or via code instrumentation. See
    -- <https://github.com/llvm/llvm-project/blob/b296aed8ae239c20ebdd7969e978f8d2a3b9c178/lld/wasm/Writer.cpp#L856>
    data DataSectionKind = SectionData | SectionROData

    -- | Neither Cmm or Wasm type system takes integer signedness into
    -- account, therefore we always round up a 'CmmLit' to the right width
    -- and handle it as an untyped integer.
    data DataSectionContent
      = DataI8 Word8
      | DataI16 Word16
      | DataI32 Word32
      | DataI64 Word64
      | DataF32 Float
      | DataF64 Double
      | DataSym SymName Int
      | DataSkip Int
      | DataASCII ByteString
      | DataIncBin FilePath Int

    data DataSection = DataSection
      { DataSection -> DataSectionKind
    dataSectionKind :: DataSectionKind,
        DataSection -> Alignment
    dataSectionAlignment ::
          Alignment,
        DataSection -> [DataSectionContent]
    dataSectionContents :: [DataSectionContent]
      }

    -- | We need to remember the symbols. Determinism is achieved by
    -- sorting symbols before writing the assembly.
    type SymMap = UniqMap SymName

    -- | No need to remember the symbols.
    type SymSet = WS.Word64Set

    type GlobalInfo = (SymName, SomeWasmType)

    type LocalInfo = (Int, SomeWasmType)

    data FuncBody w = FuncBody
      { forall (w :: WasmType). FuncBody w -> [SomeWasmType]
    funcLocals :: [SomeWasmType],
        -- | Most are Cmm functions, but may also contain synthesized
        -- function of other types, sigh.
        forall (w :: WasmType).
    FuncBody w
    -> WasmControl (WasmStatements w) (WasmExpr w w) '[] '[w]
    funcBody :: WasmControl (WasmStatements w) (WasmExpr w w) '[] '[w]
      }

    data Signage = Signed | Unsigned

    -- | The @w@ type variable in the Wasm IR stands for "platform word
    -- type", so 'TagI32' on wasm32, and 'TagI64' on wasm64. This way, we
    -- can make the codegen logic work on both wasm32/wasm64 in a
    -- type-safe manner.
    data WasmInstr :: WasmType -> [WasmType] -> [WasmType] -> Type where
      WasmComment :: String -> WasmInstr w pre pre
      WasmNop :: WasmInstr w pre pre
      WasmDrop :: WasmInstr w (t : pre) pre
      WasmUnreachable :: WasmInstr w pre post
      WasmConst :: WasmTypeTag t -> Integer -> WasmInstr w pre (t : pre)
      WasmSymConst :: SymName -> WasmInstr w pre (w : pre)
      WasmLoad ::
        WasmTypeTag t ->
        Maybe Int ->
        Signage ->
        Int ->
        AlignmentSpec ->
        WasmInstr w (w : pre) (t : pre)
      WasmStore ::
        WasmTypeTag t ->
        Maybe Int ->
        Int ->
        AlignmentSpec ->
        WasmInstr
          w
          (t : w : pre)
          pre
      WasmGlobalGet :: WasmTypeTag t -> SymName -> WasmInstr w pre (t : pre)
      WasmGlobalSet :: WasmTypeTag t -> SymName -> WasmInstr w (t : pre) pre
      WasmLocalGet :: WasmTypeTag t -> Int -> WasmInstr w pre (t : pre)
      WasmLocalSet :: WasmTypeTag t -> Int -> WasmInstr w (t : pre) pre
      WasmLocalTee :: WasmTypeTag t -> Int -> WasmInstr w (t : pre) (t : pre)
      WasmCCall :: SymName -> WasmInstr w pre post
      WasmCCallIndirect ::
        TypeList arg_tys ->
        TypeList ret_tys ->
        WasmInstr
          w
          (w : pre)
          post
      WasmConcat ::
        WasmInstr w pre mid ->
        WasmInstr w mid post ->
        WasmInstr w pre post
      WasmReinterpret ::
        WasmTypeTag t0 ->
        WasmTypeTag t1 ->
        WasmInstr
          w
          (t0 : pre)
          (t1 : pre)
      WasmTruncSat ::
        Signage ->
        WasmTypeTag t0 ->
        WasmTypeTag t1 ->
        WasmInstr
          w
          (t0 : pre)
          (t1 : pre)
      WasmConvert ::
        Signage ->
        WasmTypeTag t0 ->
        WasmTypeTag t1 ->
        WasmInstr
          w
          (t0 : pre)
          (t1 : pre)
      WasmAdd :: WasmTypeTag t -> WasmInstr w (t : t : pre) (t : pre)
      WasmSub :: WasmTypeTag t -> WasmInstr w (t : t : pre) (t : pre)
      WasmMul :: WasmTypeTag t -> WasmInstr w (t : t : pre) (t : pre)
      WasmDiv :: Signage -> WasmTypeTag t -> WasmInstr w (t : t : pre) (t : pre)
      WasmRem :: Signage -> WasmTypeTag t -> WasmInstr w (t : t : pre) (t : pre)
      WasmAnd :: WasmTypeTag t -> WasmInstr w (t : t : pre) (t : pre)
      WasmOr :: WasmTypeTag t -> WasmInstr w (t : t : pre) (t : pre)
      WasmXor :: WasmTypeTag t -> WasmInstr w (t : t : pre) (t : pre)
      WasmEq :: WasmTypeTag t -> WasmInstr w (t : t : pre) (w : pre)
      WasmNe :: WasmTypeTag t -> WasmInstr w (t : t : pre) (w : pre)
      WasmLt :: Signage -> WasmTypeTag t -> WasmInstr w (t : t : pre) (w : pre)
      WasmGt :: Signage -> WasmTypeTag t -> WasmInstr w (t : t : pre) (w : pre)
      WasmLe :: Signage -> WasmTypeTag t -> WasmInstr w (t : t : pre) (w : pre)
      WasmGe :: Signage -> WasmTypeTag t -> WasmInstr w (t : t : pre) (w : pre)
      WasmShl :: WasmTypeTag t -> WasmInstr w (t : t : pre) (t : pre)
      WasmShr :: Signage -> WasmTypeTag t -> WasmInstr w (t : t : pre) (t : pre)
      WasmI32Extend8S :: WasmInstr w ('I32 : pre) ('I32 : pre)
      WasmI32Extend16S :: WasmInstr w ('I32 : pre) ('I32 : pre)
      WasmI64Extend8S :: WasmInstr w ('I64 : pre) ('I64 : pre)
      WasmI64Extend16S :: WasmInstr w ('I64 : pre) ('I64 : pre)
      WasmI64Extend32S :: WasmInstr w ('I64 : pre) ('I64 : pre)
      WasmI64ExtendI32 :: Signage -> WasmInstr w ('I32 : pre) ('I64 : pre)
      WasmI32WrapI64 :: WasmInstr w ('I64 : pre) ('I32 : pre)
      WasmF32DemoteF64 :: WasmInstr w ('F64 : pre) ('F32 : pre)
      WasmF64PromoteF32 :: WasmInstr w ('F32 : pre) ('F64 : pre)
      WasmAbs :: WasmTypeTag t -> WasmInstr w (t : pre) (t : pre)
      WasmNeg :: WasmTypeTag t -> WasmInstr w (t : pre) (t : pre)
      WasmCond :: WasmInstr w pre pre -> WasmInstr w (w : pre) pre

    newtype WasmExpr w t = WasmExpr (forall pre. WasmInstr w pre (t : pre))

    data SomeWasmExpr w where
      SomeWasmExpr :: WasmTypeTag t -> WasmExpr w t -> SomeWasmExpr w

    newtype WasmStatements w = WasmStatements (forall pre. WasmInstr w pre pre)

    -- | Representation of WebAssembly control flow.
    -- Normally written as
    -- @
    --   WasmControl s e pre post
    -- @
    -- Type parameter `s` is the type of (unspecified) statements.
    -- It might be instantiated with an open Cmm block or with a sequence
    -- of Wasm instructions.
    -- Parameter `e` is the type of expressions.
    -- Parameter `pre` represents the values that are expected on the
    -- WebAssembly stack when the code runs, and `post` represents
    -- the state of the stack on completion.
    data WasmControl :: Type -> Type -> [WasmType] -> [WasmType] -> Type where
      WasmPush :: WasmTypeTag t -> e -> WasmControl s e stack (t : stack)
      WasmBlock ::
        WasmFunctionType pre post ->
        WasmControl s e pre post ->
        WasmControl s e pre post
      WasmLoop ::
        WasmFunctionType pre post ->
        WasmControl s e pre post ->
        WasmControl s e pre post
      WasmIfTop ::
        WasmFunctionType pre post ->
        WasmControl s e pre post ->
        WasmControl s e pre post ->
        WasmControl s e ('I32 : pre) post
      WasmBr :: Int -> WasmControl s e dropped destination -- not typechecked
      WasmFallthrough :: WasmControl s e dropped destination
      -- generates no code, but has the same type as a branch
      WasmBrTable ::
        e ->
        BrTableInterval -> -- for testing
        [Int] -> -- targets
        Int -> -- default target
        WasmControl s e dropped destination
      -- invariant: the table interval is contained
      -- within [0 .. pred (length targets)]

      -- Note [WasmTailCall]
      -- ~~~~~~~~~~~~~~~~~~~
      -- This represents the exit point of each CmmGraph: tail calling the
      -- destination in CmmCall. The STG stack may grow before the call,
      -- but it's always a tail call in the sense that the C call stack is
      -- guaranteed not to grow.
      --
      -- In the wasm backend, WasmTailCall is lowered to different
      -- assembly code given whether the wasm tail-call extension is
      -- enabled:
      --
      -- When tail-call is not enabled (which is the default as of today),
      -- a WasmTailCall is lowered to code that pushes the callee function
      -- pointer onto the value stack and returns immediately. The actual
      -- call is done by the trampoline in StgRun.
      --
      -- When tail-call is indeed enabled via passing -mtail-call in
      -- CONF_CC_OPTS_STAGE2 at configure time, a WasmTailCall is lowered
      -- to return_call/return_call_indirect, thus tail calling into its
      -- callee without returning to StgRun.
      WasmTailCall ::
        e ->
        WasmControl s e t1star t2star -- as per type system
      WasmActions ::
        s ->
        WasmControl s e stack stack -- basic block: one entry, one exit
      WasmSeq ::
        WasmControl s e pre mid ->
        WasmControl s e mid post ->
        WasmControl s e pre post

    data BrTableInterval = BrTableInterval {BrTableInterval -> Integer
    bti_lo :: Integer, BrTableInterval -> Integer
    bti_count :: Integer}
      deriving (Int -> BrTableInterval -> ShowS
    [BrTableInterval] -> ShowS
    BrTableInterval -> String
    (Int -> BrTableInterval -> ShowS)
    -> (BrTableInterval -> String)
    -> ([BrTableInterval] -> ShowS)
    -> Show BrTableInterval
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> BrTableInterval -> ShowS
    showsPrec :: Int -> BrTableInterval -> ShowS
    $cshow :: BrTableInterval -> String
    show :: BrTableInterval -> String
    $cshowList :: [BrTableInterval] -> ShowS
    showList :: [BrTableInterval] -> ShowS
    Show)

    instance Outputable BrTableInterval where
      ppr :: BrTableInterval -> SDoc
    ppr BrTableInterval
    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
    hcat
            [Integer -> SDoc
    forall doc. IsLine doc => Integer -> doc
    integer (BrTableInterval -> Integer
    bti_lo BrTableInterval
    range), String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "..", Integer -> SDoc
    forall doc. IsLine doc => Integer -> doc
    integer Integer
    hi]
        where
          hi :: Integer
    hi = BrTableInterval -> Integer
    bti_lo BrTableInterval
    range Integer -> Integer -> Integer
    forall a. Num a => a -> a -> a
    + BrTableInterval -> Integer
    bti_count BrTableInterval
    range Integer -> Integer -> Integer
    forall a. Num a => a -> a -> a
    - Integer
    1

    wasmControlCast :: WasmControl s e pre post -> WasmControl s e pre' post'
    wasmControlCast :: forall s e (pre :: [WasmType]) (post :: [WasmType])
           (pre' :: [WasmType]) (post' :: [WasmType]).
    WasmControl s e pre post -> WasmControl s e pre' post'
    wasmControlCast = WasmControl s e pre post -> WasmControl s e pre' post'
    forall a b. a -> b
    unsafeCoerce

    data WasmCodeGenState w = WasmCodeGenState
      { -- | Target platform
        forall (w :: WasmType). WasmCodeGenState w -> Platform
    wasmPlatform :: Platform,
        -- | Defined symbols with 'SymDefault' visibility.
        forall (w :: WasmType). WasmCodeGenState w -> SymSet
    defaultSyms :: SymSet,
        -- | Function types, defined or not. There may exist a function
        -- whose type is unknown (e.g. as a function pointer), in that
        -- case we fall back to () -> (), it's imperfect but works with
        -- wasm-ld.
        forall (w :: WasmType).
    WasmCodeGenState w -> SymMap ([SomeWasmType], [SomeWasmType])
    funcTypes :: SymMap ([SomeWasmType], [SomeWasmType]),
        -- | Defined function bodies.
        forall (w :: WasmType). WasmCodeGenState w -> SymMap (FuncBody w)
    funcBodies :: SymMap (FuncBody w),
        -- | Defined data sections.
        forall (w :: WasmType). WasmCodeGenState w -> SymMap DataSection
    dataSections :: SymMap DataSection,
        -- | ctors in the current compilation unit.
        forall (w :: WasmType). WasmCodeGenState w -> [SymName]
    ctors :: [SymName],
        forall (w :: WasmType).
    WasmCodeGenState w -> UniqFM LocalReg LocalInfo
    localRegs ::
          UniqFM LocalReg LocalInfo,
        forall (w :: WasmType). WasmCodeGenState w -> Int
    localRegsCount ::
          Int,
        forall (w :: WasmType). WasmCodeGenState w -> UniqSupply
    wasmUniqSupply :: UniqSupply
      }

    initialWasmCodeGenState :: Platform -> UniqSupply -> WasmCodeGenState w
    initialWasmCodeGenState :: forall (w :: WasmType).
    Platform -> UniqSupply -> WasmCodeGenState w
    initialWasmCodeGenState Platform
    platform UniqSupply
    us =
      WasmCodeGenState
        { wasmPlatform :: Platform
    wasmPlatform =
            Platform
    platform,
          defaultSyms :: SymSet
    defaultSyms = SymSet
    WS.empty,
          funcTypes :: SymMap ([SomeWasmType], [SomeWasmType])
    funcTypes = SymMap ([SomeWasmType], [SomeWasmType])
    forall k a. UniqMap k a
    emptyUniqMap,
          funcBodies :: SymMap (FuncBody w)
    funcBodies =
            SymMap (FuncBody w)
    forall k a. UniqMap k a
    emptyUniqMap,
          dataSections :: SymMap DataSection
    dataSections = SymMap DataSection
    forall k a. UniqMap k a
    emptyUniqMap,
          ctors :: [SymName]
    ctors =
            [],
          localRegs :: UniqFM LocalReg LocalInfo
    localRegs = UniqFM LocalReg LocalInfo
    forall {k} (key :: k) elt. UniqFM key elt
    emptyUFM,
          localRegsCount :: Int
    localRegsCount = Int
    0,
          wasmUniqSupply :: UniqSupply
    wasmUniqSupply = UniqSupply
    us
        }

    newtype WasmCodeGenM w a = WasmCodeGenM (State (WasmCodeGenState w) a)
      deriving newtype ((forall a b. (a -> b) -> WasmCodeGenM w a -> WasmCodeGenM w b)
    -> (forall a b. a -> WasmCodeGenM w b -> WasmCodeGenM w a)
    -> Functor (WasmCodeGenM w)
    forall a b. a -> WasmCodeGenM w b -> WasmCodeGenM w a
    forall a b. (a -> b) -> WasmCodeGenM w a -> WasmCodeGenM w b
    forall (w :: WasmType) a b.
    a -> WasmCodeGenM w b -> WasmCodeGenM w a
    forall (w :: WasmType) a b.
    (a -> b) -> WasmCodeGenM w a -> WasmCodeGenM w b
    forall (f :: * -> *).
    (forall a b. (a -> b) -> f a -> f b)
    -> (forall a b. a -> f b -> f a) -> Functor f
    $cfmap :: forall (w :: WasmType) a b.
    (a -> b) -> WasmCodeGenM w a -> WasmCodeGenM w b
    fmap :: forall a b. (a -> b) -> WasmCodeGenM w a -> WasmCodeGenM w b
    $c<$ :: forall (w :: WasmType) a b.
    a -> WasmCodeGenM w b -> WasmCodeGenM w a
    <$ :: forall a b. a -> WasmCodeGenM w b -> WasmCodeGenM w a
    Functor, Functor (WasmCodeGenM w)
    Functor (WasmCodeGenM w) =>
    (forall a. a -> WasmCodeGenM w a)
    -> (forall a b.
        WasmCodeGenM w (a -> b) -> WasmCodeGenM w a -> WasmCodeGenM w b)
    -> (forall a b c.
        (a -> b -> c)
        -> WasmCodeGenM w a -> WasmCodeGenM w b -> WasmCodeGenM w c)
    -> (forall a b.
        WasmCodeGenM w a -> WasmCodeGenM w b -> WasmCodeGenM w b)
    -> (forall a b.
        WasmCodeGenM w a -> WasmCodeGenM w b -> WasmCodeGenM w a)
    -> Applicative (WasmCodeGenM w)
    forall a. a -> WasmCodeGenM w a
    forall a b.
    WasmCodeGenM w a -> WasmCodeGenM w b -> WasmCodeGenM w a
    forall a b.
    WasmCodeGenM w a -> WasmCodeGenM w b -> WasmCodeGenM w b
    forall a b.
    WasmCodeGenM w (a -> b) -> WasmCodeGenM w a -> WasmCodeGenM w b
    forall a b c.
    (a -> b -> c)
    -> WasmCodeGenM w a -> WasmCodeGenM w b -> WasmCodeGenM w c
    forall (w :: WasmType). Functor (WasmCodeGenM w)
    forall (w :: WasmType) a. a -> WasmCodeGenM w a
    forall (w :: WasmType) a b.
    WasmCodeGenM w a -> WasmCodeGenM w b -> WasmCodeGenM w a
    forall (w :: WasmType) a b.
    WasmCodeGenM w a -> WasmCodeGenM w b -> WasmCodeGenM w b
    forall (w :: WasmType) a b.
    WasmCodeGenM w (a -> b) -> WasmCodeGenM w a -> WasmCodeGenM w b
    forall (w :: WasmType) a b c.
    (a -> b -> c)
    -> WasmCodeGenM w a -> WasmCodeGenM w b -> WasmCodeGenM w c
    forall (f :: * -> *).
    Functor f =>
    (forall a. a -> f a)
    -> (forall a b. f (a -> b) -> f a -> f b)
    -> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
    -> (forall a b. f a -> f b -> f b)
    -> (forall a b. f a -> f b -> f a)
    -> Applicative f
    $cpure :: forall (w :: WasmType) a. a -> WasmCodeGenM w a
    pure :: forall a. a -> WasmCodeGenM w a
    $c<*> :: forall (w :: WasmType) a b.
    WasmCodeGenM w (a -> b) -> WasmCodeGenM w a -> WasmCodeGenM w b
    <*> :: forall a b.
    WasmCodeGenM w (a -> b) -> WasmCodeGenM w a -> WasmCodeGenM w b
    $cliftA2 :: forall (w :: WasmType) a b c.
    (a -> b -> c)
    -> WasmCodeGenM w a -> WasmCodeGenM w b -> WasmCodeGenM w c
    liftA2 :: forall a b c.
    (a -> b -> c)
    -> WasmCodeGenM w a -> WasmCodeGenM w b -> WasmCodeGenM w c
    $c*> :: forall (w :: WasmType) a b.
    WasmCodeGenM w a -> WasmCodeGenM w b -> WasmCodeGenM w b
    *> :: forall a b.
    WasmCodeGenM w a -> WasmCodeGenM w b -> WasmCodeGenM w b
    $c<* :: forall (w :: WasmType) a b.
    WasmCodeGenM w a -> WasmCodeGenM w b -> WasmCodeGenM w a
    <* :: forall a b.
    WasmCodeGenM w a -> WasmCodeGenM w b -> WasmCodeGenM w a
    Applicative, Applicative (WasmCodeGenM w)
    Applicative (WasmCodeGenM w) =>
    (forall a b.
     WasmCodeGenM w a -> (a -> WasmCodeGenM w b) -> WasmCodeGenM w b)
    -> (forall a b.
        WasmCodeGenM w a -> WasmCodeGenM w b -> WasmCodeGenM w b)
    -> (forall a. a -> WasmCodeGenM w a)
    -> Monad (WasmCodeGenM w)
    forall a. a -> WasmCodeGenM w a
    forall a b.
    WasmCodeGenM w a -> WasmCodeGenM w b -> WasmCodeGenM w b
    forall a b.
    WasmCodeGenM w a -> (a -> WasmCodeGenM w b) -> WasmCodeGenM w b
    forall (w :: WasmType). Applicative (WasmCodeGenM w)
    forall (w :: WasmType) a. a -> WasmCodeGenM w a
    forall (w :: WasmType) a b.
    WasmCodeGenM w a -> WasmCodeGenM w b -> WasmCodeGenM w b
    forall (w :: WasmType) a b.
    WasmCodeGenM w a -> (a -> WasmCodeGenM w b) -> WasmCodeGenM w b
    forall (m :: * -> *).
    Applicative m =>
    (forall a b. m a -> (a -> m b) -> m b)
    -> (forall a b. m a -> m b -> m b)
    -> (forall a. a -> m a)
    -> Monad m
    $c>>= :: forall (w :: WasmType) a b.
    WasmCodeGenM w a -> (a -> WasmCodeGenM w b) -> WasmCodeGenM w b
    >>= :: forall a b.
    WasmCodeGenM w a -> (a -> WasmCodeGenM w b) -> WasmCodeGenM w b
    $c>> :: forall (w :: WasmType) a b.
    WasmCodeGenM w a -> WasmCodeGenM w b -> WasmCodeGenM w b
    >> :: forall a b.
    WasmCodeGenM w a -> WasmCodeGenM w b -> WasmCodeGenM w b
    $creturn :: forall (w :: WasmType) a. a -> WasmCodeGenM w a
    return :: forall a. a -> WasmCodeGenM w a
    Monad)

    wasmGetsM :: (WasmCodeGenState w -> a) -> WasmCodeGenM w a
    wasmGetsM :: forall (w :: WasmType) a.
    (WasmCodeGenState w -> a) -> WasmCodeGenM w a
    wasmGetsM = State (WasmCodeGenState w) a -> WasmCodeGenM w a
    forall a b. Coercible a b => a -> b
    coerce (State (WasmCodeGenState w) a -> WasmCodeGenM w a)
    -> ((WasmCodeGenState w -> a) -> State (WasmCodeGenState w) a)
    -> (WasmCodeGenState w -> a)
    -> WasmCodeGenM w a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (WasmCodeGenState w -> a) -> State (WasmCodeGenState w) a
    forall s a. (s -> a) -> State s a
    gets

    wasmPlatformM :: WasmCodeGenM w Platform
    wasmPlatformM :: forall (w :: WasmType). WasmCodeGenM w Platform
    wasmPlatformM = (WasmCodeGenState w -> Platform) -> WasmCodeGenM w Platform
    forall (w :: WasmType) a.
    (WasmCodeGenState w -> a) -> WasmCodeGenM w a
    wasmGetsM WasmCodeGenState w -> Platform
    forall (w :: WasmType). WasmCodeGenState w -> Platform
    wasmPlatform

    wasmWordTypeM :: WasmCodeGenM w (WasmTypeTag w)
    wasmWordTypeM :: forall (w :: WasmType). WasmCodeGenM w (WasmTypeTag w)
    wasmWordTypeM = (WasmCodeGenState w -> WasmTypeTag w)
    -> WasmCodeGenM w (WasmTypeTag w)
    forall (w :: WasmType) a.
    (WasmCodeGenState w -> a) -> WasmCodeGenM w a
    wasmGetsM ((WasmCodeGenState w -> WasmTypeTag w)
     -> WasmCodeGenM w (WasmTypeTag w))
    -> (WasmCodeGenState w -> WasmTypeTag w)
    -> WasmCodeGenM w (WasmTypeTag w)
    forall a b. (a -> b) -> a -> b
    $ \WasmCodeGenState w
    s ->
      if Platform -> Bool
    target32Bit (Platform -> Bool) -> Platform -> Bool
    forall a b. (a -> b) -> a -> b
    $ WasmCodeGenState w -> Platform
    forall (w :: WasmType). WasmCodeGenState w -> Platform
    wasmPlatform WasmCodeGenState w
    s
        then WasmTypeTag 'I32 -> WasmTypeTag w
    forall a b. a -> b
    unsafeCoerce WasmTypeTag 'I32
    TagI32
        else WasmTypeTag 'I64 -> WasmTypeTag w
    forall a b. a -> b
    unsafeCoerce WasmTypeTag 'I64
    TagI64

    wasmWordCmmTypeM :: WasmCodeGenM w CmmType
    wasmWordCmmTypeM :: forall (w :: WasmType). WasmCodeGenM w CmmType
    wasmWordCmmTypeM = (WasmCodeGenState w -> CmmType) -> WasmCodeGenM w CmmType
    forall (w :: WasmType) a.
    (WasmCodeGenState w -> a) -> WasmCodeGenM w a
    wasmGetsM (Platform -> CmmType
    bWord (Platform -> CmmType)
    -> (WasmCodeGenState w -> Platform)
    -> WasmCodeGenState w
    -> CmmType
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . WasmCodeGenState w -> Platform
    forall (w :: WasmType). WasmCodeGenState w -> Platform
    wasmPlatform)

    wasmStateM ::
      (WasmCodeGenState w -> (# a, WasmCodeGenState w #)) ->
      WasmCodeGenM w a
    wasmStateM :: forall (w :: WasmType) a.
    (WasmCodeGenState w -> (# a, WasmCodeGenState w #))
    -> WasmCodeGenM w a
    wasmStateM = State (WasmCodeGenState w) a -> WasmCodeGenM w a
    forall a b. Coercible a b => a -> b
    coerce (State (WasmCodeGenState w) a -> WasmCodeGenM w a)
    -> ((WasmCodeGenState w -> (# a, WasmCodeGenState w #))
        -> State (WasmCodeGenState w) a)
    -> (WasmCodeGenState w -> (# a, WasmCodeGenState w #))
    -> WasmCodeGenM w a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (WasmCodeGenState w -> (# a, WasmCodeGenState w #))
    -> State (WasmCodeGenState w) a
    forall s a. (s -> (# a, s #)) -> State s a
    State

    wasmModifyM :: (WasmCodeGenState w -> WasmCodeGenState w) -> WasmCodeGenM w ()
    wasmModifyM :: forall (w :: WasmType).
    (WasmCodeGenState w -> WasmCodeGenState w) -> WasmCodeGenM w ()
    wasmModifyM = State (WasmCodeGenState w) () -> WasmCodeGenM w ()
    forall a b. Coercible a b => a -> b
    coerce (State (WasmCodeGenState w) () -> WasmCodeGenM w ())
    -> ((WasmCodeGenState w -> WasmCodeGenState w)
        -> State (WasmCodeGenState w) ())
    -> (WasmCodeGenState w -> WasmCodeGenState w)
    -> WasmCodeGenM w ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (WasmCodeGenState w -> WasmCodeGenState w)
    -> State (WasmCodeGenState w) ()
    forall s. (s -> s) -> State s ()
    modify

    wasmEvalM :: WasmCodeGenM w a -> WasmCodeGenState w -> a
    wasmEvalM :: forall (w :: WasmType) a.
    WasmCodeGenM w a -> WasmCodeGenState w -> a
    wasmEvalM (WasmCodeGenM State (WasmCodeGenState w) a
    s) = State (WasmCodeGenState w) a -> WasmCodeGenState w -> a
    forall s a. State s a -> s -> a
    evalState State (WasmCodeGenState w) a
    s

    wasmExecM :: WasmCodeGenM w a -> WasmCodeGenState w -> WasmCodeGenState w
    wasmExecM :: forall (w :: WasmType) a.
    WasmCodeGenM w a -> WasmCodeGenState w -> WasmCodeGenState w
    wasmExecM (WasmCodeGenM State (WasmCodeGenState w) a
    s) = State (WasmCodeGenState w) a
    -> WasmCodeGenState w -> WasmCodeGenState w
    forall s a. State s a -> s -> s
    execState State (WasmCodeGenState w) a
    s

    instance MonadUnique (WasmCodeGenM w) where
      getUniqueSupplyM :: WasmCodeGenM w UniqSupply
    getUniqueSupplyM = (WasmCodeGenState w -> UniqSupply) -> WasmCodeGenM w UniqSupply
    forall (w :: WasmType) a.
    (WasmCodeGenState w -> a) -> WasmCodeGenM w a
    wasmGetsM WasmCodeGenState w -> UniqSupply
    forall (w :: WasmType). WasmCodeGenState w -> UniqSupply
    wasmUniqSupply
      getUniqueM :: WasmCodeGenM w Unique
    getUniqueM = (WasmCodeGenState w -> (# Unique, WasmCodeGenState w #))
    -> WasmCodeGenM w Unique
    forall (w :: WasmType) a.
    (WasmCodeGenState w -> (# a, WasmCodeGenState w #))
    -> WasmCodeGenM w a
    wasmStateM ((WasmCodeGenState w -> (# Unique, WasmCodeGenState w #))
     -> WasmCodeGenM w Unique)
    -> (WasmCodeGenState w -> (# Unique, WasmCodeGenState w #))
    -> WasmCodeGenM w Unique
    forall a b. (a -> b) -> a -> b
    $
        \s :: WasmCodeGenState w
    s@WasmCodeGenState {Int
    [SymName]
    SymSet
    UniqFM LocalReg LocalInfo
    UniqSupply
    SymMap ([SomeWasmType], [SomeWasmType])
    SymMap (FuncBody w)
    SymMap DataSection
    Platform
    wasmPlatform :: forall (w :: WasmType). WasmCodeGenState w -> Platform
    defaultSyms :: forall (w :: WasmType). WasmCodeGenState w -> SymSet
    funcTypes :: forall (w :: WasmType).
    WasmCodeGenState w -> SymMap ([SomeWasmType], [SomeWasmType])
    funcBodies :: forall (w :: WasmType). WasmCodeGenState w -> SymMap (FuncBody w)
    dataSections :: forall (w :: WasmType). WasmCodeGenState w -> SymMap DataSection
    ctors :: forall (w :: WasmType). WasmCodeGenState w -> [SymName]
    localRegs :: forall (w :: WasmType).
    WasmCodeGenState w -> UniqFM LocalReg LocalInfo
    localRegsCount :: forall (w :: WasmType). WasmCodeGenState w -> Int
    wasmUniqSupply :: forall (w :: WasmType). WasmCodeGenState w -> UniqSupply
    wasmPlatform :: Platform
    defaultSyms :: SymSet
    funcTypes :: SymMap ([SomeWasmType], [SomeWasmType])
    funcBodies :: SymMap (FuncBody w)
    dataSections :: SymMap DataSection
    ctors :: [SymName]
    localRegs :: UniqFM LocalReg LocalInfo
    localRegsCount :: Int
    wasmUniqSupply :: UniqSupply
    ..} -> case UniqSupply -> (Unique, UniqSupply)
    takeUniqFromSupply UniqSupply
    wasmUniqSupply of
          (Unique
    u, UniqSupply
    us) -> (# Unique
    u, WasmCodeGenState w
    s {wasmUniqSupply = us} #)
      getUniquesM :: WasmCodeGenM w [Unique]
    getUniquesM = do
        u <- WasmCodeGenM w Unique
    forall (m :: * -> *). MonadUnique m => m Unique
    getUniqueM
        s <- WasmCodeGenM get
        pure $ u:(wasmEvalM getUniquesM s)