{-# 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 Data.Coerce
import Data.Foldable
import qualified Data.IntSet as IS
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.Types.Basic
import GHC.Types.Unique
import GHC.Types.Unique.Map
import GHC.Utils.Monad.State.Strict
import GHC.Utils.Outputable hiding ((<>))
import GHC.Utils.Panic (panic)
newtype WasmAsmM a = WasmAsmM (Bool -> 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 Bool (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
doTailCall :: WasmAsmM Bool
doTailCall :: WasmAsmM Bool
doTailCall = (Bool -> Builder -> State Builder Bool) -> WasmAsmM Bool
forall a. (Bool -> Builder -> State Builder a) -> WasmAsmM a
WasmAsmM ((Bool -> Builder -> State Builder Bool) -> WasmAsmM Bool)
-> (Bool -> Builder -> State Builder Bool) -> WasmAsmM Bool
forall a b. (a -> b) -> a -> b
$ \Bool
do_tail_call Builder
_ -> Bool -> State Builder Bool
forall a. a -> State Builder a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
do_tail_call
execWasmAsmM :: Bool -> WasmAsmM a -> Builder
execWasmAsmM :: forall a. Bool -> WasmAsmM a -> Builder
execWasmAsmM Bool
do_tail_call (WasmAsmM Bool -> Builder -> State Builder a
m) =
State Builder a -> Builder -> Builder
forall s a. State s a -> s -> s
execState (Bool -> Builder -> State Builder a
m Bool
do_tail_call Builder
forall a. Monoid a => a
mempty) Builder
forall a. Monoid a => a
mempty
asmWithTab :: WasmAsmM a -> WasmAsmM a
asmWithTab :: forall a. WasmAsmM a -> WasmAsmM a
asmWithTab (WasmAsmM Bool -> Builder -> State Builder a
m) =
(Bool -> Builder -> State Builder a) -> WasmAsmM a
forall a. (Bool -> Builder -> State Builder a) -> WasmAsmM a
WasmAsmM ((Bool -> Builder -> State Builder a) -> WasmAsmM a)
-> (Bool -> Builder -> State Builder a) -> WasmAsmM a
forall a b. (a -> b) -> a -> b
$ \Bool
do_tail_call Builder
t -> Bool -> Builder -> State Builder a
m Bool
do_tail_call (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
asmTellLine :: Builder -> WasmAsmM ()
asmTellLine :: Builder -> WasmAsmM ()
asmTellLine Builder
b = (Bool -> Builder -> State Builder ()) -> WasmAsmM ()
forall a. (Bool -> Builder -> State Builder a) -> WasmAsmM a
WasmAsmM ((Bool -> Builder -> State Builder ()) -> WasmAsmM ())
-> (Bool -> Builder -> State Builder ()) -> WasmAsmM ()
forall a b. (a -> b) -> a -> b
$ \Bool
_ 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'
asmTellLF :: WasmAsmM ()
asmTellLF :: WasmAsmM ()
asmTellLF = (Bool -> Builder -> State Builder ()) -> WasmAsmM ()
forall a. (Bool -> Builder -> State Builder a) -> WasmAsmM a
WasmAsmM ((Bool -> Builder -> State Builder ()) -> WasmAsmM ())
-> (Bool -> Builder -> State Builder ()) -> WasmAsmM ()
forall a b. (a -> b) -> a -> b
$ \Bool
_ 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'
asmTellTabLine :: Builder -> WasmAsmM ()
asmTellTabLine :: Builder -> WasmAsmM ()
asmTellTabLine Builder
b =
(Bool -> Builder -> State Builder ()) -> WasmAsmM ()
forall a. (Bool -> Builder -> State Builder a) -> WasmAsmM a
WasmAsmM ((Bool -> Builder -> State Builder ()) -> WasmAsmM ())
-> (Bool -> Builder -> State Builder ()) -> WasmAsmM ()
forall a b. (a -> b) -> a -> b
$ \Bool
_ 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
Builder -> WasmAsmM ()
asmTellTabLine (Builder -> WasmAsmM ()) -> Builder -> WasmAsmM ()
forall a b. (a -> b) -> a -> b
$ Builder
".hidden " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
asm_sym
Builder -> WasmAsmM ()
asmTellTabLine (Builder -> WasmAsmM ()) -> Builder -> WasmAsmM ()
forall a b. (a -> b) -> a -> b
$ Builder
".globl " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
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 -> Int -> Builder
intDec Int
o
)
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 ()
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 -> IS.IntSet -> SymName -> DataSection -> WasmAsmM ()
asmTellDataSection :: forall (w :: WasmType).
WasmTypeTag w -> IntSet -> SymName -> DataSection -> WasmAsmM ()
asmTellDataSection WasmTypeTag w
ty_word IntSet
def_syms SymName
sym DataSection {[DataSectionContent]
Alignment
DataSectionKind
dataSectionKind :: DataSectionKind
dataSectionAlignment :: Alignment
dataSectionContents :: [DataSectionContent]
dataSectionKind :: DataSection -> DataSectionKind
dataSectionAlignment :: DataSection -> Alignment
dataSectionContents :: DataSection -> [DataSectionContent]
..} = do
Bool -> WasmAsmM () -> WasmAsmM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Unique -> Int
getKey (SymName -> Unique
forall a. Uniquable a => a -> Unique
getUnique SymName
sym) Int -> IntSet -> Bool
`IS.member` IntSet
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 ->
Builder -> WasmAsmM ()
asmTellLine (Builder -> WasmAsmM ()) -> Builder -> WasmAsmM ()
forall a b. (a -> b) -> a -> b
$
( case WasmTypeTag w
ty_word of
WasmTypeTag w
TagI32 -> Builder
"i32.const "
WasmTypeTag w
TagI64 -> Builder
"i64.const "
WasmTypeTag w
_ -> String -> Builder
forall a. HasCallStack => String -> a
panic String
"asmTellWasmInstr: unreachable"
)
Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> SymName -> Builder
asmFromSymName SymName
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"
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 Any (a : Any) -> WasmAsmM ()
forall (w :: WasmType) (pre :: [WasmType]) (post :: [WasmType]).
WasmTypeTag w -> WasmInstr w pre post -> WasmAsmM ()
asmTellWasmInstr WasmTypeTag w
ty_word WasmInstr w Any (a : Any)
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 Any (a : Any) -> WasmAsmM ()
forall (w :: WasmType) (pre :: [WasmType]) (post :: [WasmType]).
WasmTypeTag w -> WasmInstr w pre post -> WasmAsmM ()
asmTellWasmInstr WasmTypeTag w
ty_word WasmInstr w Any (a : Any)
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
"}"
WasmTailCall (WasmExpr forall (pre :: [WasmType]). WasmInstr w pre (a : pre)
e) -> do
Bool
do_tail_call <- WasmAsmM Bool
doTailCall
if
| Bool
do_tail_call,
WasmSymConst SymName
sym <- WasmInstr w Any (a : Any)
forall (pre :: [WasmType]). WasmInstr w pre (a : pre)
e ->
Builder -> WasmAsmM ()
asmTellLine (Builder -> WasmAsmM ()) -> Builder -> WasmAsmM ()
forall a b. (a -> b) -> a -> b
$ Builder
"return_call " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> SymName -> Builder
asmFromSymName SymName
sym
| Bool
do_tail_call ->
do
WasmTypeTag w -> WasmInstr w Any (a : Any) -> WasmAsmM ()
forall (w :: WasmType) (pre :: [WasmType]) (post :: [WasmType]).
WasmTypeTag w -> WasmInstr w pre post -> WasmAsmM ()
asmTellWasmInstr WasmTypeTag w
ty_word WasmInstr w Any (a : Any)
forall (pre :: [WasmType]). WasmInstr w pre (a : pre)
e
Builder -> WasmAsmM ()
asmTellLine (Builder -> WasmAsmM ()) -> Builder -> WasmAsmM ()
forall a b. (a -> b) -> a -> b
$
Builder
"return_call_indirect "
Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> [SomeWasmType] -> [SomeWasmType] -> Builder
asmFromFuncType
[]
[WasmTypeTag w -> SomeWasmType
forall (t :: WasmType). WasmTypeTag t -> SomeWasmType
SomeWasmType WasmTypeTag w
ty_word]
| Bool
otherwise ->
do
WasmTypeTag w -> WasmInstr w Any (a : Any) -> WasmAsmM ()
forall (w :: WasmType) (pre :: [WasmType]) (post :: [WasmType]).
WasmTypeTag w -> WasmInstr w pre post -> WasmAsmM ()
asmTellWasmInstr WasmTypeTag w
ty_word WasmInstr w Any (a : Any)
forall (pre :: [WasmType]). WasmInstr w pre (a : pre)
e
Builder -> WasmAsmM ()
asmTellLine Builder
"return"
WasmActions (WasmStatements forall (pre :: [WasmType]). WasmInstr w pre pre
a) -> WasmTypeTag w -> WasmInstr w Any Any -> WasmAsmM ()
forall (w :: WasmType) (pre :: [WasmType]) (post :: [WasmType]).
WasmTypeTag w -> WasmInstr w pre post -> WasmAsmM ()
asmTellWasmInstr WasmTypeTag w
ty_word WasmInstr w Any Any
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 ->
IS.IntSet ->
SymName ->
(([SomeWasmType], [SomeWasmType]), FuncBody w) ->
WasmAsmM ()
asmTellFunc :: forall (w :: WasmType).
WasmTypeTag w
-> IntSet
-> SymName
-> (([SomeWasmType], [SomeWasmType]), FuncBody w)
-> WasmAsmM ()
asmTellFunc WasmTypeTag w
ty_word IntSet
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]
funcLocals :: forall (w :: WasmType). FuncBody w -> [SomeWasmType]
funcBody :: forall (w :: WasmType).
FuncBody w
-> WasmControl (WasmStatements w) (WasmExpr w w) '[] '[w]
..}) = do
Bool -> WasmAsmM () -> WasmAsmM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Unique -> Int
getKey (SymName -> Unique
forall a. Uniquable a => a -> Unique
getUnique SymName
sym) Int -> IntSet -> Bool
`IS.member` IntSet
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
[GlobalReg] -> (GlobalReg -> WasmAsmM ()) -> WasmAsmM ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [GlobalReg]
supportedCmmGlobalRegs ((GlobalReg -> WasmAsmM ()) -> WasmAsmM ())
-> (GlobalReg -> WasmAsmM ()) -> WasmAsmM ()
forall a b. (a -> b) -> a -> b
$ \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
in 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
<> 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 -> Builder
asmFromSomeWasmType SomeWasmType
ty
WasmAsmM ()
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
Builder -> WasmAsmM ()
asmTellSectionHeader Builder
".init_array"
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
"9.6"
]
]
asmTellTargetFeatures :: WasmAsmM ()
asmTellTargetFeatures :: WasmAsmM ()
asmTellTargetFeatures = do
Bool
do_tail_call <- WasmAsmM Bool
doTailCall
Builder -> WasmAsmM ()
asmTellSectionHeader Builder
".custom_section.target_features"
[WasmAsmM ()] -> WasmAsmM ()
asmTellVec
[ do
Builder -> WasmAsmM ()
asmTellTabLine Builder
".int8 0x2b"
ByteString -> WasmAsmM ()
asmTellBS ByteString
feature
| ByteString
feature <-
[ByteString
"tail-call" | Bool
do_tail_call]
[ByteString] -> [ByteString] -> [ByteString]
forall a. Semigroup a => a -> a -> a
<> [ ByteString
"bulk-memory",
ByteString
"mutable-globals",
ByteString
"nontrapping-fptoint",
ByteString
"reference-types",
ByteString
"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]
IntSet
UniqFM LocalReg LocalInfo
UniqSupply
SymMap ([SomeWasmType], [SomeWasmType])
SymMap (FuncBody w)
SymMap DataSection
Platform
wasmPlatform :: Platform
defaultSyms :: IntSet
funcTypes :: SymMap ([SomeWasmType], [SomeWasmType])
funcBodies :: SymMap (FuncBody w)
dataSections :: SymMap DataSection
ctors :: [SymName]
localRegs :: UniqFM LocalReg LocalInfo
localRegsCount :: Int
wasmUniqSupply :: UniqSupply
wasmPlatform :: forall (w :: WasmType). WasmCodeGenState w -> Platform
defaultSyms :: forall (w :: WasmType). WasmCodeGenState w -> IntSet
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
..} = 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
-> IntSet
-> SymName
-> (([SomeWasmType], [SomeWasmType]), FuncBody w)
-> WasmAsmM ()
forall (w :: WasmType).
WasmTypeTag w
-> IntSet
-> SymName
-> (([SomeWasmType], [SomeWasmType]), FuncBody w)
-> WasmAsmM ()
asmTellFunc WasmTypeTag w
ty_word IntSet
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 -> IntSet -> SymName -> DataSection -> WasmAsmM ()
forall (w :: WasmType).
WasmTypeTag w -> IntSet -> SymName -> DataSection -> WasmAsmM ()
asmTellDataSection WasmTypeTag w
ty_word IntSet
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