{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE Strict #-}

module GHC.CmmToAsm.Wasm.Asm (asmTellEverything, execWasmAsmM) where

import Control.Monad
import Control.Monad.Trans.Reader
import Data.ByteString (ByteString)
import qualified Data.ByteString as BS
import Data.ByteString.Builder
import qualified Data.ByteString.Char8 as BS8
import Data.Coerce
import Data.Foldable
import Data.Maybe
import Data.Semigroup
import GHC.Cmm
import GHC.CmmToAsm.Ppr
import GHC.CmmToAsm.Wasm.FromCmm
import GHC.CmmToAsm.Wasm.Types
import GHC.CmmToAsm.Wasm.Utils
import GHC.Data.FastString
import GHC.Float
import GHC.Prelude
import GHC.Settings.Config (cProjectVersion)
import GHC.Types.Basic
import GHC.Types.Unique
import GHC.Types.Unique.Map
import GHC.Types.Unique.Set
import GHC.Utils.Monad.State.Strict
import GHC.Utils.Outputable hiding ((<>))
import GHC.Utils.Panic (panic)

-- | Reads current indentation, appends result to state
newtype WasmAsmM a = WasmAsmM (WasmAsmConfig -> Builder -> State Builder a)
  deriving
    ( (forall a b. (a -> b) -> WasmAsmM a -> WasmAsmM b)
-> (forall a b. a -> WasmAsmM b -> WasmAsmM a) -> Functor WasmAsmM
forall a b. a -> WasmAsmM b -> WasmAsmM a
forall a b. (a -> b) -> WasmAsmM a -> WasmAsmM b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> WasmAsmM a -> WasmAsmM b
fmap :: forall a b. (a -> b) -> WasmAsmM a -> WasmAsmM b
$c<$ :: forall a b. a -> WasmAsmM b -> WasmAsmM a
<$ :: forall a b. a -> WasmAsmM b -> WasmAsmM a
Functor,
      Functor WasmAsmM
Functor WasmAsmM =>
(forall a. a -> WasmAsmM a)
-> (forall a b. WasmAsmM (a -> b) -> WasmAsmM a -> WasmAsmM b)
-> (forall a b c.
    (a -> b -> c) -> WasmAsmM a -> WasmAsmM b -> WasmAsmM c)
-> (forall a b. WasmAsmM a -> WasmAsmM b -> WasmAsmM b)
-> (forall a b. WasmAsmM a -> WasmAsmM b -> WasmAsmM a)
-> Applicative WasmAsmM
forall a. a -> WasmAsmM a
forall a b. WasmAsmM a -> WasmAsmM b -> WasmAsmM a
forall a b. WasmAsmM a -> WasmAsmM b -> WasmAsmM b
forall a b. WasmAsmM (a -> b) -> WasmAsmM a -> WasmAsmM b
forall a b c.
(a -> b -> c) -> WasmAsmM a -> WasmAsmM b -> WasmAsmM 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 a. a -> WasmAsmM a
pure :: forall a. a -> WasmAsmM a
$c<*> :: forall a b. WasmAsmM (a -> b) -> WasmAsmM a -> WasmAsmM b
<*> :: forall a b. WasmAsmM (a -> b) -> WasmAsmM a -> WasmAsmM b
$cliftA2 :: forall a b c.
(a -> b -> c) -> WasmAsmM a -> WasmAsmM b -> WasmAsmM c
liftA2 :: forall a b c.
(a -> b -> c) -> WasmAsmM a -> WasmAsmM b -> WasmAsmM c
$c*> :: forall a b. WasmAsmM a -> WasmAsmM b -> WasmAsmM b
*> :: forall a b. WasmAsmM a -> WasmAsmM b -> WasmAsmM b
$c<* :: forall a b. WasmAsmM a -> WasmAsmM b -> WasmAsmM a
<* :: forall a b. WasmAsmM a -> WasmAsmM b -> WasmAsmM a
Applicative,
      Applicative WasmAsmM
Applicative WasmAsmM =>
(forall a b. WasmAsmM a -> (a -> WasmAsmM b) -> WasmAsmM b)
-> (forall a b. WasmAsmM a -> WasmAsmM b -> WasmAsmM b)
-> (forall a. a -> WasmAsmM a)
-> Monad WasmAsmM
forall a. a -> WasmAsmM a
forall a b. WasmAsmM a -> WasmAsmM b -> WasmAsmM b
forall a b. WasmAsmM a -> (a -> WasmAsmM b) -> WasmAsmM 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 a b. WasmAsmM a -> (a -> WasmAsmM b) -> WasmAsmM b
>>= :: forall a b. WasmAsmM a -> (a -> WasmAsmM b) -> WasmAsmM b
$c>> :: forall a b. WasmAsmM a -> WasmAsmM b -> WasmAsmM b
>> :: forall a b. WasmAsmM a -> WasmAsmM b -> WasmAsmM b
$creturn :: forall a. a -> WasmAsmM a
return :: forall a. a -> WasmAsmM a
Monad
    )
    via (ReaderT WasmAsmConfig (ReaderT Builder (State Builder)))

instance Semigroup a => Semigroup (WasmAsmM a) where
  <> :: WasmAsmM a -> WasmAsmM a -> WasmAsmM a
(<>) = (a -> a -> a) -> WasmAsmM a -> WasmAsmM a -> WasmAsmM a
forall a b c.
(a -> b -> c) -> WasmAsmM a -> WasmAsmM b -> WasmAsmM c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 a -> a -> a
forall a. Semigroup a => a -> a -> a
(<>)

instance Monoid a => Monoid (WasmAsmM a) where
  mempty :: WasmAsmM a
mempty = a -> WasmAsmM a
forall a. a -> WasmAsmM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
forall a. Monoid a => a
mempty

getConf :: WasmAsmM WasmAsmConfig
getConf :: WasmAsmM WasmAsmConfig
getConf = (WasmAsmConfig -> Builder -> State Builder WasmAsmConfig)
-> WasmAsmM WasmAsmConfig
forall a.
(WasmAsmConfig -> Builder -> State Builder a) -> WasmAsmM a
WasmAsmM ((WasmAsmConfig -> Builder -> State Builder WasmAsmConfig)
 -> WasmAsmM WasmAsmConfig)
-> (WasmAsmConfig -> Builder -> State Builder WasmAsmConfig)
-> WasmAsmM WasmAsmConfig
forall a b. (a -> b) -> a -> b
$ \WasmAsmConfig
conf Builder
_ -> WasmAsmConfig -> State Builder WasmAsmConfig
forall a. a -> State Builder a
forall (f :: * -> *) a. Applicative f => a -> f a
pure WasmAsmConfig
conf

-- | Default indent level is none
execWasmAsmM :: WasmAsmConfig -> WasmAsmM a -> Builder
execWasmAsmM :: forall a. WasmAsmConfig -> WasmAsmM a -> Builder
execWasmAsmM WasmAsmConfig
conf (WasmAsmM WasmAsmConfig -> Builder -> State Builder a
m) =
  State Builder a -> Builder -> Builder
forall s a. State s a -> s -> s
execState (WasmAsmConfig -> Builder -> State Builder a
m WasmAsmConfig
conf Builder
forall a. Monoid a => a
mempty) Builder
forall a. Monoid a => a
mempty

-- | Increase indent level by a tab
asmWithTab :: WasmAsmM a -> WasmAsmM a
asmWithTab :: forall a. WasmAsmM a -> WasmAsmM a
asmWithTab (WasmAsmM WasmAsmConfig -> Builder -> State Builder a
m) =
  (WasmAsmConfig -> Builder -> State Builder a) -> WasmAsmM a
forall a.
(WasmAsmConfig -> Builder -> State Builder a) -> WasmAsmM a
WasmAsmM ((WasmAsmConfig -> Builder -> State Builder a) -> WasmAsmM a)
-> (WasmAsmConfig -> Builder -> State Builder a) -> WasmAsmM a
forall a b. (a -> b) -> a -> b
$ \WasmAsmConfig
conf Builder
t -> WasmAsmConfig -> Builder -> State Builder a
m WasmAsmConfig
conf (Builder -> State Builder a) -> Builder -> State Builder a
forall a b. (a -> b) -> a -> b
$! Char -> Builder
char7 Char
'\t' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
t

-- | Writes a single line starting with the current indent
asmTellLine :: Builder -> WasmAsmM ()
asmTellLine :: Builder -> WasmAsmM ()
asmTellLine Builder
b = (WasmAsmConfig -> Builder -> State Builder ()) -> WasmAsmM ()
forall a.
(WasmAsmConfig -> Builder -> State Builder a) -> WasmAsmM a
WasmAsmM ((WasmAsmConfig -> Builder -> State Builder ()) -> WasmAsmM ())
-> (WasmAsmConfig -> Builder -> State Builder ()) -> WasmAsmM ()
forall a b. (a -> b) -> a -> b
$ \WasmAsmConfig
_ Builder
t -> (Builder -> Builder) -> State Builder ()
forall s. (s -> s) -> State s ()
modify ((Builder -> Builder) -> State Builder ())
-> (Builder -> Builder) -> State Builder ()
forall a b. (a -> b) -> a -> b
$ \Builder
acc -> Builder
acc Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
t Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
b Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
char7 Char
'\n'

-- | Writes a single line break
asmTellLF :: WasmAsmM ()
asmTellLF :: WasmAsmM ()
asmTellLF = (WasmAsmConfig -> Builder -> State Builder ()) -> WasmAsmM ()
forall a.
(WasmAsmConfig -> Builder -> State Builder a) -> WasmAsmM a
WasmAsmM ((WasmAsmConfig -> Builder -> State Builder ()) -> WasmAsmM ())
-> (WasmAsmConfig -> Builder -> State Builder ()) -> WasmAsmM ()
forall a b. (a -> b) -> a -> b
$ \WasmAsmConfig
_ Builder
_ -> (Builder -> Builder) -> State Builder ()
forall s. (s -> s) -> State s ()
modify ((Builder -> Builder) -> State Builder ())
-> (Builder -> Builder) -> State Builder ()
forall a b. (a -> b) -> a -> b
$ \Builder
acc -> Builder
acc Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
char7 Char
'\n'

-- | Writes a line starting with a single tab, ignoring current indent
-- level
asmTellTabLine :: Builder -> WasmAsmM ()
asmTellTabLine :: Builder -> WasmAsmM ()
asmTellTabLine Builder
b =
  (WasmAsmConfig -> Builder -> State Builder ()) -> WasmAsmM ()
forall a.
(WasmAsmConfig -> Builder -> State Builder a) -> WasmAsmM a
WasmAsmM ((WasmAsmConfig -> Builder -> State Builder ()) -> WasmAsmM ())
-> (WasmAsmConfig -> Builder -> State Builder ()) -> WasmAsmM ()
forall a b. (a -> b) -> a -> b
$ \WasmAsmConfig
_ Builder
_ -> (Builder -> Builder) -> State Builder ()
forall s. (s -> s) -> State s ()
modify ((Builder -> Builder) -> State Builder ())
-> (Builder -> Builder) -> State Builder ()
forall a b. (a -> b) -> a -> b
$ \Builder
acc -> Builder
acc Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
char7 Char
'\t' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
b Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
char7 Char
'\n'

asmFromWasmType :: WasmTypeTag t -> Builder
asmFromWasmType :: forall (t :: WasmType). WasmTypeTag t -> Builder
asmFromWasmType WasmTypeTag t
ty = case WasmTypeTag t
ty of
  WasmTypeTag t
TagI32 -> Builder
"i32"
  WasmTypeTag t
TagI64 -> Builder
"i64"
  WasmTypeTag t
TagF32 -> Builder
"f32"
  WasmTypeTag t
TagF64 -> Builder
"f64"

asmFromSomeWasmType :: SomeWasmType -> Builder
asmFromSomeWasmType :: SomeWasmType -> Builder
asmFromSomeWasmType (SomeWasmType WasmTypeTag t
t) = WasmTypeTag t -> Builder
forall (t :: WasmType). WasmTypeTag t -> Builder
asmFromWasmType WasmTypeTag t
t

asmFromSomeWasmTypes :: [SomeWasmType] -> Builder
asmFromSomeWasmTypes :: [SomeWasmType] -> Builder
asmFromSomeWasmTypes [SomeWasmType]
ts = Builder
"(" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> (SomeWasmType -> Builder) -> [SomeWasmType] -> Builder
forall a. (a -> Builder) -> [a] -> Builder
builderCommas SomeWasmType -> Builder
asmFromSomeWasmType [SomeWasmType]
ts Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
")"

asmFromFuncType :: [SomeWasmType] -> [SomeWasmType] -> Builder
asmFromFuncType :: [SomeWasmType] -> [SomeWasmType] -> Builder
asmFromFuncType [SomeWasmType]
arg_tys [SomeWasmType]
ret_tys =
  [SomeWasmType] -> Builder
asmFromSomeWasmTypes [SomeWasmType]
arg_tys Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
" -> " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> [SomeWasmType] -> Builder
asmFromSomeWasmTypes [SomeWasmType]
ret_tys

asmTellFuncType ::
  SymName -> ([SomeWasmType], [SomeWasmType]) -> WasmAsmM ()
asmTellFuncType :: SymName -> ([SomeWasmType], [SomeWasmType]) -> WasmAsmM ()
asmTellFuncType SymName
sym ([SomeWasmType]
arg_tys, [SomeWasmType]
ret_tys) =
  Builder -> WasmAsmM ()
asmTellTabLine (Builder -> WasmAsmM ()) -> Builder -> WasmAsmM ()
forall a b. (a -> b) -> a -> b
$
    Builder
".functype "
      Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> SymName -> Builder
asmFromSymName SymName
sym
      Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
" "
      Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> [SomeWasmType] -> [SomeWasmType] -> Builder
asmFromFuncType [SomeWasmType]
arg_tys [SomeWasmType]
ret_tys

asmTellLocals :: [SomeWasmType] -> WasmAsmM ()
asmTellLocals :: [SomeWasmType] -> WasmAsmM ()
asmTellLocals [] = WasmAsmM ()
forall a. Monoid a => a
mempty
asmTellLocals [SomeWasmType]
local_tys =
  Builder -> WasmAsmM ()
asmTellTabLine (Builder -> WasmAsmM ()) -> Builder -> WasmAsmM ()
forall a b. (a -> b) -> a -> b
$ Builder
".local " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> (SomeWasmType -> Builder) -> [SomeWasmType] -> Builder
forall a. (a -> Builder) -> [a] -> Builder
builderCommas SomeWasmType -> Builder
asmFromSomeWasmType [SomeWasmType]
local_tys

asmFromSymName :: SymName -> Builder
asmFromSymName :: SymName -> Builder
asmFromSymName = ShortByteString -> Builder
shortByteString (ShortByteString -> Builder)
-> (SymName -> ShortByteString) -> SymName -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FastString -> ShortByteString) -> SymName -> ShortByteString
forall a b. Coercible a b => a -> b
coerce FastString -> ShortByteString
fastStringToShortByteString

asmTellDefSym :: SymName -> WasmAsmM ()
asmTellDefSym :: SymName -> WasmAsmM ()
asmTellDefSym SymName
sym = do
  WasmAsmConfig {..} <- WasmAsmM WasmAsmConfig
getConf
  unless pic $ asmTellTabLine $ ".hidden " <> asm_sym
  asmTellTabLine $ ".globl " <> asm_sym
  where
    asm_sym :: Builder
asm_sym = SymName -> Builder
asmFromSymName SymName
sym

asmTellDataSectionContent :: WasmTypeTag w -> DataSectionContent -> WasmAsmM ()
asmTellDataSectionContent :: forall (w :: WasmType).
WasmTypeTag w -> DataSectionContent -> WasmAsmM ()
asmTellDataSectionContent WasmTypeTag w
ty_word DataSectionContent
c = Builder -> WasmAsmM ()
asmTellTabLine (Builder -> WasmAsmM ()) -> Builder -> WasmAsmM ()
forall a b. (a -> b) -> a -> b
$ case DataSectionContent
c of
  DataI8 Word8
i -> Builder
".int8 0x" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Word8 -> Builder
word8Hex Word8
i
  DataI16 Word16
i -> Builder
".int16 0x" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Word16 -> Builder
word16Hex Word16
i
  DataI32 Word32
i -> Builder
".int32 0x" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Word32 -> Builder
word32Hex Word32
i
  DataI64 Word64
i -> Builder
".int64 0x" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Word64 -> Builder
word64Hex Word64
i
  DataF32 Float
f -> Builder
".int32 0x" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Word32 -> Builder
word32Hex (Float -> Word32
castFloatToWord32 Float
f)
  DataF64 Double
d -> Builder
".int64 0x" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Word64 -> Builder
word64Hex (Double -> Word64
castDoubleToWord64 Double
d)
  DataSym SymName
sym Int
o ->
    ( case WasmTypeTag w
ty_word of
        WasmTypeTag w
TagI32 -> Builder
".int32 "
        WasmTypeTag w
TagI64 -> Builder
".int64 "
        WasmTypeTag w
_ -> String -> Builder
forall a. HasCallStack => String -> a
panic String
"asmTellDataSectionContent: unreachable"
    )
      Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> SymName -> Builder
asmFromSymName SymName
sym
      Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ( case Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
o Int
0 of
             Ordering
EQ -> Builder
forall a. Monoid a => a
mempty
             Ordering
GT -> Builder
"+" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Builder
intDec Int
o
             Ordering
LT -> String -> Builder
forall a. HasCallStack => String -> a
panic String
"asmTellDataSectionContent: negative offset"
         )
  DataSkip Int
i -> Builder
".skip " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Builder
intDec Int
i
  DataASCII ByteString
s
    | Bool -> Bool
not (ByteString -> Bool
BS.null ByteString
s) Bool -> Bool -> Bool
&& HasCallStack => ByteString -> Word8
ByteString -> Word8
BS.last ByteString
s Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0 ->
        Builder
".asciz \""
          Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> String -> Builder
string7
            (SDocContext -> SDoc -> String
showSDocOneLine SDocContext
defaultSDocContext (SDoc -> String) -> SDoc -> String
forall a b. (a -> b) -> a -> b
$ ByteString -> SDoc
forall doc. IsLine doc => ByteString -> doc
pprASCII (ByteString -> SDoc) -> ByteString -> SDoc
forall a b. (a -> b) -> a -> b
$ HasCallStack => ByteString -> ByteString
ByteString -> ByteString
BS.init ByteString
s)
          Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"\""
    | Bool
otherwise ->
        Builder
".ascii \""
          Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> String -> Builder
string7
            (SDocContext -> SDoc -> String
showSDocOneLine SDocContext
defaultSDocContext (SDoc -> String) -> SDoc -> String
forall a b. (a -> b) -> a -> b
$ ByteString -> SDoc
forall doc. IsLine doc => ByteString -> doc
pprASCII ByteString
s)
          Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"\""
  DataIncBin String
f Int
_ ->
    Builder
".incbin "
      Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> String -> Builder
string7
        (SDocContext -> SDoc -> String
showSDocOneLine SDocContext
defaultSDocContext (SDoc -> String) -> SDoc -> String
forall a b. (a -> b) -> a -> b
$ String -> SDoc
forall doc. IsLine doc => String -> doc
pprFilePathString String
f)

dataSectionContentSize :: WasmTypeTag w -> DataSectionContent -> Int
dataSectionContentSize :: forall (w :: WasmType). WasmTypeTag w -> DataSectionContent -> Int
dataSectionContentSize WasmTypeTag w
ty_word DataSectionContent
c = case DataSectionContent
c of
  DataI8 {} -> Int
1
  DataI16 {} -> Int
2
  DataI32 {} -> Int
4
  DataI64 {} -> Int
8
  DataF32 {} -> Int
4
  DataF64 {} -> Int
8
  DataSym {} -> Alignment -> Int
alignmentBytes (Alignment -> Int) -> Alignment -> Int
forall a b. (a -> b) -> a -> b
$ WasmTypeTag w -> Alignment
forall (w :: WasmType). WasmTypeTag w -> Alignment
alignmentFromWordType WasmTypeTag w
ty_word
  DataSkip Int
i -> Int
i
  DataASCII ByteString
s -> ByteString -> Int
BS.length ByteString
s
  DataIncBin String
_ Int
l -> Int
l

dataSectionSize :: WasmTypeTag w -> [DataSectionContent] -> Int
dataSectionSize :: forall (w :: WasmType).
WasmTypeTag w -> [DataSectionContent] -> Int
dataSectionSize WasmTypeTag w
ty_word =
  Sum Int -> Int
forall a b. Coercible a b => a -> b
coerce
    (Sum Int -> Int)
-> ([DataSectionContent] -> Sum Int) -> [DataSectionContent] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DataSectionContent -> Sum Int) -> [DataSectionContent] -> Sum Int
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap'
      (Int -> Sum Int
forall a. a -> Sum a
Sum (Int -> Sum Int)
-> (DataSectionContent -> Int) -> DataSectionContent -> Sum Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WasmTypeTag w -> DataSectionContent -> Int
forall (w :: WasmType). WasmTypeTag w -> DataSectionContent -> Int
dataSectionContentSize WasmTypeTag w
ty_word)

asmTellAlign :: Alignment -> WasmAsmM ()
asmTellAlign :: Alignment -> WasmAsmM ()
asmTellAlign Alignment
a = case Alignment -> Int
alignmentBytes Alignment
a of
  Int
1 -> WasmAsmM ()
forall a. Monoid a => a
mempty
  Int
i -> Builder -> WasmAsmM ()
asmTellTabLine (Builder -> WasmAsmM ()) -> Builder -> WasmAsmM ()
forall a b. (a -> b) -> a -> b
$ Builder
".p2align " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Builder
intDec (Int -> Int
forall b. FiniteBits b => b -> Int
countTrailingZeros Int
i)

asmTellSectionHeader :: Builder -> WasmAsmM ()
asmTellSectionHeader :: Builder -> WasmAsmM ()
asmTellSectionHeader Builder
k = Builder -> WasmAsmM ()
asmTellTabLine (Builder -> WasmAsmM ()) -> Builder -> WasmAsmM ()
forall a b. (a -> b) -> a -> b
$ Builder
".section " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
k Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
",\"\",@"

asmTellDataSection ::
  WasmTypeTag w -> UniqueSet -> SymName -> DataSection -> WasmAsmM ()
asmTellDataSection :: forall (w :: WasmType).
WasmTypeTag w -> SymSet -> SymName -> DataSection -> WasmAsmM ()
asmTellDataSection WasmTypeTag w
ty_word SymSet
def_syms SymName
sym DataSection {[DataSectionContent]
Alignment
DataSectionKind
dataSectionKind :: DataSectionKind
dataSectionAlignment :: Alignment
dataSectionContents :: [DataSectionContent]
dataSectionContents :: DataSection -> [DataSectionContent]
dataSectionAlignment :: DataSection -> Alignment
dataSectionKind :: DataSection -> DataSectionKind
..} = do
  Bool -> WasmAsmM () -> WasmAsmM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (SymName -> Unique
forall a. Uniquable a => a -> Unique
getUnique SymName
sym Unique -> SymSet -> Bool
`memberUniqueSet` SymSet
def_syms) (WasmAsmM () -> WasmAsmM ()) -> WasmAsmM () -> WasmAsmM ()
forall a b. (a -> b) -> a -> b
$ SymName -> WasmAsmM ()
asmTellDefSym SymName
sym
  Builder -> WasmAsmM ()
asmTellSectionHeader Builder
sec_name
  Alignment -> WasmAsmM ()
asmTellAlign Alignment
dataSectionAlignment
  Builder -> WasmAsmM ()
asmTellTabLine Builder
asm_size
  Builder -> WasmAsmM ()
asmTellLine (Builder -> WasmAsmM ()) -> Builder -> WasmAsmM ()
forall a b. (a -> b) -> a -> b
$ Builder
asm_sym Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
":"
  [DataSectionContent]
-> (DataSectionContent -> WasmAsmM ()) -> WasmAsmM ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [DataSectionContent]
dataSectionContents ((DataSectionContent -> WasmAsmM ()) -> WasmAsmM ())
-> (DataSectionContent -> WasmAsmM ()) -> WasmAsmM ()
forall a b. (a -> b) -> a -> b
$ WasmTypeTag w -> DataSectionContent -> WasmAsmM ()
forall (w :: WasmType).
WasmTypeTag w -> DataSectionContent -> WasmAsmM ()
asmTellDataSectionContent WasmTypeTag w
ty_word
  WasmAsmM ()
asmTellLF
  where
    asm_sym :: Builder
asm_sym = SymName -> Builder
asmFromSymName SymName
sym

    sec_name :: Builder
sec_name =
      ( case DataSectionKind
dataSectionKind of
          DataSectionKind
SectionData -> Builder
".data."
          DataSectionKind
SectionROData -> Builder
".rodata."
      )
        Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
asm_sym

    asm_size :: Builder
asm_size =
      Builder
".size "
        Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
asm_sym
        Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
", "
        Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Builder
intDec
          (WasmTypeTag w -> [DataSectionContent] -> Int
forall (w :: WasmType).
WasmTypeTag w -> [DataSectionContent] -> Int
dataSectionSize WasmTypeTag w
ty_word [DataSectionContent]
dataSectionContents)

asmFromWasmBlockType :: WasmTypeTag w -> WasmFunctionType pre post -> Builder
asmFromWasmBlockType :: forall (w :: WasmType) (pre :: [WasmType]) (post :: [WasmType]).
WasmTypeTag w -> WasmFunctionType pre post -> Builder
asmFromWasmBlockType
  WasmTypeTag w
_
  (WasmFunctionType {ft_pops :: forall (pre :: [WasmType]) (post :: [WasmType]).
WasmFunctionType pre post -> TypeList pre
ft_pops = TypeList pre
TypeListNil, ft_pushes :: forall (pre :: [WasmType]) (post :: [WasmType]).
WasmFunctionType pre post -> TypeList post
ft_pushes = TypeList post
TypeListNil}) =
    Builder
forall a. Monoid a => a
mempty
asmFromWasmBlockType
  WasmTypeTag w
TagI32
  ( WasmFunctionType
      { ft_pops :: forall (pre :: [WasmType]) (post :: [WasmType]).
WasmFunctionType pre post -> TypeList pre
ft_pops = TypeList pre
TypeListNil,
        ft_pushes :: forall (pre :: [WasmType]) (post :: [WasmType]).
WasmFunctionType pre post -> TypeList post
ft_pushes = TypeListCons WasmTypeTag t
TagI32 TypeList ts
TypeListNil
      }
    ) =
    Builder
" i32"
asmFromWasmBlockType
  WasmTypeTag w
TagI64
  ( WasmFunctionType
      { ft_pops :: forall (pre :: [WasmType]) (post :: [WasmType]).
WasmFunctionType pre post -> TypeList pre
ft_pops = TypeList pre
TypeListNil,
        ft_pushes :: forall (pre :: [WasmType]) (post :: [WasmType]).
WasmFunctionType pre post -> TypeList post
ft_pushes = TypeListCons WasmTypeTag t
TagI64 TypeList ts
TypeListNil
      }
    ) =
    Builder
" i64"
asmFromWasmBlockType WasmTypeTag w
_ WasmFunctionType pre post
_ = String -> Builder
forall a. HasCallStack => String -> a
panic String
"asmFromWasmBlockType: invalid block type"

asmFromAlignmentSpec :: AlignmentSpec -> Builder
asmFromAlignmentSpec :: AlignmentSpec -> Builder
asmFromAlignmentSpec AlignmentSpec
NaturallyAligned = Builder
forall a. Monoid a => a
mempty
asmFromAlignmentSpec AlignmentSpec
Unaligned = Builder
":p2align=0"

asmTellWasmInstr :: WasmTypeTag w -> WasmInstr w pre post -> WasmAsmM ()
asmTellWasmInstr :: forall (w :: WasmType) (pre :: [WasmType]) (post :: [WasmType]).
WasmTypeTag w -> WasmInstr w pre post -> WasmAsmM ()
asmTellWasmInstr WasmTypeTag w
ty_word WasmInstr w pre post
instr = case WasmInstr w pre post
instr of
  WasmComment String
c -> Builder -> WasmAsmM ()
asmTellLine (Builder -> WasmAsmM ()) -> Builder -> WasmAsmM ()
forall a b. (a -> b) -> a -> b
$ String -> Builder
stringUtf8 (String -> Builder) -> String -> Builder
forall a b. (a -> b) -> a -> b
$ String
"# " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
c
  WasmInstr w pre post
WasmNop -> WasmAsmM ()
forall a. Monoid a => a
mempty
  WasmInstr w pre post
WasmDrop -> Builder -> WasmAsmM ()
asmTellLine Builder
"drop"
  WasmInstr w pre post
WasmUnreachable -> Builder -> WasmAsmM ()
asmTellLine Builder
"unreachable"
  WasmConst WasmTypeTag t
TagI32 Integer
i -> Builder -> WasmAsmM ()
asmTellLine (Builder -> WasmAsmM ()) -> Builder -> WasmAsmM ()
forall a b. (a -> b) -> a -> b
$ Builder
"i32.const " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Integer -> Builder
integerDec Integer
i
  WasmConst WasmTypeTag t
TagI64 Integer
i -> Builder -> WasmAsmM ()
asmTellLine (Builder -> WasmAsmM ()) -> Builder -> WasmAsmM ()
forall a b. (a -> b) -> a -> b
$ Builder
"i64.const " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Integer -> Builder
integerDec Integer
i
  WasmConst {} -> String -> WasmAsmM ()
forall a. HasCallStack => String -> a
panic String
"asmTellWasmInstr: unreachable"
  WasmSymConst SymName
sym -> do
    WasmAsmConfig {..} <- WasmAsmM WasmAsmConfig
getConf
    let
      asm_sym = SymName -> Builder
asmFromSymName SymName
sym
      (ty_const, ty_add) = case ty_word of
        WasmTypeTag w
TagI32 -> (Builder
"i32.const ", Builder
"i32.add")
        WasmTypeTag w
TagI64 -> (Builder
"i64.const ", Builder
"i64.add")
        WasmTypeTag w
_ -> String -> (Builder, Builder)
forall a. HasCallStack => String -> a
panic String
"asmTellWasmInstr: invalid word type"
    traverse_ asmTellLine $ if
      | pic, getUnique sym `memberUniqueSet` mbrelSyms -> [
          "global.get __memory_base",
          ty_const <> asm_sym <> "@MBREL",
          ty_add
        ]
      | pic, getUnique sym `memberUniqueSet` tbrelSyms -> [
          "global.get __table_base",
          ty_const <> asm_sym <> "@TBREL",
          ty_add
        ]
      | pic -> [ "global.get " <> asm_sym <> "@GOT" ]
      | otherwise -> [ ty_const <> asm_sym ]
  WasmLoad WasmTypeTag t
ty (Just Int
w) Signage
s Int
o AlignmentSpec
align ->
    Builder -> WasmAsmM ()
asmTellLine (Builder -> WasmAsmM ()) -> Builder -> WasmAsmM ()
forall a b. (a -> b) -> a -> b
$
      WasmTypeTag t -> Builder
forall (t :: WasmType). WasmTypeTag t -> Builder
asmFromWasmType WasmTypeTag t
ty
        Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
".load"
        Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Builder
intDec Int
w
        Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ( case Signage
s of
               Signage
Signed -> Builder
"_s"
               Signage
Unsigned -> Builder
"_u"
           )
        Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
" "
        Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Builder
intDec Int
o
        Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> AlignmentSpec -> Builder
asmFromAlignmentSpec AlignmentSpec
align
  WasmLoad WasmTypeTag t
ty Maybe Int
Nothing Signage
_ Int
o AlignmentSpec
align ->
    Builder -> WasmAsmM ()
asmTellLine (Builder -> WasmAsmM ()) -> Builder -> WasmAsmM ()
forall a b. (a -> b) -> a -> b
$
      WasmTypeTag t -> Builder
forall (t :: WasmType). WasmTypeTag t -> Builder
asmFromWasmType WasmTypeTag t
ty
        Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
".load"
        Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
" "
        Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Builder
intDec Int
o
        Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> AlignmentSpec -> Builder
asmFromAlignmentSpec AlignmentSpec
align
  WasmStore WasmTypeTag t
ty (Just Int
w) Int
o AlignmentSpec
align ->
    Builder -> WasmAsmM ()
asmTellLine (Builder -> WasmAsmM ()) -> Builder -> WasmAsmM ()
forall a b. (a -> b) -> a -> b
$
      WasmTypeTag t -> Builder
forall (t :: WasmType). WasmTypeTag t -> Builder
asmFromWasmType WasmTypeTag t
ty
        Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
".store"
        Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Builder
intDec Int
w
        Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
" "
        Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Builder
intDec Int
o
        Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> AlignmentSpec -> Builder
asmFromAlignmentSpec AlignmentSpec
align
  WasmStore WasmTypeTag t
ty Maybe Int
Nothing Int
o AlignmentSpec
align ->
    Builder -> WasmAsmM ()
asmTellLine (Builder -> WasmAsmM ()) -> Builder -> WasmAsmM ()
forall a b. (a -> b) -> a -> b
$
      WasmTypeTag t -> Builder
forall (t :: WasmType). WasmTypeTag t -> Builder
asmFromWasmType WasmTypeTag t
ty
        Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
".store"
        Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
" "
        Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Builder
intDec Int
o
        Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> AlignmentSpec -> Builder
asmFromAlignmentSpec AlignmentSpec
align
  WasmGlobalGet WasmTypeTag t
_ SymName
sym -> Builder -> WasmAsmM ()
asmTellLine (Builder -> WasmAsmM ()) -> Builder -> WasmAsmM ()
forall a b. (a -> b) -> a -> b
$ Builder
"global.get " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> SymName -> Builder
asmFromSymName SymName
sym
  WasmGlobalSet WasmTypeTag t
_ SymName
sym -> Builder -> WasmAsmM ()
asmTellLine (Builder -> WasmAsmM ()) -> Builder -> WasmAsmM ()
forall a b. (a -> b) -> a -> b
$ Builder
"global.set " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> SymName -> Builder
asmFromSymName SymName
sym
  WasmLocalGet WasmTypeTag t
_ Int
i -> Builder -> WasmAsmM ()
asmTellLine (Builder -> WasmAsmM ()) -> Builder -> WasmAsmM ()
forall a b. (a -> b) -> a -> b
$ Builder
"local.get " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Builder
intDec Int
i
  WasmLocalSet WasmTypeTag t
_ Int
i -> Builder -> WasmAsmM ()
asmTellLine (Builder -> WasmAsmM ()) -> Builder -> WasmAsmM ()
forall a b. (a -> b) -> a -> b
$ Builder
"local.set " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Builder
intDec Int
i
  WasmLocalTee WasmTypeTag t
_ Int
i -> Builder -> WasmAsmM ()
asmTellLine (Builder -> WasmAsmM ()) -> Builder -> WasmAsmM ()
forall a b. (a -> b) -> a -> b
$ Builder
"local.tee " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Builder
intDec Int
i
  WasmCCall SymName
sym -> Builder -> WasmAsmM ()
asmTellLine (Builder -> WasmAsmM ()) -> Builder -> WasmAsmM ()
forall a b. (a -> b) -> a -> b
$ Builder
"call " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> SymName -> Builder
asmFromSymName SymName
sym
  WasmCCallIndirect TypeList arg_tys
arg_tys TypeList ret_tys
ret_tys ->
    Builder -> WasmAsmM ()
asmTellLine (Builder -> WasmAsmM ()) -> Builder -> WasmAsmM ()
forall a b. (a -> b) -> a -> b
$
      Builder
"call_indirect "
        Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> [SomeWasmType] -> [SomeWasmType] -> Builder
asmFromFuncType
          (TypeList arg_tys -> [SomeWasmType]
forall (ts :: [WasmType]). TypeList ts -> [SomeWasmType]
someWasmTypesFromTypeList TypeList arg_tys
arg_tys)
          (TypeList ret_tys -> [SomeWasmType]
forall (ts :: [WasmType]). TypeList ts -> [SomeWasmType]
someWasmTypesFromTypeList TypeList ret_tys
ret_tys)
  WasmConcat WasmInstr w pre mid
instr0 WasmInstr w mid post
instr1 -> do
    WasmTypeTag w -> WasmInstr w pre mid -> WasmAsmM ()
forall (w :: WasmType) (pre :: [WasmType]) (post :: [WasmType]).
WasmTypeTag w -> WasmInstr w pre post -> WasmAsmM ()
asmTellWasmInstr WasmTypeTag w
ty_word WasmInstr w pre mid
instr0
    WasmTypeTag w -> WasmInstr w mid post -> WasmAsmM ()
forall (w :: WasmType) (pre :: [WasmType]) (post :: [WasmType]).
WasmTypeTag w -> WasmInstr w pre post -> WasmAsmM ()
asmTellWasmInstr WasmTypeTag w
ty_word WasmInstr w mid post
instr1
  WasmReinterpret WasmTypeTag t0
t0 WasmTypeTag t1
t1 ->
    Builder -> WasmAsmM ()
asmTellLine (Builder -> WasmAsmM ()) -> Builder -> WasmAsmM ()
forall a b. (a -> b) -> a -> b
$
      WasmTypeTag t1 -> Builder
forall (t :: WasmType). WasmTypeTag t -> Builder
asmFromWasmType WasmTypeTag t1
t1 Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
".reinterpret_" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> WasmTypeTag t0 -> Builder
forall (t :: WasmType). WasmTypeTag t -> Builder
asmFromWasmType WasmTypeTag t0
t0
  WasmTruncSat Signage
Signed WasmTypeTag t0
t0 WasmTypeTag t1
t1 ->
    Builder -> WasmAsmM ()
asmTellLine (Builder -> WasmAsmM ()) -> Builder -> WasmAsmM ()
forall a b. (a -> b) -> a -> b
$
      WasmTypeTag t1 -> Builder
forall (t :: WasmType). WasmTypeTag t -> Builder
asmFromWasmType WasmTypeTag t1
t1 Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
".trunc_sat_" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> WasmTypeTag t0 -> Builder
forall (t :: WasmType). WasmTypeTag t -> Builder
asmFromWasmType WasmTypeTag t0
t0 Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"_s"
  WasmTruncSat Signage
Unsigned WasmTypeTag t0
t0 WasmTypeTag t1
t1 ->
    Builder -> WasmAsmM ()
asmTellLine (Builder -> WasmAsmM ()) -> Builder -> WasmAsmM ()
forall a b. (a -> b) -> a -> b
$
      WasmTypeTag t1 -> Builder
forall (t :: WasmType). WasmTypeTag t -> Builder
asmFromWasmType WasmTypeTag t1
t1 Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
".trunc_sat_" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> WasmTypeTag t0 -> Builder
forall (t :: WasmType). WasmTypeTag t -> Builder
asmFromWasmType WasmTypeTag t0
t0 Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"_u"
  WasmConvert Signage
Signed WasmTypeTag t0
t0 WasmTypeTag t1
t1 ->
    Builder -> WasmAsmM ()
asmTellLine (Builder -> WasmAsmM ()) -> Builder -> WasmAsmM ()
forall a b. (a -> b) -> a -> b
$
      WasmTypeTag t1 -> Builder
forall (t :: WasmType). WasmTypeTag t -> Builder
asmFromWasmType WasmTypeTag t1
t1 Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
".convert_" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> WasmTypeTag t0 -> Builder
forall (t :: WasmType). WasmTypeTag t -> Builder
asmFromWasmType WasmTypeTag t0
t0 Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"_s"
  WasmConvert Signage
Unsigned WasmTypeTag t0
t0 WasmTypeTag t1
t1 ->
    Builder -> WasmAsmM ()
asmTellLine (Builder -> WasmAsmM ()) -> Builder -> WasmAsmM ()
forall a b. (a -> b) -> a -> b
$
      WasmTypeTag t1 -> Builder
forall (t :: WasmType). WasmTypeTag t -> Builder
asmFromWasmType WasmTypeTag t1
t1 Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
".convert_" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> WasmTypeTag t0 -> Builder
forall (t :: WasmType). WasmTypeTag t -> Builder
asmFromWasmType WasmTypeTag t0
t0 Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"_u"
  WasmAdd WasmTypeTag t
ty -> Builder -> WasmAsmM ()
asmTellLine (Builder -> WasmAsmM ()) -> Builder -> WasmAsmM ()
forall a b. (a -> b) -> a -> b
$ WasmTypeTag t -> Builder
forall (t :: WasmType). WasmTypeTag t -> Builder
asmFromWasmType WasmTypeTag t
ty Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
".add"
  WasmSub WasmTypeTag t
ty -> Builder -> WasmAsmM ()
asmTellLine (Builder -> WasmAsmM ()) -> Builder -> WasmAsmM ()
forall a b. (a -> b) -> a -> b
$ WasmTypeTag t -> Builder
forall (t :: WasmType). WasmTypeTag t -> Builder
asmFromWasmType WasmTypeTag t
ty Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
".sub"
  WasmMul WasmTypeTag t
ty -> Builder -> WasmAsmM ()
asmTellLine (Builder -> WasmAsmM ()) -> Builder -> WasmAsmM ()
forall a b. (a -> b) -> a -> b
$ WasmTypeTag t -> Builder
forall (t :: WasmType). WasmTypeTag t -> Builder
asmFromWasmType WasmTypeTag t
ty Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
".mul"
  WasmDiv Signage
_ WasmTypeTag t
TagF32 -> Builder -> WasmAsmM ()
asmTellLine Builder
"f32.div"
  WasmDiv Signage
_ WasmTypeTag t
TagF64 -> Builder -> WasmAsmM ()
asmTellLine Builder
"f64.div"
  WasmDiv Signage
Signed WasmTypeTag t
ty -> Builder -> WasmAsmM ()
asmTellLine (Builder -> WasmAsmM ()) -> Builder -> WasmAsmM ()
forall a b. (a -> b) -> a -> b
$ WasmTypeTag t -> Builder
forall (t :: WasmType). WasmTypeTag t -> Builder
asmFromWasmType WasmTypeTag t
ty Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
".div_s"
  WasmDiv Signage
Unsigned WasmTypeTag t
ty -> Builder -> WasmAsmM ()
asmTellLine (Builder -> WasmAsmM ()) -> Builder -> WasmAsmM ()
forall a b. (a -> b) -> a -> b
$ WasmTypeTag t -> Builder
forall (t :: WasmType). WasmTypeTag t -> Builder
asmFromWasmType WasmTypeTag t
ty Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
".div_u"
  WasmRem Signage
Signed WasmTypeTag t
ty -> Builder -> WasmAsmM ()
asmTellLine (Builder -> WasmAsmM ()) -> Builder -> WasmAsmM ()
forall a b. (a -> b) -> a -> b
$ WasmTypeTag t -> Builder
forall (t :: WasmType). WasmTypeTag t -> Builder
asmFromWasmType WasmTypeTag t
ty Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
".rem_s"
  WasmRem Signage
Unsigned WasmTypeTag t
ty -> Builder -> WasmAsmM ()
asmTellLine (Builder -> WasmAsmM ()) -> Builder -> WasmAsmM ()
forall a b. (a -> b) -> a -> b
$ WasmTypeTag t -> Builder
forall (t :: WasmType). WasmTypeTag t -> Builder
asmFromWasmType WasmTypeTag t
ty Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
".rem_u"
  WasmAnd WasmTypeTag t
ty -> Builder -> WasmAsmM ()
asmTellLine (Builder -> WasmAsmM ()) -> Builder -> WasmAsmM ()
forall a b. (a -> b) -> a -> b
$ WasmTypeTag t -> Builder
forall (t :: WasmType). WasmTypeTag t -> Builder
asmFromWasmType WasmTypeTag t
ty Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
".and"
  WasmOr WasmTypeTag t
ty -> Builder -> WasmAsmM ()
asmTellLine (Builder -> WasmAsmM ()) -> Builder -> WasmAsmM ()
forall a b. (a -> b) -> a -> b
$ WasmTypeTag t -> Builder
forall (t :: WasmType). WasmTypeTag t -> Builder
asmFromWasmType WasmTypeTag t
ty Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
".or"
  WasmXor WasmTypeTag t
ty -> Builder -> WasmAsmM ()
asmTellLine (Builder -> WasmAsmM ()) -> Builder -> WasmAsmM ()
forall a b. (a -> b) -> a -> b
$ WasmTypeTag t -> Builder
forall (t :: WasmType). WasmTypeTag t -> Builder
asmFromWasmType WasmTypeTag t
ty Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
".xor"
  WasmEq WasmTypeTag t
ty -> Builder -> WasmAsmM ()
asmTellLine (Builder -> WasmAsmM ()) -> Builder -> WasmAsmM ()
forall a b. (a -> b) -> a -> b
$ WasmTypeTag t -> Builder
forall (t :: WasmType). WasmTypeTag t -> Builder
asmFromWasmType WasmTypeTag t
ty Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
".eq"
  WasmNe WasmTypeTag t
ty -> Builder -> WasmAsmM ()
asmTellLine (Builder -> WasmAsmM ()) -> Builder -> WasmAsmM ()
forall a b. (a -> b) -> a -> b
$ WasmTypeTag t -> Builder
forall (t :: WasmType). WasmTypeTag t -> Builder
asmFromWasmType WasmTypeTag t
ty Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
".ne"
  WasmLt Signage
_ WasmTypeTag t
TagF32 -> Builder -> WasmAsmM ()
asmTellLine Builder
"f32.lt"
  WasmLt Signage
_ WasmTypeTag t
TagF64 -> Builder -> WasmAsmM ()
asmTellLine Builder
"f64.lt"
  WasmLt Signage
Signed WasmTypeTag t
ty -> Builder -> WasmAsmM ()
asmTellLine (Builder -> WasmAsmM ()) -> Builder -> WasmAsmM ()
forall a b. (a -> b) -> a -> b
$ WasmTypeTag t -> Builder
forall (t :: WasmType). WasmTypeTag t -> Builder
asmFromWasmType WasmTypeTag t
ty Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
".lt_s"
  WasmLt Signage
Unsigned WasmTypeTag t
ty -> Builder -> WasmAsmM ()
asmTellLine (Builder -> WasmAsmM ()) -> Builder -> WasmAsmM ()
forall a b. (a -> b) -> a -> b
$ WasmTypeTag t -> Builder
forall (t :: WasmType). WasmTypeTag t -> Builder
asmFromWasmType WasmTypeTag t
ty Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
".lt_u"
  WasmGt Signage
_ WasmTypeTag t
TagF32 -> Builder -> WasmAsmM ()
asmTellLine Builder
"f32.gt"
  WasmGt Signage
_ WasmTypeTag t
TagF64 -> Builder -> WasmAsmM ()
asmTellLine Builder
"f64.gt"
  WasmGt Signage
Signed WasmTypeTag t
ty -> Builder -> WasmAsmM ()
asmTellLine (Builder -> WasmAsmM ()) -> Builder -> WasmAsmM ()
forall a b. (a -> b) -> a -> b
$ WasmTypeTag t -> Builder
forall (t :: WasmType). WasmTypeTag t -> Builder
asmFromWasmType WasmTypeTag t
ty Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
".gt_s"
  WasmGt Signage
Unsigned WasmTypeTag t
ty -> Builder -> WasmAsmM ()
asmTellLine (Builder -> WasmAsmM ()) -> Builder -> WasmAsmM ()
forall a b. (a -> b) -> a -> b
$ WasmTypeTag t -> Builder
forall (t :: WasmType). WasmTypeTag t -> Builder
asmFromWasmType WasmTypeTag t
ty Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
".gt_u"
  WasmLe Signage
_ WasmTypeTag t
TagF32 -> Builder -> WasmAsmM ()
asmTellLine Builder
"f32.le"
  WasmLe Signage
_ WasmTypeTag t
TagF64 -> Builder -> WasmAsmM ()
asmTellLine Builder
"f64.le"
  WasmLe Signage
Signed WasmTypeTag t
ty -> Builder -> WasmAsmM ()
asmTellLine (Builder -> WasmAsmM ()) -> Builder -> WasmAsmM ()
forall a b. (a -> b) -> a -> b
$ WasmTypeTag t -> Builder
forall (t :: WasmType). WasmTypeTag t -> Builder
asmFromWasmType WasmTypeTag t
ty Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
".le_s"
  WasmLe Signage
Unsigned WasmTypeTag t
ty -> Builder -> WasmAsmM ()
asmTellLine (Builder -> WasmAsmM ()) -> Builder -> WasmAsmM ()
forall a b. (a -> b) -> a -> b
$ WasmTypeTag t -> Builder
forall (t :: WasmType). WasmTypeTag t -> Builder
asmFromWasmType WasmTypeTag t
ty Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
".le_u"
  WasmGe Signage
_ WasmTypeTag t
TagF32 -> Builder -> WasmAsmM ()
asmTellLine Builder
"f32.ge"
  WasmGe Signage
_ WasmTypeTag t
TagF64 -> Builder -> WasmAsmM ()
asmTellLine Builder
"f64.ge"
  WasmGe Signage
Signed WasmTypeTag t
ty -> Builder -> WasmAsmM ()
asmTellLine (Builder -> WasmAsmM ()) -> Builder -> WasmAsmM ()
forall a b. (a -> b) -> a -> b
$ WasmTypeTag t -> Builder
forall (t :: WasmType). WasmTypeTag t -> Builder
asmFromWasmType WasmTypeTag t
ty Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
".ge_s"
  WasmGe Signage
Unsigned WasmTypeTag t
ty -> Builder -> WasmAsmM ()
asmTellLine (Builder -> WasmAsmM ()) -> Builder -> WasmAsmM ()
forall a b. (a -> b) -> a -> b
$ WasmTypeTag t -> Builder
forall (t :: WasmType). WasmTypeTag t -> Builder
asmFromWasmType WasmTypeTag t
ty Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
".ge_u"
  WasmShl WasmTypeTag t
ty -> Builder -> WasmAsmM ()
asmTellLine (Builder -> WasmAsmM ()) -> Builder -> WasmAsmM ()
forall a b. (a -> b) -> a -> b
$ WasmTypeTag t -> Builder
forall (t :: WasmType). WasmTypeTag t -> Builder
asmFromWasmType WasmTypeTag t
ty Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
".shl"
  WasmShr Signage
Signed WasmTypeTag t
ty -> Builder -> WasmAsmM ()
asmTellLine (Builder -> WasmAsmM ()) -> Builder -> WasmAsmM ()
forall a b. (a -> b) -> a -> b
$ WasmTypeTag t -> Builder
forall (t :: WasmType). WasmTypeTag t -> Builder
asmFromWasmType WasmTypeTag t
ty Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
".shr_s"
  WasmShr Signage
Unsigned WasmTypeTag t
ty -> Builder -> WasmAsmM ()
asmTellLine (Builder -> WasmAsmM ()) -> Builder -> WasmAsmM ()
forall a b. (a -> b) -> a -> b
$ WasmTypeTag t -> Builder
forall (t :: WasmType). WasmTypeTag t -> Builder
asmFromWasmType WasmTypeTag t
ty Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
".shr_u"
  WasmInstr w pre post
WasmI32Extend8S -> Builder -> WasmAsmM ()
asmTellLine Builder
"i32.extend8_s"
  WasmInstr w pre post
WasmI32Extend16S -> Builder -> WasmAsmM ()
asmTellLine Builder
"i32.extend16_s"
  WasmInstr w pre post
WasmI64Extend8S -> Builder -> WasmAsmM ()
asmTellLine Builder
"i64.extend8_s"
  WasmInstr w pre post
WasmI64Extend16S -> Builder -> WasmAsmM ()
asmTellLine Builder
"i64.extend16_s"
  WasmInstr w pre post
WasmI64Extend32S -> Builder -> WasmAsmM ()
asmTellLine Builder
"i64.extend32_s"
  WasmI64ExtendI32 Signage
Signed -> Builder -> WasmAsmM ()
asmTellLine Builder
"i64.extend_i32_s"
  WasmI64ExtendI32 Signage
Unsigned -> Builder -> WasmAsmM ()
asmTellLine Builder
"i64.extend_i32_u"
  WasmInstr w pre post
WasmI32WrapI64 -> Builder -> WasmAsmM ()
asmTellLine Builder
"i32.wrap_i64"
  WasmInstr w pre post
WasmF32DemoteF64 -> Builder -> WasmAsmM ()
asmTellLine Builder
"f32.demote_f64"
  WasmInstr w pre post
WasmF64PromoteF32 -> Builder -> WasmAsmM ()
asmTellLine Builder
"f64.promote_f32"
  WasmAbs WasmTypeTag t
ty -> Builder -> WasmAsmM ()
asmTellLine (Builder -> WasmAsmM ()) -> Builder -> WasmAsmM ()
forall a b. (a -> b) -> a -> b
$ WasmTypeTag t -> Builder
forall (t :: WasmType). WasmTypeTag t -> Builder
asmFromWasmType WasmTypeTag t
ty Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
".abs"
  WasmNeg WasmTypeTag t
ty -> Builder -> WasmAsmM ()
asmTellLine (Builder -> WasmAsmM ()) -> Builder -> WasmAsmM ()
forall a b. (a -> b) -> a -> b
$ WasmTypeTag t -> Builder
forall (t :: WasmType). WasmTypeTag t -> Builder
asmFromWasmType WasmTypeTag t
ty Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
".neg"
  WasmMin WasmTypeTag t
ty -> Builder -> WasmAsmM ()
asmTellLine (Builder -> WasmAsmM ()) -> Builder -> WasmAsmM ()
forall a b. (a -> b) -> a -> b
$ WasmTypeTag t -> Builder
forall (t :: WasmType). WasmTypeTag t -> Builder
asmFromWasmType WasmTypeTag t
ty Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
".min"
  WasmMax WasmTypeTag t
ty -> Builder -> WasmAsmM ()
asmTellLine (Builder -> WasmAsmM ()) -> Builder -> WasmAsmM ()
forall a b. (a -> b) -> a -> b
$ WasmTypeTag t -> Builder
forall (t :: WasmType). WasmTypeTag t -> Builder
asmFromWasmType WasmTypeTag t
ty Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
".max"
  WasmCond WasmInstr w post post
t -> do
    Builder -> WasmAsmM ()
asmTellLine Builder
"if"
    WasmAsmM () -> WasmAsmM ()
forall a. WasmAsmM a -> WasmAsmM a
asmWithTab (WasmAsmM () -> WasmAsmM ()) -> WasmAsmM () -> WasmAsmM ()
forall a b. (a -> b) -> a -> b
$ WasmTypeTag w -> WasmInstr w post post -> WasmAsmM ()
forall (w :: WasmType) (pre :: [WasmType]) (post :: [WasmType]).
WasmTypeTag w -> WasmInstr w pre post -> WasmAsmM ()
asmTellWasmInstr WasmTypeTag w
ty_word WasmInstr w post post
t
    Builder -> WasmAsmM ()
asmTellLine Builder
"end_if"

asmTellWasmControl ::
  WasmTypeTag w ->
  WasmControl
    (WasmStatements w)
    (WasmExpr w a)
    pre
    post ->
  WasmAsmM ()
asmTellWasmControl :: forall (w :: WasmType) (a :: WasmType) (pre :: [WasmType])
       (post :: [WasmType]).
WasmTypeTag w
-> WasmControl (WasmStatements w) (WasmExpr w a) pre post
-> WasmAsmM ()
asmTellWasmControl WasmTypeTag w
ty_word WasmControl (WasmStatements w) (WasmExpr w a) pre post
c = case WasmControl (WasmStatements w) (WasmExpr w a) pre post
c of
  WasmPush WasmTypeTag t
_ (WasmExpr forall (pre :: [WasmType]). WasmInstr w pre (a : pre)
e) -> WasmTypeTag w
-> WasmInstr w (ZonkAny 0) (a : ZonkAny 0) -> WasmAsmM ()
forall (w :: WasmType) (pre :: [WasmType]) (post :: [WasmType]).
WasmTypeTag w -> WasmInstr w pre post -> WasmAsmM ()
asmTellWasmInstr WasmTypeTag w
ty_word WasmInstr w (ZonkAny 0) (a : ZonkAny 0)
forall (pre :: [WasmType]). WasmInstr w pre (a : pre)
e
  WasmBlock WasmFunctionType pre post
bt WasmControl (WasmStatements w) (WasmExpr w a) pre post
c -> do
    Builder -> WasmAsmM ()
asmTellLine (Builder -> WasmAsmM ()) -> Builder -> WasmAsmM ()
forall a b. (a -> b) -> a -> b
$ Builder
"block" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> WasmTypeTag w -> WasmFunctionType pre post -> Builder
forall (w :: WasmType) (pre :: [WasmType]) (post :: [WasmType]).
WasmTypeTag w -> WasmFunctionType pre post -> Builder
asmFromWasmBlockType WasmTypeTag w
ty_word WasmFunctionType pre post
bt
    WasmAsmM () -> WasmAsmM ()
forall a. WasmAsmM a -> WasmAsmM a
asmWithTab (WasmAsmM () -> WasmAsmM ()) -> WasmAsmM () -> WasmAsmM ()
forall a b. (a -> b) -> a -> b
$ WasmTypeTag w
-> WasmControl (WasmStatements w) (WasmExpr w a) pre post
-> WasmAsmM ()
forall (w :: WasmType) (a :: WasmType) (pre :: [WasmType])
       (post :: [WasmType]).
WasmTypeTag w
-> WasmControl (WasmStatements w) (WasmExpr w a) pre post
-> WasmAsmM ()
asmTellWasmControl WasmTypeTag w
ty_word WasmControl (WasmStatements w) (WasmExpr w a) pre post
c
    Builder -> WasmAsmM ()
asmTellLine Builder
"end_block"
  WasmLoop WasmFunctionType pre post
bt WasmControl (WasmStatements w) (WasmExpr w a) pre post
c -> do
    Builder -> WasmAsmM ()
asmTellLine (Builder -> WasmAsmM ()) -> Builder -> WasmAsmM ()
forall a b. (a -> b) -> a -> b
$ Builder
"loop" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> WasmTypeTag w -> WasmFunctionType pre post -> Builder
forall (w :: WasmType) (pre :: [WasmType]) (post :: [WasmType]).
WasmTypeTag w -> WasmFunctionType pre post -> Builder
asmFromWasmBlockType WasmTypeTag w
ty_word WasmFunctionType pre post
bt
    WasmAsmM () -> WasmAsmM ()
forall a. WasmAsmM a -> WasmAsmM a
asmWithTab (WasmAsmM () -> WasmAsmM ()) -> WasmAsmM () -> WasmAsmM ()
forall a b. (a -> b) -> a -> b
$ WasmTypeTag w
-> WasmControl (WasmStatements w) (WasmExpr w a) pre post
-> WasmAsmM ()
forall (w :: WasmType) (a :: WasmType) (pre :: [WasmType])
       (post :: [WasmType]).
WasmTypeTag w
-> WasmControl (WasmStatements w) (WasmExpr w a) pre post
-> WasmAsmM ()
asmTellWasmControl WasmTypeTag w
ty_word WasmControl (WasmStatements w) (WasmExpr w a) pre post
c
    Builder -> WasmAsmM ()
asmTellLine Builder
"end_loop"
  WasmIfTop WasmFunctionType pre post
bt WasmControl (WasmStatements w) (WasmExpr w a) pre post
t WasmControl (WasmStatements w) (WasmExpr w a) pre post
f -> do
    Builder -> WasmAsmM ()
asmTellLine (Builder -> WasmAsmM ()) -> Builder -> WasmAsmM ()
forall a b. (a -> b) -> a -> b
$ Builder
"if" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> WasmTypeTag w -> WasmFunctionType pre post -> Builder
forall (w :: WasmType) (pre :: [WasmType]) (post :: [WasmType]).
WasmTypeTag w -> WasmFunctionType pre post -> Builder
asmFromWasmBlockType WasmTypeTag w
ty_word WasmFunctionType pre post
bt
    WasmAsmM () -> WasmAsmM ()
forall a. WasmAsmM a -> WasmAsmM a
asmWithTab (WasmAsmM () -> WasmAsmM ()) -> WasmAsmM () -> WasmAsmM ()
forall a b. (a -> b) -> a -> b
$ WasmTypeTag w
-> WasmControl (WasmStatements w) (WasmExpr w a) pre post
-> WasmAsmM ()
forall (w :: WasmType) (a :: WasmType) (pre :: [WasmType])
       (post :: [WasmType]).
WasmTypeTag w
-> WasmControl (WasmStatements w) (WasmExpr w a) pre post
-> WasmAsmM ()
asmTellWasmControl WasmTypeTag w
ty_word WasmControl (WasmStatements w) (WasmExpr w a) pre post
t
    Builder -> WasmAsmM ()
asmTellLine Builder
"else"
    WasmAsmM () -> WasmAsmM ()
forall a. WasmAsmM a -> WasmAsmM a
asmWithTab (WasmAsmM () -> WasmAsmM ()) -> WasmAsmM () -> WasmAsmM ()
forall a b. (a -> b) -> a -> b
$ WasmTypeTag w
-> WasmControl (WasmStatements w) (WasmExpr w a) pre post
-> WasmAsmM ()
forall (w :: WasmType) (a :: WasmType) (pre :: [WasmType])
       (post :: [WasmType]).
WasmTypeTag w
-> WasmControl (WasmStatements w) (WasmExpr w a) pre post
-> WasmAsmM ()
asmTellWasmControl WasmTypeTag w
ty_word WasmControl (WasmStatements w) (WasmExpr w a) pre post
f
    Builder -> WasmAsmM ()
asmTellLine Builder
"end_if"
  WasmBr Int
i -> Builder -> WasmAsmM ()
asmTellLine (Builder -> WasmAsmM ()) -> Builder -> WasmAsmM ()
forall a b. (a -> b) -> a -> b
$ Builder
"br " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Builder
intDec Int
i
  WasmControl (WasmStatements w) (WasmExpr w a) pre post
WasmFallthrough -> WasmAsmM ()
forall a. Monoid a => a
mempty
  WasmBrTable (WasmExpr forall (pre :: [WasmType]). WasmInstr w pre (a : pre)
e) BrTableInterval
_ [Int]
ts Int
t -> do
    WasmTypeTag w
-> WasmInstr w (ZonkAny 1) (a : ZonkAny 1) -> WasmAsmM ()
forall (w :: WasmType) (pre :: [WasmType]) (post :: [WasmType]).
WasmTypeTag w -> WasmInstr w pre post -> WasmAsmM ()
asmTellWasmInstr WasmTypeTag w
ty_word WasmInstr w (ZonkAny 1) (a : ZonkAny 1)
forall (pre :: [WasmType]). WasmInstr w pre (a : pre)
e
    Builder -> WasmAsmM ()
asmTellLine (Builder -> WasmAsmM ()) -> Builder -> WasmAsmM ()
forall a b. (a -> b) -> a -> b
$ Builder
"br_table {" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> (Int -> Builder) -> [Int] -> Builder
forall a. (a -> Builder) -> [a] -> Builder
builderCommas Int -> Builder
intDec ([Int]
ts [Int] -> [Int] -> [Int]
forall a. Semigroup a => a -> a -> a
<> [Int
t]) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"}"
  -- See Note [WasmTailCall]
  WasmTailCall (WasmExpr forall (pre :: [WasmType]). WasmInstr w pre (a : pre)
e) -> do
    WasmAsmConfig {..} <- WasmAsmM WasmAsmConfig
getConf
    if
        | tailcall,
          WasmSymConst sym <- e ->
            asmTellLine $ "return_call " <> asmFromSymName sym
        | tailcall ->
            do
              asmTellWasmInstr ty_word e
              asmTellLine $
                "return_call_indirect "
                  <> asmFromFuncType
                    []
                    [SomeWasmType ty_word]
        | otherwise ->
            do
              asmTellWasmInstr ty_word e
              asmTellLine "return"
  WasmActions (WasmStatements forall (pre :: [WasmType]). WasmInstr w pre pre
a) -> WasmTypeTag w -> WasmInstr w (ZonkAny 5) (ZonkAny 5) -> WasmAsmM ()
forall (w :: WasmType) (pre :: [WasmType]) (post :: [WasmType]).
WasmTypeTag w -> WasmInstr w pre post -> WasmAsmM ()
asmTellWasmInstr WasmTypeTag w
ty_word WasmInstr w (ZonkAny 5) (ZonkAny 5)
forall (pre :: [WasmType]). WasmInstr w pre pre
a
  WasmSeq WasmControl (WasmStatements w) (WasmExpr w a) pre mid
c0 WasmControl (WasmStatements w) (WasmExpr w a) mid post
c1 -> do
    WasmTypeTag w
-> WasmControl (WasmStatements w) (WasmExpr w a) pre mid
-> WasmAsmM ()
forall (w :: WasmType) (a :: WasmType) (pre :: [WasmType])
       (post :: [WasmType]).
WasmTypeTag w
-> WasmControl (WasmStatements w) (WasmExpr w a) pre post
-> WasmAsmM ()
asmTellWasmControl WasmTypeTag w
ty_word WasmControl (WasmStatements w) (WasmExpr w a) pre mid
c0
    WasmTypeTag w
-> WasmControl (WasmStatements w) (WasmExpr w a) mid post
-> WasmAsmM ()
forall (w :: WasmType) (a :: WasmType) (pre :: [WasmType])
       (post :: [WasmType]).
WasmTypeTag w
-> WasmControl (WasmStatements w) (WasmExpr w a) pre post
-> WasmAsmM ()
asmTellWasmControl WasmTypeTag w
ty_word WasmControl (WasmStatements w) (WasmExpr w a) mid post
c1

asmTellFunc ::
  WasmTypeTag w ->
  UniqueSet ->
  SymName ->
  (([SomeWasmType], [SomeWasmType]), FuncBody w) ->
  WasmAsmM ()
asmTellFunc :: forall (w :: WasmType).
WasmTypeTag w
-> SymSet
-> SymName
-> (([SomeWasmType], [SomeWasmType]), FuncBody w)
-> WasmAsmM ()
asmTellFunc WasmTypeTag w
ty_word SymSet
def_syms SymName
sym (([SomeWasmType], [SomeWasmType])
func_ty, FuncBody {[SomeWasmType]
WasmControl (WasmStatements w) (WasmExpr w w) '[] '[w]
funcLocals :: [SomeWasmType]
funcBody :: WasmControl (WasmStatements w) (WasmExpr w w) '[] '[w]
funcBody :: forall (w :: WasmType).
FuncBody w
-> WasmControl (WasmStatements w) (WasmExpr w w) '[] '[w]
funcLocals :: forall (w :: WasmType). FuncBody w -> [SomeWasmType]
..}) = do
  Bool -> WasmAsmM () -> WasmAsmM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (SymName -> Unique
forall a. Uniquable a => a -> Unique
getUnique SymName
sym Unique -> SymSet -> Bool
`memberUniqueSet` SymSet
def_syms) (WasmAsmM () -> WasmAsmM ()) -> WasmAsmM () -> WasmAsmM ()
forall a b. (a -> b) -> a -> b
$ SymName -> WasmAsmM ()
asmTellDefSym SymName
sym
  Builder -> WasmAsmM ()
asmTellSectionHeader (Builder -> WasmAsmM ()) -> Builder -> WasmAsmM ()
forall a b. (a -> b) -> a -> b
$ Builder
".text." Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
asm_sym
  Builder -> WasmAsmM ()
asmTellLine (Builder -> WasmAsmM ()) -> Builder -> WasmAsmM ()
forall a b. (a -> b) -> a -> b
$ Builder
asm_sym Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
":"
  SymName -> ([SomeWasmType], [SomeWasmType]) -> WasmAsmM ()
asmTellFuncType SymName
sym ([SomeWasmType], [SomeWasmType])
func_ty
  [SomeWasmType] -> WasmAsmM ()
asmTellLocals [SomeWasmType]
funcLocals
  WasmAsmM () -> WasmAsmM ()
forall a. WasmAsmM a -> WasmAsmM a
asmWithTab (WasmAsmM () -> WasmAsmM ()) -> WasmAsmM () -> WasmAsmM ()
forall a b. (a -> b) -> a -> b
$ WasmTypeTag w
-> WasmControl (WasmStatements w) (WasmExpr w w) '[] '[w]
-> WasmAsmM ()
forall (w :: WasmType) (a :: WasmType) (pre :: [WasmType])
       (post :: [WasmType]).
WasmTypeTag w
-> WasmControl (WasmStatements w) (WasmExpr w a) pre post
-> WasmAsmM ()
asmTellWasmControl WasmTypeTag w
ty_word WasmControl (WasmStatements w) (WasmExpr w w) '[] '[w]
funcBody
  Builder -> WasmAsmM ()
asmTellTabLine Builder
"end_function"
  WasmAsmM ()
asmTellLF
  where
    asm_sym :: Builder
asm_sym = SymName -> Builder
asmFromSymName SymName
sym

asmTellGlobals :: WasmTypeTag w -> WasmAsmM ()
asmTellGlobals :: forall (w :: WasmType). WasmTypeTag w -> WasmAsmM ()
asmTellGlobals WasmTypeTag w
ty_word = do
  WasmAsmConfig {..} <- WasmAsmM WasmAsmConfig
getConf
  when pic $ traverse_ asmTellTabLine [
      ".globaltype __memory_base, i32, immutable",
      ".globaltype __table_base, i32, immutable"
    ]
  for_ supportedCmmGlobalRegs $ \GlobalReg
reg ->
    let
      (SymName
sym, SomeWasmType
ty) = Maybe (SymName, SomeWasmType) -> (SymName, SomeWasmType)
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe (SymName, SomeWasmType) -> (SymName, SomeWasmType))
-> Maybe (SymName, SomeWasmType) -> (SymName, SomeWasmType)
forall a b. (a -> b) -> a -> b
$ WasmTypeTag w -> GlobalReg -> Maybe (SymName, SomeWasmType)
forall (w :: WasmType).
WasmTypeTag w -> GlobalReg -> Maybe (SymName, SomeWasmType)
globalInfoFromCmmGlobalReg WasmTypeTag w
ty_word GlobalReg
reg
      asm_sym :: Builder
asm_sym = SymName -> Builder
asmFromSymName SymName
sym
     in do
      Builder -> WasmAsmM ()
asmTellTabLine (Builder -> WasmAsmM ()) -> Builder -> WasmAsmM ()
forall a b. (a -> b) -> a -> b
$
          Builder
".globaltype "
            Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
asm_sym
            Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
", "
            Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> SomeWasmType -> Builder
asmFromSomeWasmType SomeWasmType
ty
      Bool -> WasmAsmM () -> WasmAsmM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
pic (WasmAsmM () -> WasmAsmM ()) -> WasmAsmM () -> WasmAsmM ()
forall a b. (a -> b) -> a -> b
$ (Builder -> WasmAsmM ()) -> [Builder] -> WasmAsmM ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ Builder -> WasmAsmM ()
asmTellTabLine [
          Builder
".import_module " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
asm_sym Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
", regs",
          Builder
".import_name " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
asm_sym Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
", " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
asm_sym
        ]
  asmTellLF

asmTellCtors :: WasmTypeTag w -> [SymName] -> WasmAsmM ()
asmTellCtors :: forall (w :: WasmType). WasmTypeTag w -> [SymName] -> WasmAsmM ()
asmTellCtors WasmTypeTag w
_ [] = WasmAsmM ()
forall a. Monoid a => a
mempty
asmTellCtors WasmTypeTag w
ty_word [SymName]
syms = do
  -- See Note [JSFFI initialization] for details
  Builder -> WasmAsmM ()
asmTellSectionHeader Builder
".init_array.101"
  Alignment -> WasmAsmM ()
asmTellAlign (Alignment -> WasmAsmM ()) -> Alignment -> WasmAsmM ()
forall a b. (a -> b) -> a -> b
$ WasmTypeTag w -> Alignment
forall (w :: WasmType). WasmTypeTag w -> Alignment
alignmentFromWordType WasmTypeTag w
ty_word
  [SymName] -> (SymName -> WasmAsmM ()) -> WasmAsmM ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [SymName]
syms ((SymName -> WasmAsmM ()) -> WasmAsmM ())
-> (SymName -> WasmAsmM ()) -> WasmAsmM ()
forall a b. (a -> b) -> a -> b
$ \SymName
sym ->
    Builder -> WasmAsmM ()
asmTellTabLine (Builder -> WasmAsmM ()) -> Builder -> WasmAsmM ()
forall a b. (a -> b) -> a -> b
$
      ( case WasmTypeTag w
ty_word of
          WasmTypeTag w
TagI32 -> Builder
".int32 "
          WasmTypeTag w
TagI64 -> Builder
".int64 "
          WasmTypeTag w
_ -> String -> Builder
forall a. HasCallStack => String -> a
panic String
"asmTellCtors: unreachable"
      )
        Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> SymName -> Builder
asmFromSymName SymName
sym
  WasmAsmM ()
asmTellLF

asmTellBS :: ByteString -> WasmAsmM ()
asmTellBS :: ByteString -> WasmAsmM ()
asmTellBS ByteString
s = do
  Builder -> WasmAsmM ()
asmTellTabLine (Builder -> WasmAsmM ()) -> Builder -> WasmAsmM ()
forall a b. (a -> b) -> a -> b
$ Builder
".int8 " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Builder
intDec (ByteString -> Int
BS.length ByteString
s)
  Builder -> WasmAsmM ()
asmTellTabLine (Builder -> WasmAsmM ()) -> Builder -> WasmAsmM ()
forall a b. (a -> b) -> a -> b
$
    Builder
".ascii \""
      Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> String -> Builder
string7
        (SDocContext -> SDoc -> String
showSDocOneLine SDocContext
defaultSDocContext (SDoc -> String) -> SDoc -> String
forall a b. (a -> b) -> a -> b
$ ByteString -> SDoc
forall doc. IsLine doc => ByteString -> doc
pprASCII ByteString
s)
      Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"\""

asmTellVec :: [WasmAsmM ()] -> WasmAsmM ()
asmTellVec :: [WasmAsmM ()] -> WasmAsmM ()
asmTellVec [WasmAsmM ()]
xs = do
  Builder -> WasmAsmM ()
asmTellTabLine (Builder -> WasmAsmM ()) -> Builder -> WasmAsmM ()
forall a b. (a -> b) -> a -> b
$ Builder
".int8 " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Builder
intDec ([WasmAsmM ()] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [WasmAsmM ()]
xs)
  [WasmAsmM ()] -> WasmAsmM ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ [WasmAsmM ()]
xs

asmTellProducers :: WasmAsmM ()
asmTellProducers :: WasmAsmM ()
asmTellProducers = do
  Builder -> WasmAsmM ()
asmTellSectionHeader Builder
".custom_section.producers"
  [WasmAsmM ()] -> WasmAsmM ()
asmTellVec
    [ do
        ByteString -> WasmAsmM ()
asmTellBS ByteString
"processed-by"
        [WasmAsmM ()] -> WasmAsmM ()
asmTellVec
          [ do
              ByteString -> WasmAsmM ()
asmTellBS ByteString
"ghc"
              ByteString -> WasmAsmM ()
asmTellBS (ByteString -> WasmAsmM ()) -> ByteString -> WasmAsmM ()
forall a b. (a -> b) -> a -> b
$ String -> ByteString
BS8.pack String
cProjectVersion
          ]
    ]

asmTellTargetFeatures :: WasmAsmM ()
asmTellTargetFeatures :: WasmAsmM ()
asmTellTargetFeatures = do
  WasmAsmConfig {..} <- WasmAsmM WasmAsmConfig
getConf
  asmTellSectionHeader ".custom_section.target_features"
  asmTellVec
    [ do
        asmTellTabLine ".int8 0x2b"
        asmTellBS feature
      | feature <-
          ["tail-call" | tailcall]
            <> [ "bulk-memory",
                 "mutable-globals",
                 "nontrapping-fptoint",
                 "reference-types",
                 "sign-ext"
               ]
    ]

asmTellEverything :: WasmTypeTag w -> WasmCodeGenState w -> WasmAsmM ()
asmTellEverything :: forall (w :: WasmType).
WasmTypeTag w -> WasmCodeGenState w -> WasmAsmM ()
asmTellEverything WasmTypeTag w
ty_word WasmCodeGenState {Int
[SymName]
UniqFM LocalReg LocalInfo
DUniqSupply
SymSet
SymMap ([SomeWasmType], [SomeWasmType])
SymMap (FuncBody w)
SymMap DataSection
Platform
wasmPlatform :: Platform
defaultSyms :: SymSet
funcTypes :: SymMap ([SomeWasmType], [SomeWasmType])
funcBodies :: SymMap (FuncBody w)
dataSections :: SymMap DataSection
ctors :: [SymName]
localRegs :: UniqFM LocalReg LocalInfo
localRegsCount :: Int
wasmDUniqSupply :: DUniqSupply
wasmDUniqSupply :: forall (w :: WasmType). WasmCodeGenState w -> DUniqSupply
localRegsCount :: forall (w :: WasmType). WasmCodeGenState w -> Int
localRegs :: forall (w :: WasmType).
WasmCodeGenState w -> UniqFM LocalReg LocalInfo
ctors :: forall (w :: WasmType). WasmCodeGenState w -> [SymName]
dataSections :: forall (w :: WasmType). WasmCodeGenState w -> SymMap DataSection
funcBodies :: forall (w :: WasmType). WasmCodeGenState w -> SymMap (FuncBody w)
funcTypes :: forall (w :: WasmType).
WasmCodeGenState w -> SymMap ([SomeWasmType], [SomeWasmType])
defaultSyms :: forall (w :: WasmType). WasmCodeGenState w -> SymSet
wasmPlatform :: forall (w :: WasmType). WasmCodeGenState w -> Platform
..} = do
  WasmTypeTag w -> WasmAsmM ()
forall (w :: WasmType). WasmTypeTag w -> WasmAsmM ()
asmTellGlobals WasmTypeTag w
ty_word
  WasmAsmM ()
asm_functypes
  WasmAsmM ()
asm_funcs
  WasmAsmM ()
asm_data_secs
  WasmAsmM ()
asm_ctors
  WasmAsmM ()
asmTellProducers
  WasmAsmM ()
asmTellTargetFeatures
  where
    asm_functypes :: WasmAsmM ()
asm_functypes = do
      [(SymName, ([SomeWasmType], [SomeWasmType]))]
-> ((SymName, ([SomeWasmType], [SomeWasmType])) -> WasmAsmM ())
-> WasmAsmM ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_
        (SymMap ([SomeWasmType], [SomeWasmType])
-> [(SymName, ([SomeWasmType], [SomeWasmType]))]
forall k a. Ord k => UniqMap k a -> [(k, a)]
detEltsUniqMap (SymMap ([SomeWasmType], [SomeWasmType])
 -> [(SymName, ([SomeWasmType], [SomeWasmType]))])
-> SymMap ([SomeWasmType], [SomeWasmType])
-> [(SymName, ([SomeWasmType], [SomeWasmType]))]
forall a b. (a -> b) -> a -> b
$ SymMap ([SomeWasmType], [SomeWasmType])
funcTypes SymMap ([SomeWasmType], [SomeWasmType])
-> SymMap (FuncBody w) -> SymMap ([SomeWasmType], [SomeWasmType])
forall k a b. UniqMap k a -> UniqMap k b -> UniqMap k a
`minusUniqMap` SymMap (FuncBody w)
funcBodies)
        ((SymName -> ([SomeWasmType], [SomeWasmType]) -> WasmAsmM ())
-> (SymName, ([SomeWasmType], [SomeWasmType])) -> WasmAsmM ()
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry SymName -> ([SomeWasmType], [SomeWasmType]) -> WasmAsmM ()
asmTellFuncType)
      WasmAsmM ()
asmTellLF

    asm_funcs :: WasmAsmM ()
asm_funcs = do
      [(SymName, (([SomeWasmType], [SomeWasmType]), FuncBody w))]
-> ((SymName, (([SomeWasmType], [SomeWasmType]), FuncBody w))
    -> WasmAsmM ())
-> WasmAsmM ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_
        (UniqMap SymName (([SomeWasmType], [SomeWasmType]), FuncBody w)
-> [(SymName, (([SomeWasmType], [SomeWasmType]), FuncBody w))]
forall k a. Ord k => UniqMap k a -> [(k, a)]
detEltsUniqMap (UniqMap SymName (([SomeWasmType], [SomeWasmType]), FuncBody w)
 -> [(SymName, (([SomeWasmType], [SomeWasmType]), FuncBody w))])
-> UniqMap SymName (([SomeWasmType], [SomeWasmType]), FuncBody w)
-> [(SymName, (([SomeWasmType], [SomeWasmType]), FuncBody w))]
forall a b. (a -> b) -> a -> b
$ (([SomeWasmType], [SomeWasmType])
 -> FuncBody w -> (([SomeWasmType], [SomeWasmType]), FuncBody w))
-> SymMap ([SomeWasmType], [SomeWasmType])
-> SymMap (FuncBody w)
-> UniqMap SymName (([SomeWasmType], [SomeWasmType]), FuncBody w)
forall a b c k.
(a -> b -> c) -> UniqMap k a -> UniqMap k b -> UniqMap k c
intersectUniqMap_C (,) SymMap ([SomeWasmType], [SomeWasmType])
funcTypes SymMap (FuncBody w)
funcBodies)
        ((SymName
 -> (([SomeWasmType], [SomeWasmType]), FuncBody w) -> WasmAsmM ())
-> (SymName, (([SomeWasmType], [SomeWasmType]), FuncBody w))
-> WasmAsmM ()
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ((SymName
  -> (([SomeWasmType], [SomeWasmType]), FuncBody w) -> WasmAsmM ())
 -> (SymName, (([SomeWasmType], [SomeWasmType]), FuncBody w))
 -> WasmAsmM ())
-> (SymName
    -> (([SomeWasmType], [SomeWasmType]), FuncBody w) -> WasmAsmM ())
-> (SymName, (([SomeWasmType], [SomeWasmType]), FuncBody w))
-> WasmAsmM ()
forall a b. (a -> b) -> a -> b
$ WasmTypeTag w
-> SymSet
-> SymName
-> (([SomeWasmType], [SomeWasmType]), FuncBody w)
-> WasmAsmM ()
forall (w :: WasmType).
WasmTypeTag w
-> SymSet
-> SymName
-> (([SomeWasmType], [SomeWasmType]), FuncBody w)
-> WasmAsmM ()
asmTellFunc WasmTypeTag w
ty_word SymSet
defaultSyms)
      WasmAsmM ()
asmTellLF

    asm_data_secs :: WasmAsmM ()
asm_data_secs = do
      [(SymName, DataSection)]
-> ((SymName, DataSection) -> WasmAsmM ()) -> WasmAsmM ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_
        (SymMap DataSection -> [(SymName, DataSection)]
forall k a. Ord k => UniqMap k a -> [(k, a)]
detEltsUniqMap SymMap DataSection
dataSections)
        ((SymName -> DataSection -> WasmAsmM ())
-> (SymName, DataSection) -> WasmAsmM ()
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (WasmTypeTag w -> SymSet -> SymName -> DataSection -> WasmAsmM ()
forall (w :: WasmType).
WasmTypeTag w -> SymSet -> SymName -> DataSection -> WasmAsmM ()
asmTellDataSection WasmTypeTag w
ty_word SymSet
defaultSyms))
      WasmAsmM ()
asmTellLF

    asm_ctors :: WasmAsmM ()
asm_ctors = WasmTypeTag w -> [SymName] -> WasmAsmM ()
forall (w :: WasmType). WasmTypeTag w -> [SymName] -> WasmAsmM ()
asmTellCtors WasmTypeTag w
ty_word [SymName]
ctors