{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE FlexibleInstances #-}

module Language.Wasm.Binary (
    dumpModule,
    dumpModuleLazy,
    decodeModule,
    decodeModuleLazy
) where

import Language.Wasm.Structure

import Numeric.Natural (Natural)
import Data.Bits
import Data.Word (Word8, Word32, Word64)
import Data.Int (Int8, Int32, Int64)
import Data.Serialize
import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as LBS
import qualified Data.Text.Lazy as TL
import qualified Data.Text.Lazy.Encoding as TLEncoding

asInt32 :: Word32 -> Int32
asInt32 :: Word32 -> Int32
asInt32 Word32
w =
    if Word32
w Word32 -> Word32 -> Bool
forall a. Ord a => a -> a -> Bool
< Word32
0x80000000
    then Word32 -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
w
    else -Int32
1 Int32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
* Word32 -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32
0xFFFFFFFF Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
- Word32
w Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ Word32
1)

asInt64 :: Word64 -> Int64
asInt64 :: Word64 -> Int64
asInt64 Word64
w =
    if Word64
w Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
< Word64
0x8000000000000000
    then Word64 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
w
    else -Int64
1 Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
* Word64 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64
0xFFFFFFFFFFFFFFFF Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- Word64
w Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
1)

getULEB128 :: (Integral a, Bits a) => Int -> Get a
getULEB128 :: Int -> Get a
getULEB128 Int
bitsBudget = do
    if Int
bitsBudget Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 then () -> Get ()
forall (m :: * -> *) a. Monad m => a -> m a
return () else String -> Get ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"integer representation too long"
    Word8
val <- Get Word8
getWord8
    if Int
bitsBudget Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
7 Bool -> Bool -> Bool
|| Word8
val Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0x7F Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
< Word8
1 Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`shiftL` Int
bitsBudget then () -> Get ()
forall (m :: * -> *) a. Monad m => a -> m a
return () else String -> Get ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"integer too large"
    if Bool -> Bool
not (Word8 -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit Word8
val Int
7)
    then a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> Get a) -> a -> Get a
forall a b. (a -> b) -> a -> b
$ Word8 -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
val
    else do
        a
rest <- Int -> Get a
forall a. (Integral a, Bits a) => Int -> Get a
getULEB128 (Int
bitsBudget Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
7)
        a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> Get a) -> a -> Get a
forall a b. (a -> b) -> a -> b
$ (Word8 -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> a) -> Word8 -> a
forall a b. (a -> b) -> a -> b
$ Word8
val Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0x7F) a -> a -> a
forall a. Bits a => a -> a -> a
.|. (a
rest a -> Int -> a
forall a. Bits a => a -> Int -> a
`shiftL` Int
7)

putULEB128 :: (Integral a, Bits a) => a -> Put
putULEB128 :: a -> Put
putULEB128 a
val =
    if a
val a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
128
    then Putter Word8
putWord8 Putter Word8 -> Putter Word8
forall a b. (a -> b) -> a -> b
$ a -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
val
    else do
        Putter Word8
putWord8 Putter Word8 -> Putter Word8
forall a b. (a -> b) -> a -> b
$ Word8
0x80 Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
+ (Word8
0x7F Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. a -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
val)
        a -> Put
forall a. (Integral a, Bits a) => a -> Put
putULEB128 (a -> Put) -> a -> Put
forall a b. (a -> b) -> a -> b
$ a
val a -> Int -> a
forall a. Bits a => a -> Int -> a
`shiftR` Int
7

getSLEB128 :: (Integral a, Bits a) => Int -> Get a
getSLEB128 :: Int -> Get a
getSLEB128 Int
bitsBudget = do
    if Int
bitsBudget Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 then () -> Get ()
forall (m :: * -> *) a. Monad m => a -> m a
return () else String -> Get ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"integer representation too long"
    let toInt8 :: Word8 -> Int8
        toInt8 :: Word8 -> Int8
toInt8 = Word8 -> Int8
forall a b. (Integral a, Num b) => a -> b
fromIntegral
    Word8
a <- Get Word8
getWord8
    let mask :: Word8
mask = (Word8
0xFF Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`shiftL` (Int
bitsBudget Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)) Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0x7F
    if Int
bitsBudget Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
7 Bool -> Bool -> Bool
|| Word8
a Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
mask Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0 Bool -> Bool -> Bool
|| Word8
a Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
mask Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
mask then () -> Get ()
forall (m :: * -> *) a. Monad m => a -> m a
return () else String -> Get ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"integer too large"
    if Bool -> Bool
not (Word8 -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit Word8
a Int
7)
    then a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> Get a) -> (Word8 -> a) -> Word8 -> Get a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int8 -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int8 -> a) -> (Word8 -> Int8) -> Word8 -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Int8
toInt8 (Word8 -> Get a) -> Word8 -> Get a
forall a b. (a -> b) -> a -> b
$ (Word8
a Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0x7f) Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. ((Word8
a Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0x40) Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`shiftL` Int
1)
    else do
        a
b <- Int -> Get a
forall a. (Integral a, Bits a) => Int -> Get a
getSLEB128 (Int
bitsBudget Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
7)
        a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> Get a) -> a -> Get a
forall a b. (a -> b) -> a -> b
$ (a
b a -> Int -> a
forall a. Bits a => a -> Int -> a
`shiftL` Int
7) a -> a -> a
forall a. Bits a => a -> a -> a
.|. (Word8 -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8
a Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0x7f))

putSLEB128 :: (Integral a, Bits a) => a -> Put
putSLEB128 :: a -> Put
putSLEB128 a
a = a -> Put
go a
a
    where
        ext :: a
ext = if a
a a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
0 then a
0 else a -> a
forall a. Bits a => a -> a
complement a
0
        go :: a -> Put
go a
x = do
            let 
                r :: a
r = a
x a -> Int -> a
forall a. Bits a => a -> Int -> a
`shiftR` Int
7
                w :: a
w = a
x a -> a -> a
forall a. Bits a => a -> a -> a
.&. a
0x7f
            if a
r a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= a
ext
            then do
                Putter Word8
putWord8 (a -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
w Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. Word8
0x80)
                a -> Put
go a
r
            else
                if (a -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit a
w Int
6 Bool -> Bool -> Bool
&& a
a a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
0) Bool -> Bool -> Bool
|| (Bool -> Bool
not (a -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit a
w Int
6) Bool -> Bool -> Bool
&& a
a a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
0)
                then Putter Word8
putWord8 (a -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
w)
                else do
                    Putter Word8
putWord8 (a -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
w Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. Word8
0x80)
                    Putter Word8
putWord8 (a -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
ext Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0x7F)

putVec :: Serialize a => [a] -> Put
putVec :: [a] -> Put
putVec [a]
list = do
    Int -> Put
forall a. (Integral a, Bits a) => a -> Put
putULEB128 (Int -> Put) -> Int -> Put
forall a b. (a -> b) -> a -> b
$ [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
list
    (a -> Put) -> [a] -> PutM [()]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM a -> Put
forall t. Serialize t => Putter t
put [a]
list
    () -> Put
forall (m :: * -> *) a. Monad m => a -> m a
return ()

getVec :: Serialize a => Get [a]
getVec :: Get [a]
getVec = do
    Int
len <- Int -> Get Int
forall a. (Integral a, Bits a) => Int -> Get a
getULEB128 Int
32
    [Get a] -> Get [a]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence ([Get a] -> Get [a]) -> [Get a] -> Get [a]
forall a b. (a -> b) -> a -> b
$ Int -> Get a -> [Get a]
forall a. Int -> a -> [a]
replicate Int
len Get a
forall t. Serialize t => Get t
get

byteGuard :: Word8 -> Get ()
byteGuard :: Word8 -> Get ()
byteGuard Word8
expected = do
    Word8
byte <- Get Word8
getWord8
    if Word8
byte Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
expected
    then () -> Get ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    else String -> Get ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Get ()) -> String -> Get ()
forall a b. (a -> b) -> a -> b
$ String
"Expected " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Word8 -> String
forall a. Show a => a -> String
show Word8
expected String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
", but encountered " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Word8 -> String
forall a. Show a => a -> String
show Word8
byte

putSection :: SectionType -> Put -> Put
putSection :: SectionType -> Put -> Put
putSection SectionType
section Put
content = do
    Putter SectionType
forall t. Serialize t => Putter t
put SectionType
section
    let payload :: ByteString
payload = Put -> ByteString
runPut Put
content
    Int -> Put
forall a. (Integral a, Bits a) => a -> Put
putULEB128 (Int -> Put) -> Int -> Put
forall a b. (a -> b) -> a -> b
$ ByteString -> Int
BS.length ByteString
payload
    Putter ByteString
putByteString ByteString
payload

skipCustomSection :: Get ()
skipCustomSection :: Get ()
skipCustomSection = do
    Word8 -> Get ()
byteGuard Word8
0x00
    Int
size <- Int -> Get Int
forall a. (Integral a, Bits a) => Int -> Get a
getULEB128 Int
32
    ByteString
content <- Int -> Get ByteString
getByteString Int
size
    case Get Text -> ByteString -> Either String Text
forall a. Get a -> ByteString -> Either String a
runGet Get Text
getName ByteString
content of
        Right Text
_name -> () -> Get ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        Left String
_ -> String -> Get ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"invalid UTF-8 encoding"

getSection :: SectionType -> Get a -> a -> Get a
getSection :: SectionType -> Get a -> a -> Get a
getSection SectionType
sectionType Get a
parser a
def = do
    Bool
empty <- Get Bool
isEmpty
    if Bool
empty
    then a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return a
def
    else do
        Word8
nextByte <- Get Word8 -> Get Word8
forall a. Get a -> Get a
lookAhead Get Word8
getWord8
        Int -> Get a
parseSection (Int -> Get a) -> Int -> Get a
forall a b. (a -> b) -> a -> b
$ Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
nextByte
    where
        parseSection :: Int -> Get a
parseSection Int
op
            | Int
op Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = Get ()
skipCustomSection Get () -> Get a -> Get a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> SectionType -> Get a -> a -> Get a
forall a. SectionType -> Get a -> a -> Get a
getSection SectionType
sectionType Get a
parser a
def
            | Int
op Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== SectionType -> Int
forall a. Enum a => a -> Int
fromEnum SectionType
sectionType = do
                Get Word8
getWord8
                Int
len <- Int -> Get Int
forall a. (Integral a, Bits a) => Int -> Get a
getULEB128 Int
32
                Int -> Get a -> Get a
forall a. Int -> Get a -> Get a
isolate Int
len Get a
parser
            | Int
op Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> SectionType -> Int
forall a. Enum a => a -> Int
fromEnum SectionType
DataSection = String -> Get a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"invalid section id"
            | Int
op Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> SectionType -> Int
forall a. Enum a => a -> Int
fromEnum SectionType
sectionType = a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return a
def
            | Bool
otherwise =
                String -> Get a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Get a) -> String -> Get a
forall a b. (a -> b) -> a -> b
$ String
"Incorrect order of sections. Expected " String -> String -> String
forall a. [a] -> [a] -> [a]
++ SectionType -> String
forall a. Show a => a -> String
show SectionType
sectionType
                    String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
", but found " String -> String -> String
forall a. [a] -> [a] -> [a]
++ SectionType -> String
forall a. Show a => a -> String
show (Int -> SectionType
forall a. Enum a => Int -> a
toEnum Int
op :: SectionType)

putName :: TL.Text -> Put
putName :: Text -> Put
putName Text
txt = do
    let bs :: ByteString
bs = Text -> ByteString
TLEncoding.encodeUtf8 Text
txt
    Int64 -> Put
forall a. (Integral a, Bits a) => a -> Put
putULEB128 (Int64 -> Put) -> Int64 -> Put
forall a b. (a -> b) -> a -> b
$ ByteString -> Int64
LBS.length ByteString
bs
    Putter ByteString
putLazyByteString ByteString
bs

getName :: Get TL.Text
getName :: Get Text
getName = do
    Int64
len <- Int -> Get Int64
forall a. (Integral a, Bits a) => Int -> Get a
getULEB128 Int
32
    ByteString
bytes <- Int64 -> Get ByteString
getLazyByteString Int64
len
    case ByteString -> Either UnicodeException Text
TLEncoding.decodeUtf8' ByteString
bytes of
        Right Text
name -> Text -> Get Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
name
        Left UnicodeException
_ -> String -> Get Text
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"invalid UTF-8 encoding"

putResultType :: ResultType -> Put
putResultType :: ResultType -> Put
putResultType [] = Putter Word8
putWord8 Word8
0x40
putResultType [ValueType
valType] = Putter ValueType
forall t. Serialize t => Putter t
put ValueType
valType
putResultType ResultType
_ = String -> Put
forall a. HasCallStack => String -> a
error String
"Current WebAssembly spec does not support returning more then one value"

getResultType :: Get ResultType
getResultType :: Get ResultType
getResultType = do
    Word8
op <- Get Word8
getWord8
    case Word8
op of
        Word8
0x40 -> ResultType -> Get ResultType
forall (m :: * -> *) a. Monad m => a -> m a
return []
        Word8
0x7F -> ResultType -> Get ResultType
forall (m :: * -> *) a. Monad m => a -> m a
return [ValueType
I32]
        Word8
0x7E -> ResultType -> Get ResultType
forall (m :: * -> *) a. Monad m => a -> m a
return [ValueType
I64]
        Word8
0x7D -> ResultType -> Get ResultType
forall (m :: * -> *) a. Monad m => a -> m a
return [ValueType
F32]
        Word8
0x7C -> ResultType -> Get ResultType
forall (m :: * -> *) a. Monad m => a -> m a
return [ValueType
F64]
        Word8
_ -> String -> Get ResultType
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"unexpected byte in result type position"

putBlockType :: BlockType -> Put
putBlockType :: BlockType -> Put
putBlockType (Inline Maybe ValueType
Nothing) = Putter Word8
putWord8 Word8
0x40
putBlockType (Inline (Just ValueType
valType)) = Putter ValueType
forall t. Serialize t => Putter t
put ValueType
valType
putBlockType (TypeIndex TypeIndex
idx) = TypeIndex -> Put
forall a. (Integral a, Bits a) => a -> Put
putSLEB128 TypeIndex
idx

getInlineBlockType :: Get (Maybe (Maybe ValueType))
getInlineBlockType :: Get (Maybe (Maybe ValueType))
getInlineBlockType = do
    Word8
op <- Get Word8
getWord8
    case Word8
op of
        Word8
0x40 -> Maybe (Maybe ValueType) -> Get (Maybe (Maybe ValueType))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Maybe ValueType) -> Get (Maybe (Maybe ValueType)))
-> Maybe (Maybe ValueType) -> Get (Maybe (Maybe ValueType))
forall a b. (a -> b) -> a -> b
$ Maybe ValueType -> Maybe (Maybe ValueType)
forall a. a -> Maybe a
Just Maybe ValueType
forall a. Maybe a
Nothing
        Word8
0x7F -> Maybe (Maybe ValueType) -> Get (Maybe (Maybe ValueType))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Maybe ValueType) -> Get (Maybe (Maybe ValueType)))
-> Maybe (Maybe ValueType) -> Get (Maybe (Maybe ValueType))
forall a b. (a -> b) -> a -> b
$ Maybe ValueType -> Maybe (Maybe ValueType)
forall a. a -> Maybe a
Just (ValueType -> Maybe ValueType
forall a. a -> Maybe a
Just ValueType
I32)
        Word8
0x7E -> Maybe (Maybe ValueType) -> Get (Maybe (Maybe ValueType))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Maybe ValueType) -> Get (Maybe (Maybe ValueType)))
-> Maybe (Maybe ValueType) -> Get (Maybe (Maybe ValueType))
forall a b. (a -> b) -> a -> b
$ Maybe ValueType -> Maybe (Maybe ValueType)
forall a. a -> Maybe a
Just (ValueType -> Maybe ValueType
forall a. a -> Maybe a
Just ValueType
I64)
        Word8
0x7D -> Maybe (Maybe ValueType) -> Get (Maybe (Maybe ValueType))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Maybe ValueType) -> Get (Maybe (Maybe ValueType)))
-> Maybe (Maybe ValueType) -> Get (Maybe (Maybe ValueType))
forall a b. (a -> b) -> a -> b
$ Maybe ValueType -> Maybe (Maybe ValueType)
forall a. a -> Maybe a
Just (ValueType -> Maybe ValueType
forall a. a -> Maybe a
Just ValueType
F32)
        Word8
0x7C -> Maybe (Maybe ValueType) -> Get (Maybe (Maybe ValueType))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Maybe ValueType) -> Get (Maybe (Maybe ValueType)))
-> Maybe (Maybe ValueType) -> Get (Maybe (Maybe ValueType))
forall a b. (a -> b) -> a -> b
$ Maybe ValueType -> Maybe (Maybe ValueType)
forall a. a -> Maybe a
Just (ValueType -> Maybe ValueType
forall a. a -> Maybe a
Just ValueType
F64)
        Word8
_ -> Maybe (Maybe ValueType) -> Get (Maybe (Maybe ValueType))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Maybe ValueType)
forall a. Maybe a
Nothing

getBlockType :: Get BlockType
getBlockType :: Get BlockType
getBlockType = do
    Maybe (Maybe ValueType)
inlineType <- Get (Maybe (Maybe ValueType)) -> Get (Maybe (Maybe ValueType))
forall a. Get (Maybe a) -> Get (Maybe a)
lookAheadM Get (Maybe (Maybe ValueType))
getInlineBlockType
    case Maybe (Maybe ValueType)
inlineType of
        Just Maybe ValueType
inline -> BlockType -> Get BlockType
forall (m :: * -> *) a. Monad m => a -> m a
return (BlockType -> Get BlockType) -> BlockType -> Get BlockType
forall a b. (a -> b) -> a -> b
$ Maybe ValueType -> BlockType
Inline Maybe ValueType
inline
        Maybe (Maybe ValueType)
Nothing -> TypeIndex -> BlockType
TypeIndex (TypeIndex -> BlockType) -> Get TypeIndex -> Get BlockType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Get TypeIndex
forall a. (Integral a, Bits a) => Int -> Get a
getSLEB128 Int
33

data SectionType =
    CustomSection
    | TypeSection
    | ImportSection
    | FunctionSection
    | TableSection
    | MemorySection
    | GlobalSection
    | ExportSection
    | StartSection
    | ElementSection
    | CodeSection
    | DataSection
    deriving (SectionType -> SectionType -> Bool
(SectionType -> SectionType -> Bool)
-> (SectionType -> SectionType -> Bool) -> Eq SectionType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SectionType -> SectionType -> Bool
$c/= :: SectionType -> SectionType -> Bool
== :: SectionType -> SectionType -> Bool
$c== :: SectionType -> SectionType -> Bool
Eq, Int -> SectionType -> String -> String
[SectionType] -> String -> String
SectionType -> String
(Int -> SectionType -> String -> String)
-> (SectionType -> String)
-> ([SectionType] -> String -> String)
-> Show SectionType
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [SectionType] -> String -> String
$cshowList :: [SectionType] -> String -> String
show :: SectionType -> String
$cshow :: SectionType -> String
showsPrec :: Int -> SectionType -> String -> String
$cshowsPrec :: Int -> SectionType -> String -> String
Show, Int -> SectionType
SectionType -> Int
SectionType -> [SectionType]
SectionType -> SectionType
SectionType -> SectionType -> [SectionType]
SectionType -> SectionType -> SectionType -> [SectionType]
(SectionType -> SectionType)
-> (SectionType -> SectionType)
-> (Int -> SectionType)
-> (SectionType -> Int)
-> (SectionType -> [SectionType])
-> (SectionType -> SectionType -> [SectionType])
-> (SectionType -> SectionType -> [SectionType])
-> (SectionType -> SectionType -> SectionType -> [SectionType])
-> Enum SectionType
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: SectionType -> SectionType -> SectionType -> [SectionType]
$cenumFromThenTo :: SectionType -> SectionType -> SectionType -> [SectionType]
enumFromTo :: SectionType -> SectionType -> [SectionType]
$cenumFromTo :: SectionType -> SectionType -> [SectionType]
enumFromThen :: SectionType -> SectionType -> [SectionType]
$cenumFromThen :: SectionType -> SectionType -> [SectionType]
enumFrom :: SectionType -> [SectionType]
$cenumFrom :: SectionType -> [SectionType]
fromEnum :: SectionType -> Int
$cfromEnum :: SectionType -> Int
toEnum :: Int -> SectionType
$ctoEnum :: Int -> SectionType
pred :: SectionType -> SectionType
$cpred :: SectionType -> SectionType
succ :: SectionType -> SectionType
$csucc :: SectionType -> SectionType
Enum)

instance Serialize SectionType where
    put :: Putter SectionType
put SectionType
section = Putter Word8
putWord8 Putter Word8 -> Putter Word8
forall a b. (a -> b) -> a -> b
$ Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word8) -> Int -> Word8
forall a b. (a -> b) -> a -> b
$ SectionType -> Int
forall a. Enum a => a -> Int
fromEnum SectionType
section
    get :: Get SectionType
get = do
        Int
op <- Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> Int) -> Get Word8 -> Get Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Get Word8
getWord8
        if Int
op Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= SectionType -> Int
forall a. Enum a => a -> Int
fromEnum SectionType
DataSection
        then SectionType -> Get SectionType
forall (m :: * -> *) a. Monad m => a -> m a
return (SectionType -> Get SectionType) -> SectionType -> Get SectionType
forall a b. (a -> b) -> a -> b
$ Int -> SectionType
forall a. Enum a => Int -> a
toEnum Int
op
        else String -> Get SectionType
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Unexpected byte in section type position"

instance Serialize ValueType where
    put :: Putter ValueType
put ValueType
I32 = Putter Word8
putWord8 Word8
0x7F
    put ValueType
I64 = Putter Word8
putWord8 Word8
0x7E
    put ValueType
F32 = Putter Word8
putWord8 Word8
0x7D
    put ValueType
F64 = Putter Word8
putWord8 Word8
0x7C

    get :: Get ValueType
get = do
        Word8
op <- Get Word8
getWord8
        case Word8
op of
            Word8
0x7F -> ValueType -> Get ValueType
forall (m :: * -> *) a. Monad m => a -> m a
return ValueType
I32
            Word8
0x7E -> ValueType -> Get ValueType
forall (m :: * -> *) a. Monad m => a -> m a
return ValueType
I64
            Word8
0x7D -> ValueType -> Get ValueType
forall (m :: * -> *) a. Monad m => a -> m a
return ValueType
F32
            Word8
0x7C -> ValueType -> Get ValueType
forall (m :: * -> *) a. Monad m => a -> m a
return ValueType
F64
            Word8
_ -> String -> Get ValueType
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"unexpected byte in value type position"

instance Serialize FuncType where
    put :: Putter FuncType
put FuncType {ResultType
$sel:params:FuncType :: FuncType -> ResultType
params :: ResultType
params, ResultType
$sel:results:FuncType :: FuncType -> ResultType
results :: ResultType
results} = do
        Putter Word8
putWord8 Word8
0x60
        ResultType -> Put
forall a. Serialize a => [a] -> Put
putVec ResultType
params
        ResultType -> Put
forall a. Serialize a => [a] -> Put
putVec ResultType
results
    get :: Get FuncType
get = do
        Word8 -> Get ()
byteGuard Word8
0x60
        ResultType
params <- Get ResultType
forall a. Serialize a => Get [a]
getVec
        ResultType
results <- Get ResultType
forall a. Serialize a => Get [a]
getVec
        FuncType -> Get FuncType
forall (m :: * -> *) a. Monad m => a -> m a
return (FuncType -> Get FuncType) -> FuncType -> Get FuncType
forall a b. (a -> b) -> a -> b
$ FuncType :: ResultType -> ResultType -> FuncType
FuncType { ResultType
params :: ResultType
$sel:params:FuncType :: ResultType
params, ResultType
results :: ResultType
$sel:results:FuncType :: ResultType
results }

instance Serialize ElemType where
    put :: Putter ElemType
put ElemType
FuncRef = Putter Word8
putWord8 Word8
0x70
    get :: Get ElemType
get = Word8 -> Get ()
byteGuard Word8
0x70 Get () -> Get ElemType -> Get ElemType
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ElemType -> Get ElemType
forall (m :: * -> *) a. Monad m => a -> m a
return ElemType
FuncRef

instance Serialize Limit where
    put :: Putter Limit
put (Limit TypeIndex
min Maybe TypeIndex
Nothing) = Putter Word8
putWord8 Word8
0x00 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> TypeIndex -> Put
forall a. (Integral a, Bits a) => a -> Put
putULEB128 TypeIndex
min
    put (Limit TypeIndex
min (Just TypeIndex
max)) = Putter Word8
putWord8 Word8
0x01 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> TypeIndex -> Put
forall a. (Integral a, Bits a) => a -> Put
putULEB128 TypeIndex
min Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> TypeIndex -> Put
forall a. (Integral a, Bits a) => a -> Put
putULEB128 TypeIndex
max
    get :: Get Limit
get = do
        Word8
op <- Get Word8
getWord8
        case Word8
op of
            Word8
0x00 -> do
                TypeIndex
min <- Int -> Get TypeIndex
forall a. (Integral a, Bits a) => Int -> Get a
getULEB128 Int
32
                Limit -> Get Limit
forall (m :: * -> *) a. Monad m => a -> m a
return (Limit -> Get Limit) -> Limit -> Get Limit
forall a b. (a -> b) -> a -> b
$ TypeIndex -> Maybe TypeIndex -> Limit
Limit TypeIndex
min Maybe TypeIndex
forall a. Maybe a
Nothing
            Word8
0x01 -> do
                TypeIndex
min <- Int -> Get TypeIndex
forall a. (Integral a, Bits a) => Int -> Get a
getULEB128 Int
32
                TypeIndex
max <- Int -> Get TypeIndex
forall a. (Integral a, Bits a) => Int -> Get a
getULEB128 Int
32
                Limit -> Get Limit
forall (m :: * -> *) a. Monad m => a -> m a
return (Limit -> Get Limit) -> Limit -> Get Limit
forall a b. (a -> b) -> a -> b
$ TypeIndex -> Maybe TypeIndex -> Limit
Limit TypeIndex
min (TypeIndex -> Maybe TypeIndex
forall a. a -> Maybe a
Just TypeIndex
max)
            Word8
_ -> String -> Get Limit
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Unexpected byte in place of Limit opcode"

instance Serialize TableType where
    put :: Putter TableType
put (TableType Limit
limit ElemType
elemType) = do
        Putter ElemType
forall t. Serialize t => Putter t
put ElemType
elemType
        Putter Limit
forall t. Serialize t => Putter t
put Limit
limit
    get :: Get TableType
get = do
        ElemType
elemType <- Get ElemType
forall t. Serialize t => Get t
get
        Limit
limit <- Get Limit
forall t. Serialize t => Get t
get
        TableType -> Get TableType
forall (m :: * -> *) a. Monad m => a -> m a
return (TableType -> Get TableType) -> TableType -> Get TableType
forall a b. (a -> b) -> a -> b
$ Limit -> ElemType -> TableType
TableType Limit
limit ElemType
elemType

instance Serialize GlobalType where
    put :: Putter GlobalType
put (Const ValueType
valType) = Putter ValueType
forall t. Serialize t => Putter t
put ValueType
valType Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Putter Word8
putWord8 Word8
0x00
    put (Mut ValueType
valType) = Putter ValueType
forall t. Serialize t => Putter t
put ValueType
valType Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Putter Word8
putWord8 Word8
0x01
    get :: Get GlobalType
get = do
        ValueType
valType <- Get ValueType
forall t. Serialize t => Get t
get
        Word8
op <- Get Word8
getWord8
        case Word8
op of
            Word8
0x00 -> GlobalType -> Get GlobalType
forall (m :: * -> *) a. Monad m => a -> m a
return (GlobalType -> Get GlobalType) -> GlobalType -> Get GlobalType
forall a b. (a -> b) -> a -> b
$ ValueType -> GlobalType
Const ValueType
valType
            Word8
0x01 -> GlobalType -> Get GlobalType
forall (m :: * -> *) a. Monad m => a -> m a
return (GlobalType -> Get GlobalType) -> GlobalType -> Get GlobalType
forall a b. (a -> b) -> a -> b
$ ValueType -> GlobalType
Mut ValueType
valType
            Word8
_ -> String -> Get GlobalType
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"invalid mutability"

instance Serialize ImportDesc where
    put :: Putter ImportDesc
put (ImportFunc TypeIndex
typeIdx) = Putter Word8
putWord8 Word8
0x00 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> TypeIndex -> Put
forall a. (Integral a, Bits a) => a -> Put
putULEB128 TypeIndex
typeIdx
    put (ImportTable TableType
tableType) = Putter Word8
putWord8 Word8
0x01 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Putter TableType
forall t. Serialize t => Putter t
put TableType
tableType
    put (ImportMemory Limit
memType) = Putter Word8
putWord8 Word8
0x02 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Putter Limit
forall t. Serialize t => Putter t
put Limit
memType
    put (ImportGlobal GlobalType
globalType) = Putter Word8
putWord8 Word8
0x03 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Putter GlobalType
forall t. Serialize t => Putter t
put GlobalType
globalType
    get :: Get ImportDesc
get = do
        Word8
op <- Get Word8
getWord8
        case Word8
op of
            Word8
0x00 -> TypeIndex -> ImportDesc
ImportFunc (TypeIndex -> ImportDesc) -> Get TypeIndex -> Get ImportDesc
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Get TypeIndex
forall a. (Integral a, Bits a) => Int -> Get a
getULEB128 Int
32
            Word8
0x01 -> TableType -> ImportDesc
ImportTable (TableType -> ImportDesc) -> Get TableType -> Get ImportDesc
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get TableType
forall t. Serialize t => Get t
get
            Word8
0x02 -> Limit -> ImportDesc
ImportMemory (Limit -> ImportDesc) -> Get Limit -> Get ImportDesc
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Limit
forall t. Serialize t => Get t
get
            Word8
0x03 -> GlobalType -> ImportDesc
ImportGlobal (GlobalType -> ImportDesc) -> Get GlobalType -> Get ImportDesc
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get GlobalType
forall t. Serialize t => Get t
get
            Word8
_ -> String -> Get ImportDesc
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Unexpected byte in place of Import Declaration opcode"

instance Serialize Import where
    put :: Putter Import
put (Import Text
sourceModule Text
name ImportDesc
desc) = do
        Text -> Put
putName Text
sourceModule
        Text -> Put
putName Text
name
        Putter ImportDesc
forall t. Serialize t => Putter t
put ImportDesc
desc
    get :: Get Import
get = do
        Text
sourceModule <- Get Text
getName
        Text
name <- Get Text
getName
        ImportDesc
desc <- Get ImportDesc
forall t. Serialize t => Get t
get
        Import -> Get Import
forall (m :: * -> *) a. Monad m => a -> m a
return (Import -> Get Import) -> Import -> Get Import
forall a b. (a -> b) -> a -> b
$ Text -> Text -> ImportDesc -> Import
Import Text
sourceModule Text
name ImportDesc
desc

instance Serialize Table where
    put :: Putter Table
put (Table TableType
tableType) = Putter TableType
forall t. Serialize t => Putter t
put TableType
tableType
    get :: Get Table
get = TableType -> Table
Table (TableType -> Table) -> Get TableType -> Get Table
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get TableType
forall t. Serialize t => Get t
get

instance Serialize Memory where
    put :: Putter Memory
put (Memory Limit
limit) = Putter Limit
forall t. Serialize t => Putter t
put Limit
limit
    get :: Get Memory
get = Limit -> Memory
Memory (Limit -> Memory) -> Get Limit -> Get Memory
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Limit
forall t. Serialize t => Get t
get

newtype Index = Index { Index -> TypeIndex
unIndex :: Natural } deriving (Int -> Index -> String -> String
[Index] -> String -> String
Index -> String
(Int -> Index -> String -> String)
-> (Index -> String) -> ([Index] -> String -> String) -> Show Index
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [Index] -> String -> String
$cshowList :: [Index] -> String -> String
show :: Index -> String
$cshow :: Index -> String
showsPrec :: Int -> Index -> String -> String
$cshowsPrec :: Int -> Index -> String -> String
Show, Index -> Index -> Bool
(Index -> Index -> Bool) -> (Index -> Index -> Bool) -> Eq Index
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Index -> Index -> Bool
$c/= :: Index -> Index -> Bool
== :: Index -> Index -> Bool
$c== :: Index -> Index -> Bool
Eq)

instance Serialize Index where
    put :: Putter Index
put (Index TypeIndex
idx) = TypeIndex -> Put
forall a. (Integral a, Bits a) => a -> Put
putULEB128 TypeIndex
idx
    get :: Get Index
get = TypeIndex -> Index
Index (TypeIndex -> Index) -> Get TypeIndex -> Get Index
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Get TypeIndex
forall a. (Integral a, Bits a) => Int -> Get a
getULEB128 Int
32

instance Serialize MemArg where
    put :: Putter MemArg
put MemArg { TypeIndex
$sel:align:MemArg :: MemArg -> TypeIndex
align :: TypeIndex
align, TypeIndex
$sel:offset:MemArg :: MemArg -> TypeIndex
offset :: TypeIndex
offset } = TypeIndex -> Put
forall a. (Integral a, Bits a) => a -> Put
putULEB128 TypeIndex
align Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> TypeIndex -> Put
forall a. (Integral a, Bits a) => a -> Put
putULEB128 TypeIndex
offset
    get :: Get MemArg
get = do
        TypeIndex
align <- Int -> Get TypeIndex
forall a. (Integral a, Bits a) => Int -> Get a
getULEB128 Int
32
        TypeIndex
offset <- Int -> Get TypeIndex
forall a. (Integral a, Bits a) => Int -> Get a
getULEB128 Int
32
        MemArg -> Get MemArg
forall (m :: * -> *) a. Monad m => a -> m a
return (MemArg -> Get MemArg) -> MemArg -> Get MemArg
forall a b. (a -> b) -> a -> b
$ MemArg :: TypeIndex -> TypeIndex -> MemArg
MemArg { TypeIndex
align :: TypeIndex
$sel:align:MemArg :: TypeIndex
align, TypeIndex
offset :: TypeIndex
$sel:offset:MemArg :: TypeIndex
offset }

instance Serialize (Instruction Natural) where
    put :: Putter (Instruction TypeIndex)
put Instruction TypeIndex
Unreachable = Putter Word8
putWord8 Word8
0x00
    put Instruction TypeIndex
Nop = Putter Word8
putWord8 Word8
0x01
    put (Block BlockType
blockType Expression
body) = do
        Putter Word8
putWord8 Word8
0x02
        BlockType -> Put
putBlockType BlockType
blockType
        Expression -> Put
putExpression Expression
body
    put (Loop BlockType
blockType Expression
body) = do
        Putter Word8
putWord8 Word8
0x03
        BlockType -> Put
putBlockType BlockType
blockType
        Expression -> Put
putExpression Expression
body
    put If {BlockType
$sel:blockType:Unreachable :: forall index. Instruction index -> BlockType
blockType :: BlockType
blockType, Expression
$sel:true:Unreachable :: forall index. Instruction index -> Expression
true :: Expression
true, $sel:false:Unreachable :: forall index. Instruction index -> Expression
false = []} = do
        Putter Word8
putWord8 Word8
0x04
        BlockType -> Put
putBlockType BlockType
blockType
        Expression -> Put
putExpression Expression
true
    put If {BlockType
blockType :: BlockType
$sel:blockType:Unreachable :: forall index. Instruction index -> BlockType
blockType, Expression
true :: Expression
$sel:true:Unreachable :: forall index. Instruction index -> Expression
true, Expression
false :: Expression
$sel:false:Unreachable :: forall index. Instruction index -> Expression
false} = do
        Putter Word8
putWord8 Word8
0x04
        BlockType -> Put
putBlockType BlockType
blockType
        Putter (Instruction TypeIndex) -> Expression -> Put
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Putter (Instruction TypeIndex)
forall t. Serialize t => Putter t
put Expression
true
        Putter Word8
putWord8 Word8
0x05 -- ELSE
        Expression -> Put
putExpression Expression
false
    put (Br TypeIndex
labelIdx) = Putter Word8
putWord8 Word8
0x0C Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> TypeIndex -> Put
forall a. (Integral a, Bits a) => a -> Put
putULEB128 TypeIndex
labelIdx
    put (BrIf TypeIndex
labelIdx) = Putter Word8
putWord8 Word8
0x0D Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> TypeIndex -> Put
forall a. (Integral a, Bits a) => a -> Put
putULEB128 TypeIndex
labelIdx
    put (BrTable [TypeIndex]
labels TypeIndex
label) = Putter Word8
putWord8 Word8
0x0E Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Index] -> Put
forall a. Serialize a => [a] -> Put
putVec ((TypeIndex -> Index) -> [TypeIndex] -> [Index]
forall a b. (a -> b) -> [a] -> [b]
map TypeIndex -> Index
Index [TypeIndex]
labels) Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> TypeIndex -> Put
forall a. (Integral a, Bits a) => a -> Put
putULEB128 TypeIndex
label
    put Instruction TypeIndex
Return = Putter Word8
putWord8 Word8
0x0F
    put (Call TypeIndex
funcIdx) = Putter Word8
putWord8 Word8
0x10 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> TypeIndex -> Put
forall a. (Integral a, Bits a) => a -> Put
putULEB128 TypeIndex
funcIdx
    put (CallIndirect TypeIndex
typeIdx) = Putter Word8
putWord8 Word8
0x11 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> TypeIndex -> Put
forall a. (Integral a, Bits a) => a -> Put
putULEB128 TypeIndex
typeIdx Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Putter Word8
putWord8 Word8
0x00
    -- Parametric instructions
    put Instruction TypeIndex
Drop = Putter Word8
putWord8 Word8
0x1A
    put Instruction TypeIndex
Select = Putter Word8
putWord8 Word8
0x1B
    -- Variable instructions
    put (GetLocal TypeIndex
idx) = Putter Word8
putWord8 Word8
0x20 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> TypeIndex -> Put
forall a. (Integral a, Bits a) => a -> Put
putULEB128 TypeIndex
idx
    put (SetLocal TypeIndex
idx) = Putter Word8
putWord8 Word8
0x21 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> TypeIndex -> Put
forall a. (Integral a, Bits a) => a -> Put
putULEB128 TypeIndex
idx
    put (TeeLocal TypeIndex
idx) = Putter Word8
putWord8 Word8
0x22 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> TypeIndex -> Put
forall a. (Integral a, Bits a) => a -> Put
putULEB128 TypeIndex
idx
    put (GetGlobal TypeIndex
idx) = Putter Word8
putWord8 Word8
0x23 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> TypeIndex -> Put
forall a. (Integral a, Bits a) => a -> Put
putULEB128 TypeIndex
idx
    put (SetGlobal TypeIndex
idx) = Putter Word8
putWord8 Word8
0x24 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> TypeIndex -> Put
forall a. (Integral a, Bits a) => a -> Put
putULEB128 TypeIndex
idx
    -- Memory instructions
    put (I32Load MemArg
memArg) = Putter Word8
putWord8 Word8
0x28 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Putter MemArg
forall t. Serialize t => Putter t
put MemArg
memArg
    put (I64Load MemArg
memArg) = Putter Word8
putWord8 Word8
0x29 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Putter MemArg
forall t. Serialize t => Putter t
put MemArg
memArg
    put (F32Load MemArg
memArg) = Putter Word8
putWord8 Word8
0x2A Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Putter MemArg
forall t. Serialize t => Putter t
put MemArg
memArg
    put (F64Load MemArg
memArg) = Putter Word8
putWord8 Word8
0x2B Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Putter MemArg
forall t. Serialize t => Putter t
put MemArg
memArg
    put (I32Load8S MemArg
memArg) = Putter Word8
putWord8 Word8
0x2C Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Putter MemArg
forall t. Serialize t => Putter t
put MemArg
memArg
    put (I32Load8U MemArg
memArg) = Putter Word8
putWord8 Word8
0x2D Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Putter MemArg
forall t. Serialize t => Putter t
put MemArg
memArg
    put (I32Load16S MemArg
memArg) = Putter Word8
putWord8 Word8
0x2E Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Putter MemArg
forall t. Serialize t => Putter t
put MemArg
memArg
    put (I32Load16U MemArg
memArg) = Putter Word8
putWord8 Word8
0x2F Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Putter MemArg
forall t. Serialize t => Putter t
put MemArg
memArg
    put (I64Load8S MemArg
memArg) = Putter Word8
putWord8 Word8
0x30 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Putter MemArg
forall t. Serialize t => Putter t
put MemArg
memArg
    put (I64Load8U MemArg
memArg) = Putter Word8
putWord8 Word8
0x31 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Putter MemArg
forall t. Serialize t => Putter t
put MemArg
memArg
    put (I64Load16S MemArg
memArg) = Putter Word8
putWord8 Word8
0x32 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Putter MemArg
forall t. Serialize t => Putter t
put MemArg
memArg
    put (I64Load16U MemArg
memArg) = Putter Word8
putWord8 Word8
0x33 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Putter MemArg
forall t. Serialize t => Putter t
put MemArg
memArg
    put (I64Load32S MemArg
memArg) = Putter Word8
putWord8 Word8
0x34 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Putter MemArg
forall t. Serialize t => Putter t
put MemArg
memArg
    put (I64Load32U MemArg
memArg) = Putter Word8
putWord8 Word8
0x35 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Putter MemArg
forall t. Serialize t => Putter t
put MemArg
memArg
    put (I32Store MemArg
memArg) = Putter Word8
putWord8 Word8
0x36 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Putter MemArg
forall t. Serialize t => Putter t
put MemArg
memArg
    put (I64Store MemArg
memArg) = Putter Word8
putWord8 Word8
0x37 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Putter MemArg
forall t. Serialize t => Putter t
put MemArg
memArg
    put (F32Store MemArg
memArg) = Putter Word8
putWord8 Word8
0x38 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Putter MemArg
forall t. Serialize t => Putter t
put MemArg
memArg
    put (F64Store MemArg
memArg) = Putter Word8
putWord8 Word8
0x39 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Putter MemArg
forall t. Serialize t => Putter t
put MemArg
memArg
    put (I32Store8 MemArg
memArg) = Putter Word8
putWord8 Word8
0x3A Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Putter MemArg
forall t. Serialize t => Putter t
put MemArg
memArg
    put (I32Store16 MemArg
memArg) = Putter Word8
putWord8 Word8
0x3B Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Putter MemArg
forall t. Serialize t => Putter t
put MemArg
memArg
    put (I64Store8 MemArg
memArg) = Putter Word8
putWord8 Word8
0x3C Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Putter MemArg
forall t. Serialize t => Putter t
put MemArg
memArg
    put (I64Store16 MemArg
memArg) = Putter Word8
putWord8 Word8
0x3D Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Putter MemArg
forall t. Serialize t => Putter t
put MemArg
memArg
    put (I64Store32 MemArg
memArg) = Putter Word8
putWord8 Word8
0x3E Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Putter MemArg
forall t. Serialize t => Putter t
put MemArg
memArg
    put Instruction TypeIndex
CurrentMemory = Putter Word8
putWord8 Word8
0x3F Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Putter Word8
putWord8 Word8
0x00
    put Instruction TypeIndex
GrowMemory = Putter Word8
putWord8 Word8
0x40 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Putter Word8
putWord8 Word8
0x00
    -- Numeric instructions
    put (I32Const Word32
val) = Putter Word8
putWord8 Word8
0x41 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int32 -> Put
forall a. (Integral a, Bits a) => a -> Put
putSLEB128 (Word32 -> Int32
asInt32 Word32
val)
    put (I64Const Word64
val) = Putter Word8
putWord8 Word8
0x42 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int64 -> Put
forall a. (Integral a, Bits a) => a -> Put
putSLEB128 (Word64 -> Int64
asInt64 Word64
val)
    put (F32Const Float
val) = Putter Word8
putWord8 Word8
0x43 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Float -> Put
putFloat32le Float
val
    put (F64Const Double
val) = Putter Word8
putWord8 Word8
0x44 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Double -> Put
putFloat64le Double
val
    put Instruction TypeIndex
I32Eqz = Putter Word8
putWord8 Word8
0x45
    put (IRelOp BitSize
BS32 IRelOp
IEq) = Putter Word8
putWord8 Word8
0x46
    put (IRelOp BitSize
BS32 IRelOp
INe) = Putter Word8
putWord8 Word8
0x47
    put (IRelOp BitSize
BS32 IRelOp
ILtS) = Putter Word8
putWord8 Word8
0x48
    put (IRelOp BitSize
BS32 IRelOp
ILtU) = Putter Word8
putWord8 Word8
0x49
    put (IRelOp BitSize
BS32 IRelOp
IGtS) = Putter Word8
putWord8 Word8
0x4A
    put (IRelOp BitSize
BS32 IRelOp
IGtU) = Putter Word8
putWord8 Word8
0x4B
    put (IRelOp BitSize
BS32 IRelOp
ILeS) = Putter Word8
putWord8 Word8
0x4C
    put (IRelOp BitSize
BS32 IRelOp
ILeU) = Putter Word8
putWord8 Word8
0x4D
    put (IRelOp BitSize
BS32 IRelOp
IGeS) = Putter Word8
putWord8 Word8
0x4E
    put (IRelOp BitSize
BS32 IRelOp
IGeU) = Putter Word8
putWord8 Word8
0x4F
    put Instruction TypeIndex
I64Eqz = Putter Word8
putWord8 Word8
0x50
    put (IRelOp BitSize
BS64 IRelOp
IEq) = Putter Word8
putWord8 Word8
0x51
    put (IRelOp BitSize
BS64 IRelOp
INe) = Putter Word8
putWord8 Word8
0x52
    put (IRelOp BitSize
BS64 IRelOp
ILtS) = Putter Word8
putWord8 Word8
0x53
    put (IRelOp BitSize
BS64 IRelOp
ILtU) = Putter Word8
putWord8 Word8
0x54
    put (IRelOp BitSize
BS64 IRelOp
IGtS) = Putter Word8
putWord8 Word8
0x55
    put (IRelOp BitSize
BS64 IRelOp
IGtU) = Putter Word8
putWord8 Word8
0x56
    put (IRelOp BitSize
BS64 IRelOp
ILeS) = Putter Word8
putWord8 Word8
0x57
    put (IRelOp BitSize
BS64 IRelOp
ILeU) = Putter Word8
putWord8 Word8
0x58
    put (IRelOp BitSize
BS64 IRelOp
IGeS) = Putter Word8
putWord8 Word8
0x59
    put (IRelOp BitSize
BS64 IRelOp
IGeU) = Putter Word8
putWord8 Word8
0x5A
    put (FRelOp BitSize
BS32 FRelOp
FEq) = Putter Word8
putWord8 Word8
0x5B
    put (FRelOp BitSize
BS32 FRelOp
FNe) = Putter Word8
putWord8 Word8
0x5C
    put (FRelOp BitSize
BS32 FRelOp
FLt) = Putter Word8
putWord8 Word8
0x5D
    put (FRelOp BitSize
BS32 FRelOp
FGt) = Putter Word8
putWord8 Word8
0x5E
    put (FRelOp BitSize
BS32 FRelOp
FLe) = Putter Word8
putWord8 Word8
0x5F
    put (FRelOp BitSize
BS32 FRelOp
FGe) = Putter Word8
putWord8 Word8
0x60
    put (FRelOp BitSize
BS64 FRelOp
FEq) = Putter Word8
putWord8 Word8
0x61
    put (FRelOp BitSize
BS64 FRelOp
FNe) = Putter Word8
putWord8 Word8
0x62
    put (FRelOp BitSize
BS64 FRelOp
FLt) = Putter Word8
putWord8 Word8
0x63
    put (FRelOp BitSize
BS64 FRelOp
FGt) = Putter Word8
putWord8 Word8
0x64
    put (FRelOp BitSize
BS64 FRelOp
FLe) = Putter Word8
putWord8 Word8
0x65
    put (FRelOp BitSize
BS64 FRelOp
FGe) = Putter Word8
putWord8 Word8
0x66
    put (IUnOp BitSize
BS32 IUnOp
IClz) = Putter Word8
putWord8 Word8
0x67
    put (IUnOp BitSize
BS32 IUnOp
ICtz) = Putter Word8
putWord8 Word8
0x68
    put (IUnOp BitSize
BS32 IUnOp
IPopcnt) = Putter Word8
putWord8 Word8
0x69
    put (IBinOp BitSize
BS32 IBinOp
IAdd) = Putter Word8
putWord8 Word8
0x6A
    put (IBinOp BitSize
BS32 IBinOp
ISub) = Putter Word8
putWord8 Word8
0x6B
    put (IBinOp BitSize
BS32 IBinOp
IMul) = Putter Word8
putWord8 Word8
0x6C
    put (IBinOp BitSize
BS32 IBinOp
IDivS) = Putter Word8
putWord8 Word8
0x6D
    put (IBinOp BitSize
BS32 IBinOp
IDivU) = Putter Word8
putWord8 Word8
0x6E
    put (IBinOp BitSize
BS32 IBinOp
IRemS) = Putter Word8
putWord8 Word8
0x6F
    put (IBinOp BitSize
BS32 IBinOp
IRemU) = Putter Word8
putWord8 Word8
0x70
    put (IBinOp BitSize
BS32 IBinOp
IAnd) = Putter Word8
putWord8 Word8
0x71
    put (IBinOp BitSize
BS32 IBinOp
IOr) = Putter Word8
putWord8 Word8
0x72
    put (IBinOp BitSize
BS32 IBinOp
IXor) = Putter Word8
putWord8 Word8
0x73
    put (IBinOp BitSize
BS32 IBinOp
IShl) = Putter Word8
putWord8 Word8
0x74
    put (IBinOp BitSize
BS32 IBinOp
IShrS) = Putter Word8
putWord8 Word8
0x75
    put (IBinOp BitSize
BS32 IBinOp
IShrU) = Putter Word8
putWord8 Word8
0x76
    put (IBinOp BitSize
BS32 IBinOp
IRotl) = Putter Word8
putWord8 Word8
0x77
    put (IBinOp BitSize
BS32 IBinOp
IRotr) = Putter Word8
putWord8 Word8
0x78
    put (IUnOp BitSize
BS64 IUnOp
IClz) = Putter Word8
putWord8 Word8
0x79
    put (IUnOp BitSize
BS64 IUnOp
ICtz) = Putter Word8
putWord8 Word8
0x7A
    put (IUnOp BitSize
BS64 IUnOp
IPopcnt) = Putter Word8
putWord8 Word8
0x7B
    put (IBinOp BitSize
BS64 IBinOp
IAdd) = Putter Word8
putWord8 Word8
0x7C
    put (IBinOp BitSize
BS64 IBinOp
ISub) = Putter Word8
putWord8 Word8
0x7D
    put (IBinOp BitSize
BS64 IBinOp
IMul) = Putter Word8
putWord8 Word8
0x7E
    put (IBinOp BitSize
BS64 IBinOp
IDivS) = Putter Word8
putWord8 Word8
0x7F
    put (IBinOp BitSize
BS64 IBinOp
IDivU) = Putter Word8
putWord8 Word8
0x80
    put (IBinOp BitSize
BS64 IBinOp
IRemS) = Putter Word8
putWord8 Word8
0x81
    put (IBinOp BitSize
BS64 IBinOp
IRemU) = Putter Word8
putWord8 Word8
0x82
    put (IBinOp BitSize
BS64 IBinOp
IAnd) = Putter Word8
putWord8 Word8
0x83
    put (IBinOp BitSize
BS64 IBinOp
IOr) = Putter Word8
putWord8 Word8
0x84
    put (IBinOp BitSize
BS64 IBinOp
IXor) = Putter Word8
putWord8 Word8
0x85
    put (IBinOp BitSize
BS64 IBinOp
IShl) = Putter Word8
putWord8 Word8
0x86
    put (IBinOp BitSize
BS64 IBinOp
IShrS) = Putter Word8
putWord8 Word8
0x87
    put (IBinOp BitSize
BS64 IBinOp
IShrU) = Putter Word8
putWord8 Word8
0x88
    put (IBinOp BitSize
BS64 IBinOp
IRotl) = Putter Word8
putWord8 Word8
0x89
    put (IBinOp BitSize
BS64 IBinOp
IRotr) = Putter Word8
putWord8 Word8
0x8A
    put (FUnOp BitSize
BS32 FUnOp
FAbs) = Putter Word8
putWord8 Word8
0x8B
    put (FUnOp BitSize
BS32 FUnOp
FNeg) = Putter Word8
putWord8 Word8
0x8C
    put (FUnOp BitSize
BS32 FUnOp
FCeil) = Putter Word8
putWord8 Word8
0x8D
    put (FUnOp BitSize
BS32 FUnOp
FFloor) = Putter Word8
putWord8 Word8
0x8E
    put (FUnOp BitSize
BS32 FUnOp
FTrunc) = Putter Word8
putWord8 Word8
0x8F
    put (FUnOp BitSize
BS32 FUnOp
FNearest) = Putter Word8
putWord8 Word8
0x90
    put (FUnOp BitSize
BS32 FUnOp
FSqrt) = Putter Word8
putWord8 Word8
0x91
    put (FBinOp BitSize
BS32 FBinOp
FAdd) = Putter Word8
putWord8 Word8
0x92
    put (FBinOp BitSize
BS32 FBinOp
FSub) = Putter Word8
putWord8 Word8
0x93
    put (FBinOp BitSize
BS32 FBinOp
FMul) = Putter Word8
putWord8 Word8
0x94
    put (FBinOp BitSize
BS32 FBinOp
FDiv) = Putter Word8
putWord8 Word8
0x95
    put (FBinOp BitSize
BS32 FBinOp
FMin) = Putter Word8
putWord8 Word8
0x96
    put (FBinOp BitSize
BS32 FBinOp
FMax) = Putter Word8
putWord8 Word8
0x97
    put (FBinOp BitSize
BS32 FBinOp
FCopySign) = Putter Word8
putWord8 Word8
0x98
    put (FUnOp BitSize
BS64 FUnOp
FAbs) = Putter Word8
putWord8 Word8
0x99
    put (FUnOp BitSize
BS64 FUnOp
FNeg) = Putter Word8
putWord8 Word8
0x9A
    put (FUnOp BitSize
BS64 FUnOp
FCeil) = Putter Word8
putWord8 Word8
0x9B
    put (FUnOp BitSize
BS64 FUnOp
FFloor) = Putter Word8
putWord8 Word8
0x9C
    put (FUnOp BitSize
BS64 FUnOp
FTrunc) = Putter Word8
putWord8 Word8
0x9D
    put (FUnOp BitSize
BS64 FUnOp
FNearest) = Putter Word8
putWord8 Word8
0x9E
    put (FUnOp BitSize
BS64 FUnOp
FSqrt) = Putter Word8
putWord8 Word8
0x9F
    put (FBinOp BitSize
BS64 FBinOp
FAdd) = Putter Word8
putWord8 Word8
0xA0
    put (FBinOp BitSize
BS64 FBinOp
FSub) = Putter Word8
putWord8 Word8
0xA1
    put (FBinOp BitSize
BS64 FBinOp
FMul) = Putter Word8
putWord8 Word8
0xA2
    put (FBinOp BitSize
BS64 FBinOp
FDiv) = Putter Word8
putWord8 Word8
0xA3
    put (FBinOp BitSize
BS64 FBinOp
FMin) = Putter Word8
putWord8 Word8
0xA4
    put (FBinOp BitSize
BS64 FBinOp
FMax) = Putter Word8
putWord8 Word8
0xA5
    put (FBinOp BitSize
BS64 FBinOp
FCopySign) = Putter Word8
putWord8 Word8
0xA6
    put Instruction TypeIndex
I32WrapI64 = Putter Word8
putWord8 Word8
0xA7
    put (ITruncFS BitSize
BS32 BitSize
BS32) = Putter Word8
putWord8 Word8
0xA8
    put (ITruncFU BitSize
BS32 BitSize
BS32) = Putter Word8
putWord8 Word8
0xA9
    put (ITruncFS BitSize
BS32 BitSize
BS64) = Putter Word8
putWord8 Word8
0xAA
    put (ITruncFU BitSize
BS32 BitSize
BS64) = Putter Word8
putWord8 Word8
0xAB
    put Instruction TypeIndex
I64ExtendSI32 = Putter Word8
putWord8 Word8
0xAC
    put Instruction TypeIndex
I64ExtendUI32 = Putter Word8
putWord8 Word8
0xAD
    put (ITruncFS BitSize
BS64 BitSize
BS32) = Putter Word8
putWord8 Word8
0xAE
    put (ITruncFU BitSize
BS64 BitSize
BS32) = Putter Word8
putWord8 Word8
0xAF
    put (ITruncFS BitSize
BS64 BitSize
BS64) = Putter Word8
putWord8 Word8
0xB0
    put (ITruncFU BitSize
BS64 BitSize
BS64) = Putter Word8
putWord8 Word8
0xB1
    put (FConvertIS BitSize
BS32 BitSize
BS32) = Putter Word8
putWord8 Word8
0xB2
    put (FConvertIU BitSize
BS32 BitSize
BS32) = Putter Word8
putWord8 Word8
0xB3
    put (FConvertIS BitSize
BS32 BitSize
BS64) = Putter Word8
putWord8 Word8
0xB4
    put (FConvertIU BitSize
BS32 BitSize
BS64) = Putter Word8
putWord8 Word8
0xB5
    put Instruction TypeIndex
F32DemoteF64 = Putter Word8
putWord8 Word8
0xB6
    put (FConvertIS BitSize
BS64 BitSize
BS32) = Putter Word8
putWord8 Word8
0xB7
    put (FConvertIU BitSize
BS64 BitSize
BS32) = Putter Word8
putWord8 Word8
0xB8
    put (FConvertIS BitSize
BS64 BitSize
BS64) = Putter Word8
putWord8 Word8
0xB9
    put (FConvertIU BitSize
BS64 BitSize
BS64) = Putter Word8
putWord8 Word8
0xBA
    put Instruction TypeIndex
F64PromoteF32 = Putter Word8
putWord8 Word8
0xBB
    put (IReinterpretF BitSize
BS32) = Putter Word8
putWord8 Word8
0xBC
    put (IReinterpretF BitSize
BS64) = Putter Word8
putWord8 Word8
0xBD
    put (FReinterpretI BitSize
BS32) = Putter Word8
putWord8 Word8
0xBE
    put (FReinterpretI BitSize
BS64) = Putter Word8
putWord8 Word8
0xBF

    put (IUnOp BitSize
BS32 IUnOp
IExtend8S) = Putter Word8
putWord8 Word8
0xC0
    put (IUnOp BitSize
BS32 IUnOp
IExtend16S) = Putter Word8
putWord8 Word8
0xC1
    put (IUnOp BitSize
BS32 IUnOp
IExtend32S) = String -> Put
forall a. HasCallStack => String -> a
error String
"Opcode for i32.extend32_s doesn't exist"
    put (IUnOp BitSize
BS64 IUnOp
IExtend8S) = Putter Word8
putWord8 Word8
0xC2
    put (IUnOp BitSize
BS64 IUnOp
IExtend16S) = Putter Word8
putWord8 Word8
0xC3
    put (IUnOp BitSize
BS64 IUnOp
IExtend32S) = Putter Word8
putWord8 Word8
0xC4

    put (ITruncSatFS BitSize
BS32 BitSize
BS32) = Putter Word8
putWord8 Word8
0xFC Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word32 -> Put
forall a. (Integral a, Bits a) => a -> Put
putULEB128 (Word32
0x00 :: Word32)
    put (ITruncSatFU BitSize
BS32 BitSize
BS32) = Putter Word8
putWord8 Word8
0xFC Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word32 -> Put
forall a. (Integral a, Bits a) => a -> Put
putULEB128 (Word32
0x01 :: Word32)
    put (ITruncSatFS BitSize
BS32 BitSize
BS64) = Putter Word8
putWord8 Word8
0xFC Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word32 -> Put
forall a. (Integral a, Bits a) => a -> Put
putULEB128 (Word32
0x02 :: Word32)
    put (ITruncSatFU BitSize
BS32 BitSize
BS64) = Putter Word8
putWord8 Word8
0xFC Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word32 -> Put
forall a. (Integral a, Bits a) => a -> Put
putULEB128 (Word32
0x03 :: Word32)
    put (ITruncSatFS BitSize
BS64 BitSize
BS32) = Putter Word8
putWord8 Word8
0xFC Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word32 -> Put
forall a. (Integral a, Bits a) => a -> Put
putULEB128 (Word32
0x04 :: Word32)
    put (ITruncSatFU BitSize
BS64 BitSize
BS32) = Putter Word8
putWord8 Word8
0xFC Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word32 -> Put
forall a. (Integral a, Bits a) => a -> Put
putULEB128 (Word32
0x05 :: Word32)
    put (ITruncSatFS BitSize
BS64 BitSize
BS64) = Putter Word8
putWord8 Word8
0xFC Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word32 -> Put
forall a. (Integral a, Bits a) => a -> Put
putULEB128 (Word32
0x06 :: Word32)
    put (ITruncSatFU BitSize
BS64 BitSize
BS64) = Putter Word8
putWord8 Word8
0xFC Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word32 -> Put
forall a. (Integral a, Bits a) => a -> Put
putULEB128 (Word32
0x07 :: Word32)

    get :: Get (Instruction TypeIndex)
get = do
        Word8
op <- Get Word8
getWord8
        case Word8
op of
            Word8
0x00 -> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall (m :: * -> *) a. Monad m => a -> m a
return Instruction TypeIndex
forall index. Instruction index
Unreachable
            Word8
0x01 -> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall (m :: * -> *) a. Monad m => a -> m a
return Instruction TypeIndex
forall index. Instruction index
Nop
            Word8
0x02 -> BlockType -> Expression -> Instruction TypeIndex
forall index. BlockType -> Expression -> Instruction index
Block (BlockType -> Expression -> Instruction TypeIndex)
-> Get BlockType -> Get (Expression -> Instruction TypeIndex)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get BlockType
getBlockType Get (Expression -> Instruction TypeIndex)
-> Get Expression -> Get (Instruction TypeIndex)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Expression
getExpression
            Word8
0x03 -> BlockType -> Expression -> Instruction TypeIndex
forall index. BlockType -> Expression -> Instruction index
Loop (BlockType -> Expression -> Instruction TypeIndex)
-> Get BlockType -> Get (Expression -> Instruction TypeIndex)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get BlockType
getBlockType Get (Expression -> Instruction TypeIndex)
-> Get Expression -> Get (Instruction TypeIndex)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Expression
getExpression
            Word8
0x04 -> do
                BlockType
blockType <- Get BlockType
getBlockType
                (Expression
true, Bool
hasElse) <- Get (Expression, Bool)
getTrueBranch
                Expression
false <- if Bool
hasElse then Get Expression
getExpression else Expression -> Get Expression
forall (m :: * -> *) a. Monad m => a -> m a
return []
                Instruction TypeIndex -> Get (Instruction TypeIndex)
forall (m :: * -> *) a. Monad m => a -> m a
return (Instruction TypeIndex -> Get (Instruction TypeIndex))
-> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall a b. (a -> b) -> a -> b
$ BlockType -> Expression -> Expression -> Instruction TypeIndex
forall index.
BlockType -> Expression -> Expression -> Instruction index
If BlockType
blockType Expression
true Expression
false
            Word8
0x0C -> TypeIndex -> Instruction TypeIndex
forall index. index -> Instruction index
Br (TypeIndex -> Instruction TypeIndex)
-> Get TypeIndex -> Get (Instruction TypeIndex)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Get TypeIndex
forall a. (Integral a, Bits a) => Int -> Get a
getULEB128 Int
32
            Word8
0x0D -> TypeIndex -> Instruction TypeIndex
forall index. index -> Instruction index
BrIf (TypeIndex -> Instruction TypeIndex)
-> Get TypeIndex -> Get (Instruction TypeIndex)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Get TypeIndex
forall a. (Integral a, Bits a) => Int -> Get a
getULEB128 Int
32
            Word8
0x0E -> [TypeIndex] -> TypeIndex -> Instruction TypeIndex
forall index. [index] -> index -> Instruction index
BrTable ([TypeIndex] -> TypeIndex -> Instruction TypeIndex)
-> Get [TypeIndex] -> Get (TypeIndex -> Instruction TypeIndex)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Index -> TypeIndex) -> [Index] -> [TypeIndex]
forall a b. (a -> b) -> [a] -> [b]
map Index -> TypeIndex
unIndex ([Index] -> [TypeIndex]) -> Get [Index] -> Get [TypeIndex]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get [Index]
forall a. Serialize a => Get [a]
getVec) Get (TypeIndex -> Instruction TypeIndex)
-> Get TypeIndex -> Get (Instruction TypeIndex)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> Get TypeIndex
forall a. (Integral a, Bits a) => Int -> Get a
getULEB128 Int
32
            Word8
0x0F -> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall (m :: * -> *) a. Monad m => a -> m a
return (Instruction TypeIndex -> Get (Instruction TypeIndex))
-> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall a b. (a -> b) -> a -> b
$ Instruction TypeIndex
forall index. Instruction index
Return
            Word8
0x10 -> TypeIndex -> Instruction TypeIndex
forall index. index -> Instruction index
Call (TypeIndex -> Instruction TypeIndex)
-> Get TypeIndex -> Get (Instruction TypeIndex)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Get TypeIndex
forall a. (Integral a, Bits a) => Int -> Get a
getULEB128 Int
32
            Word8
0x11 -> do
                TypeIndex
typeIdx <- Int -> Get TypeIndex
forall a. (Integral a, Bits a) => Int -> Get a
getULEB128 Int
32
                Word8 -> Get ()
byteGuard Word8
0x00
                Instruction TypeIndex -> Get (Instruction TypeIndex)
forall (m :: * -> *) a. Monad m => a -> m a
return (Instruction TypeIndex -> Get (Instruction TypeIndex))
-> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall a b. (a -> b) -> a -> b
$ TypeIndex -> Instruction TypeIndex
forall index. index -> Instruction index
CallIndirect TypeIndex
typeIdx
            -- Parametric instructions
            Word8
0x1A -> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall (m :: * -> *) a. Monad m => a -> m a
return (Instruction TypeIndex -> Get (Instruction TypeIndex))
-> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall a b. (a -> b) -> a -> b
$ Instruction TypeIndex
forall index. Instruction index
Drop
            Word8
0x1B -> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall (m :: * -> *) a. Monad m => a -> m a
return (Instruction TypeIndex -> Get (Instruction TypeIndex))
-> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall a b. (a -> b) -> a -> b
$ Instruction TypeIndex
forall index. Instruction index
Select
            -- Variable instructions
            Word8
0x20 -> TypeIndex -> Instruction TypeIndex
forall index. index -> Instruction index
GetLocal (TypeIndex -> Instruction TypeIndex)
-> Get TypeIndex -> Get (Instruction TypeIndex)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Get TypeIndex
forall a. (Integral a, Bits a) => Int -> Get a
getULEB128 Int
32
            Word8
0x21 -> TypeIndex -> Instruction TypeIndex
forall index. index -> Instruction index
SetLocal (TypeIndex -> Instruction TypeIndex)
-> Get TypeIndex -> Get (Instruction TypeIndex)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Get TypeIndex
forall a. (Integral a, Bits a) => Int -> Get a
getULEB128 Int
32
            Word8
0x22 -> TypeIndex -> Instruction TypeIndex
forall index. index -> Instruction index
TeeLocal (TypeIndex -> Instruction TypeIndex)
-> Get TypeIndex -> Get (Instruction TypeIndex)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Get TypeIndex
forall a. (Integral a, Bits a) => Int -> Get a
getULEB128 Int
32
            Word8
0x23 -> TypeIndex -> Instruction TypeIndex
forall index. index -> Instruction index
GetGlobal (TypeIndex -> Instruction TypeIndex)
-> Get TypeIndex -> Get (Instruction TypeIndex)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Get TypeIndex
forall a. (Integral a, Bits a) => Int -> Get a
getULEB128 Int
32
            Word8
0x24 -> TypeIndex -> Instruction TypeIndex
forall index. index -> Instruction index
SetGlobal (TypeIndex -> Instruction TypeIndex)
-> Get TypeIndex -> Get (Instruction TypeIndex)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Get TypeIndex
forall a. (Integral a, Bits a) => Int -> Get a
getULEB128 Int
32
            -- Memory instructions
            Word8
0x28 -> MemArg -> Instruction TypeIndex
forall index. MemArg -> Instruction index
I32Load (MemArg -> Instruction TypeIndex)
-> Get MemArg -> Get (Instruction TypeIndex)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get MemArg
forall t. Serialize t => Get t
get
            Word8
0x29 -> MemArg -> Instruction TypeIndex
forall index. MemArg -> Instruction index
I64Load (MemArg -> Instruction TypeIndex)
-> Get MemArg -> Get (Instruction TypeIndex)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get MemArg
forall t. Serialize t => Get t
get
            Word8
0x2A -> MemArg -> Instruction TypeIndex
forall index. MemArg -> Instruction index
F32Load (MemArg -> Instruction TypeIndex)
-> Get MemArg -> Get (Instruction TypeIndex)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get MemArg
forall t. Serialize t => Get t
get
            Word8
0x2B -> MemArg -> Instruction TypeIndex
forall index. MemArg -> Instruction index
F64Load (MemArg -> Instruction TypeIndex)
-> Get MemArg -> Get (Instruction TypeIndex)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get MemArg
forall t. Serialize t => Get t
get
            Word8
0x2C -> MemArg -> Instruction TypeIndex
forall index. MemArg -> Instruction index
I32Load8S (MemArg -> Instruction TypeIndex)
-> Get MemArg -> Get (Instruction TypeIndex)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get MemArg
forall t. Serialize t => Get t
get
            Word8
0x2D -> MemArg -> Instruction TypeIndex
forall index. MemArg -> Instruction index
I32Load8U (MemArg -> Instruction TypeIndex)
-> Get MemArg -> Get (Instruction TypeIndex)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get MemArg
forall t. Serialize t => Get t
get
            Word8
0x2E -> MemArg -> Instruction TypeIndex
forall index. MemArg -> Instruction index
I32Load16S (MemArg -> Instruction TypeIndex)
-> Get MemArg -> Get (Instruction TypeIndex)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get MemArg
forall t. Serialize t => Get t
get
            Word8
0x2F -> MemArg -> Instruction TypeIndex
forall index. MemArg -> Instruction index
I32Load16U (MemArg -> Instruction TypeIndex)
-> Get MemArg -> Get (Instruction TypeIndex)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get MemArg
forall t. Serialize t => Get t
get
            Word8
0x30 -> MemArg -> Instruction TypeIndex
forall index. MemArg -> Instruction index
I64Load8S (MemArg -> Instruction TypeIndex)
-> Get MemArg -> Get (Instruction TypeIndex)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get MemArg
forall t. Serialize t => Get t
get
            Word8
0x31 -> MemArg -> Instruction TypeIndex
forall index. MemArg -> Instruction index
I64Load8U (MemArg -> Instruction TypeIndex)
-> Get MemArg -> Get (Instruction TypeIndex)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get MemArg
forall t. Serialize t => Get t
get
            Word8
0x32 -> MemArg -> Instruction TypeIndex
forall index. MemArg -> Instruction index
I64Load16S (MemArg -> Instruction TypeIndex)
-> Get MemArg -> Get (Instruction TypeIndex)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get MemArg
forall t. Serialize t => Get t
get
            Word8
0x33 -> MemArg -> Instruction TypeIndex
forall index. MemArg -> Instruction index
I64Load16U (MemArg -> Instruction TypeIndex)
-> Get MemArg -> Get (Instruction TypeIndex)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get MemArg
forall t. Serialize t => Get t
get
            Word8
0x34 -> MemArg -> Instruction TypeIndex
forall index. MemArg -> Instruction index
I64Load32S (MemArg -> Instruction TypeIndex)
-> Get MemArg -> Get (Instruction TypeIndex)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get MemArg
forall t. Serialize t => Get t
get
            Word8
0x35 -> MemArg -> Instruction TypeIndex
forall index. MemArg -> Instruction index
I64Load32U (MemArg -> Instruction TypeIndex)
-> Get MemArg -> Get (Instruction TypeIndex)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get MemArg
forall t. Serialize t => Get t
get
            Word8
0x36 -> MemArg -> Instruction TypeIndex
forall index. MemArg -> Instruction index
I32Store (MemArg -> Instruction TypeIndex)
-> Get MemArg -> Get (Instruction TypeIndex)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get MemArg
forall t. Serialize t => Get t
get
            Word8
0x37 -> MemArg -> Instruction TypeIndex
forall index. MemArg -> Instruction index
I64Store (MemArg -> Instruction TypeIndex)
-> Get MemArg -> Get (Instruction TypeIndex)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get MemArg
forall t. Serialize t => Get t
get
            Word8
0x38 -> MemArg -> Instruction TypeIndex
forall index. MemArg -> Instruction index
F32Store (MemArg -> Instruction TypeIndex)
-> Get MemArg -> Get (Instruction TypeIndex)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get MemArg
forall t. Serialize t => Get t
get
            Word8
0x39 -> MemArg -> Instruction TypeIndex
forall index. MemArg -> Instruction index
F64Store (MemArg -> Instruction TypeIndex)
-> Get MemArg -> Get (Instruction TypeIndex)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get MemArg
forall t. Serialize t => Get t
get
            Word8
0x3A -> MemArg -> Instruction TypeIndex
forall index. MemArg -> Instruction index
I32Store8 (MemArg -> Instruction TypeIndex)
-> Get MemArg -> Get (Instruction TypeIndex)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get MemArg
forall t. Serialize t => Get t
get
            Word8
0x3B -> MemArg -> Instruction TypeIndex
forall index. MemArg -> Instruction index
I32Store16 (MemArg -> Instruction TypeIndex)
-> Get MemArg -> Get (Instruction TypeIndex)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get MemArg
forall t. Serialize t => Get t
get
            Word8
0x3C -> MemArg -> Instruction TypeIndex
forall index. MemArg -> Instruction index
I64Store8 (MemArg -> Instruction TypeIndex)
-> Get MemArg -> Get (Instruction TypeIndex)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get MemArg
forall t. Serialize t => Get t
get
            Word8
0x3D -> MemArg -> Instruction TypeIndex
forall index. MemArg -> Instruction index
I64Store16 (MemArg -> Instruction TypeIndex)
-> Get MemArg -> Get (Instruction TypeIndex)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get MemArg
forall t. Serialize t => Get t
get
            Word8
0x3E -> MemArg -> Instruction TypeIndex
forall index. MemArg -> Instruction index
I64Store32 (MemArg -> Instruction TypeIndex)
-> Get MemArg -> Get (Instruction TypeIndex)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get MemArg
forall t. Serialize t => Get t
get
            Word8
0x3F -> Word8 -> Get ()
byteGuard Word8
0x00 Get ()
-> Get (Instruction TypeIndex) -> Get (Instruction TypeIndex)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (Instruction TypeIndex -> Get (Instruction TypeIndex)
forall (m :: * -> *) a. Monad m => a -> m a
return (Instruction TypeIndex -> Get (Instruction TypeIndex))
-> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall a b. (a -> b) -> a -> b
$ Instruction TypeIndex
forall index. Instruction index
CurrentMemory)
            Word8
0x40 -> Word8 -> Get ()
byteGuard Word8
0x00 Get ()
-> Get (Instruction TypeIndex) -> Get (Instruction TypeIndex)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (Instruction TypeIndex -> Get (Instruction TypeIndex)
forall (m :: * -> *) a. Monad m => a -> m a
return (Instruction TypeIndex -> Get (Instruction TypeIndex))
-> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall a b. (a -> b) -> a -> b
$ Instruction TypeIndex
forall index. Instruction index
GrowMemory)
            -- Numeric instructions
            Word8
0x41 -> Word32 -> Instruction TypeIndex
forall index. Word32 -> Instruction index
I32Const (Word32 -> Instruction TypeIndex)
-> Get Word32 -> Get (Instruction TypeIndex)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Get Word32
forall a. (Integral a, Bits a) => Int -> Get a
getSLEB128 Int
32
            Word8
0x42 -> Word64 -> Instruction TypeIndex
forall index. Word64 -> Instruction index
I64Const (Word64 -> Instruction TypeIndex)
-> Get Word64 -> Get (Instruction TypeIndex)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Get Word64
forall a. (Integral a, Bits a) => Int -> Get a
getSLEB128 Int
64
            Word8
0x43 -> Float -> Instruction TypeIndex
forall index. Float -> Instruction index
F32Const (Float -> Instruction TypeIndex)
-> Get Float -> Get (Instruction TypeIndex)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Float
getFloat32le
            Word8
0x44 -> Double -> Instruction TypeIndex
forall index. Double -> Instruction index
F64Const (Double -> Instruction TypeIndex)
-> Get Double -> Get (Instruction TypeIndex)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Double
getFloat64le
            Word8
0x45 -> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall (m :: * -> *) a. Monad m => a -> m a
return (Instruction TypeIndex -> Get (Instruction TypeIndex))
-> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall a b. (a -> b) -> a -> b
$ Instruction TypeIndex
forall index. Instruction index
I32Eqz
            Word8
0x46 -> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall (m :: * -> *) a. Monad m => a -> m a
return (Instruction TypeIndex -> Get (Instruction TypeIndex))
-> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall a b. (a -> b) -> a -> b
$ BitSize -> IRelOp -> Instruction TypeIndex
forall index. BitSize -> IRelOp -> Instruction index
IRelOp BitSize
BS32 IRelOp
IEq
            Word8
0x47 -> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall (m :: * -> *) a. Monad m => a -> m a
return (Instruction TypeIndex -> Get (Instruction TypeIndex))
-> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall a b. (a -> b) -> a -> b
$ BitSize -> IRelOp -> Instruction TypeIndex
forall index. BitSize -> IRelOp -> Instruction index
IRelOp BitSize
BS32 IRelOp
INe
            Word8
0x48 -> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall (m :: * -> *) a. Monad m => a -> m a
return (Instruction TypeIndex -> Get (Instruction TypeIndex))
-> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall a b. (a -> b) -> a -> b
$ BitSize -> IRelOp -> Instruction TypeIndex
forall index. BitSize -> IRelOp -> Instruction index
IRelOp BitSize
BS32 IRelOp
ILtS
            Word8
0x49 -> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall (m :: * -> *) a. Monad m => a -> m a
return (Instruction TypeIndex -> Get (Instruction TypeIndex))
-> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall a b. (a -> b) -> a -> b
$ BitSize -> IRelOp -> Instruction TypeIndex
forall index. BitSize -> IRelOp -> Instruction index
IRelOp BitSize
BS32 IRelOp
ILtU
            Word8
0x4A -> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall (m :: * -> *) a. Monad m => a -> m a
return (Instruction TypeIndex -> Get (Instruction TypeIndex))
-> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall a b. (a -> b) -> a -> b
$ BitSize -> IRelOp -> Instruction TypeIndex
forall index. BitSize -> IRelOp -> Instruction index
IRelOp BitSize
BS32 IRelOp
IGtS
            Word8
0x4B -> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall (m :: * -> *) a. Monad m => a -> m a
return (Instruction TypeIndex -> Get (Instruction TypeIndex))
-> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall a b. (a -> b) -> a -> b
$ BitSize -> IRelOp -> Instruction TypeIndex
forall index. BitSize -> IRelOp -> Instruction index
IRelOp BitSize
BS32 IRelOp
IGtU
            Word8
0x4C -> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall (m :: * -> *) a. Monad m => a -> m a
return (Instruction TypeIndex -> Get (Instruction TypeIndex))
-> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall a b. (a -> b) -> a -> b
$ BitSize -> IRelOp -> Instruction TypeIndex
forall index. BitSize -> IRelOp -> Instruction index
IRelOp BitSize
BS32 IRelOp
ILeS
            Word8
0x4D -> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall (m :: * -> *) a. Monad m => a -> m a
return (Instruction TypeIndex -> Get (Instruction TypeIndex))
-> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall a b. (a -> b) -> a -> b
$ BitSize -> IRelOp -> Instruction TypeIndex
forall index. BitSize -> IRelOp -> Instruction index
IRelOp BitSize
BS32 IRelOp
ILeU
            Word8
0x4E -> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall (m :: * -> *) a. Monad m => a -> m a
return (Instruction TypeIndex -> Get (Instruction TypeIndex))
-> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall a b. (a -> b) -> a -> b
$ BitSize -> IRelOp -> Instruction TypeIndex
forall index. BitSize -> IRelOp -> Instruction index
IRelOp BitSize
BS32 IRelOp
IGeS
            Word8
0x4F -> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall (m :: * -> *) a. Monad m => a -> m a
return (Instruction TypeIndex -> Get (Instruction TypeIndex))
-> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall a b. (a -> b) -> a -> b
$ BitSize -> IRelOp -> Instruction TypeIndex
forall index. BitSize -> IRelOp -> Instruction index
IRelOp BitSize
BS32 IRelOp
IGeU
            Word8
0x50 -> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall (m :: * -> *) a. Monad m => a -> m a
return (Instruction TypeIndex -> Get (Instruction TypeIndex))
-> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall a b. (a -> b) -> a -> b
$ Instruction TypeIndex
forall index. Instruction index
I64Eqz
            Word8
0x51 -> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall (m :: * -> *) a. Monad m => a -> m a
return (Instruction TypeIndex -> Get (Instruction TypeIndex))
-> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall a b. (a -> b) -> a -> b
$ BitSize -> IRelOp -> Instruction TypeIndex
forall index. BitSize -> IRelOp -> Instruction index
IRelOp BitSize
BS64 IRelOp
IEq
            Word8
0x52 -> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall (m :: * -> *) a. Monad m => a -> m a
return (Instruction TypeIndex -> Get (Instruction TypeIndex))
-> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall a b. (a -> b) -> a -> b
$ BitSize -> IRelOp -> Instruction TypeIndex
forall index. BitSize -> IRelOp -> Instruction index
IRelOp BitSize
BS64 IRelOp
INe
            Word8
0x53 -> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall (m :: * -> *) a. Monad m => a -> m a
return (Instruction TypeIndex -> Get (Instruction TypeIndex))
-> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall a b. (a -> b) -> a -> b
$ BitSize -> IRelOp -> Instruction TypeIndex
forall index. BitSize -> IRelOp -> Instruction index
IRelOp BitSize
BS64 IRelOp
ILtS
            Word8
0x54 -> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall (m :: * -> *) a. Monad m => a -> m a
return (Instruction TypeIndex -> Get (Instruction TypeIndex))
-> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall a b. (a -> b) -> a -> b
$ BitSize -> IRelOp -> Instruction TypeIndex
forall index. BitSize -> IRelOp -> Instruction index
IRelOp BitSize
BS64 IRelOp
ILtU
            Word8
0x55 -> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall (m :: * -> *) a. Monad m => a -> m a
return (Instruction TypeIndex -> Get (Instruction TypeIndex))
-> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall a b. (a -> b) -> a -> b
$ BitSize -> IRelOp -> Instruction TypeIndex
forall index. BitSize -> IRelOp -> Instruction index
IRelOp BitSize
BS64 IRelOp
IGtS
            Word8
0x56 -> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall (m :: * -> *) a. Monad m => a -> m a
return (Instruction TypeIndex -> Get (Instruction TypeIndex))
-> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall a b. (a -> b) -> a -> b
$ BitSize -> IRelOp -> Instruction TypeIndex
forall index. BitSize -> IRelOp -> Instruction index
IRelOp BitSize
BS64 IRelOp
IGtU
            Word8
0x57 -> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall (m :: * -> *) a. Monad m => a -> m a
return (Instruction TypeIndex -> Get (Instruction TypeIndex))
-> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall a b. (a -> b) -> a -> b
$ BitSize -> IRelOp -> Instruction TypeIndex
forall index. BitSize -> IRelOp -> Instruction index
IRelOp BitSize
BS64 IRelOp
ILeS
            Word8
0x58 -> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall (m :: * -> *) a. Monad m => a -> m a
return (Instruction TypeIndex -> Get (Instruction TypeIndex))
-> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall a b. (a -> b) -> a -> b
$ BitSize -> IRelOp -> Instruction TypeIndex
forall index. BitSize -> IRelOp -> Instruction index
IRelOp BitSize
BS64 IRelOp
ILeU
            Word8
0x59 -> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall (m :: * -> *) a. Monad m => a -> m a
return (Instruction TypeIndex -> Get (Instruction TypeIndex))
-> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall a b. (a -> b) -> a -> b
$ BitSize -> IRelOp -> Instruction TypeIndex
forall index. BitSize -> IRelOp -> Instruction index
IRelOp BitSize
BS64 IRelOp
IGeS
            Word8
0x5A -> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall (m :: * -> *) a. Monad m => a -> m a
return (Instruction TypeIndex -> Get (Instruction TypeIndex))
-> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall a b. (a -> b) -> a -> b
$ BitSize -> IRelOp -> Instruction TypeIndex
forall index. BitSize -> IRelOp -> Instruction index
IRelOp BitSize
BS64 IRelOp
IGeU
            Word8
0x5B -> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall (m :: * -> *) a. Monad m => a -> m a
return (Instruction TypeIndex -> Get (Instruction TypeIndex))
-> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall a b. (a -> b) -> a -> b
$ BitSize -> FRelOp -> Instruction TypeIndex
forall index. BitSize -> FRelOp -> Instruction index
FRelOp BitSize
BS32 FRelOp
FEq
            Word8
0x5C -> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall (m :: * -> *) a. Monad m => a -> m a
return (Instruction TypeIndex -> Get (Instruction TypeIndex))
-> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall a b. (a -> b) -> a -> b
$ BitSize -> FRelOp -> Instruction TypeIndex
forall index. BitSize -> FRelOp -> Instruction index
FRelOp BitSize
BS32 FRelOp
FNe
            Word8
0x5D -> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall (m :: * -> *) a. Monad m => a -> m a
return (Instruction TypeIndex -> Get (Instruction TypeIndex))
-> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall a b. (a -> b) -> a -> b
$ BitSize -> FRelOp -> Instruction TypeIndex
forall index. BitSize -> FRelOp -> Instruction index
FRelOp BitSize
BS32 FRelOp
FLt
            Word8
0x5E -> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall (m :: * -> *) a. Monad m => a -> m a
return (Instruction TypeIndex -> Get (Instruction TypeIndex))
-> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall a b. (a -> b) -> a -> b
$ BitSize -> FRelOp -> Instruction TypeIndex
forall index. BitSize -> FRelOp -> Instruction index
FRelOp BitSize
BS32 FRelOp
FGt
            Word8
0x5F -> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall (m :: * -> *) a. Monad m => a -> m a
return (Instruction TypeIndex -> Get (Instruction TypeIndex))
-> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall a b. (a -> b) -> a -> b
$ BitSize -> FRelOp -> Instruction TypeIndex
forall index. BitSize -> FRelOp -> Instruction index
FRelOp BitSize
BS32 FRelOp
FLe
            Word8
0x60 -> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall (m :: * -> *) a. Monad m => a -> m a
return (Instruction TypeIndex -> Get (Instruction TypeIndex))
-> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall a b. (a -> b) -> a -> b
$ BitSize -> FRelOp -> Instruction TypeIndex
forall index. BitSize -> FRelOp -> Instruction index
FRelOp BitSize
BS32 FRelOp
FGe
            Word8
0x61 -> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall (m :: * -> *) a. Monad m => a -> m a
return (Instruction TypeIndex -> Get (Instruction TypeIndex))
-> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall a b. (a -> b) -> a -> b
$ BitSize -> FRelOp -> Instruction TypeIndex
forall index. BitSize -> FRelOp -> Instruction index
FRelOp BitSize
BS64 FRelOp
FEq
            Word8
0x62 -> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall (m :: * -> *) a. Monad m => a -> m a
return (Instruction TypeIndex -> Get (Instruction TypeIndex))
-> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall a b. (a -> b) -> a -> b
$ BitSize -> FRelOp -> Instruction TypeIndex
forall index. BitSize -> FRelOp -> Instruction index
FRelOp BitSize
BS64 FRelOp
FNe
            Word8
0x63 -> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall (m :: * -> *) a. Monad m => a -> m a
return (Instruction TypeIndex -> Get (Instruction TypeIndex))
-> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall a b. (a -> b) -> a -> b
$ BitSize -> FRelOp -> Instruction TypeIndex
forall index. BitSize -> FRelOp -> Instruction index
FRelOp BitSize
BS64 FRelOp
FLt
            Word8
0x64 -> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall (m :: * -> *) a. Monad m => a -> m a
return (Instruction TypeIndex -> Get (Instruction TypeIndex))
-> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall a b. (a -> b) -> a -> b
$ BitSize -> FRelOp -> Instruction TypeIndex
forall index. BitSize -> FRelOp -> Instruction index
FRelOp BitSize
BS64 FRelOp
FGt
            Word8
0x65 -> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall (m :: * -> *) a. Monad m => a -> m a
return (Instruction TypeIndex -> Get (Instruction TypeIndex))
-> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall a b. (a -> b) -> a -> b
$ BitSize -> FRelOp -> Instruction TypeIndex
forall index. BitSize -> FRelOp -> Instruction index
FRelOp BitSize
BS64 FRelOp
FLe
            Word8
0x66 -> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall (m :: * -> *) a. Monad m => a -> m a
return (Instruction TypeIndex -> Get (Instruction TypeIndex))
-> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall a b. (a -> b) -> a -> b
$ BitSize -> FRelOp -> Instruction TypeIndex
forall index. BitSize -> FRelOp -> Instruction index
FRelOp BitSize
BS64 FRelOp
FGe
            Word8
0x67 -> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall (m :: * -> *) a. Monad m => a -> m a
return (Instruction TypeIndex -> Get (Instruction TypeIndex))
-> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall a b. (a -> b) -> a -> b
$ BitSize -> IUnOp -> Instruction TypeIndex
forall index. BitSize -> IUnOp -> Instruction index
IUnOp BitSize
BS32 IUnOp
IClz
            Word8
0x68 -> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall (m :: * -> *) a. Monad m => a -> m a
return (Instruction TypeIndex -> Get (Instruction TypeIndex))
-> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall a b. (a -> b) -> a -> b
$ BitSize -> IUnOp -> Instruction TypeIndex
forall index. BitSize -> IUnOp -> Instruction index
IUnOp BitSize
BS32 IUnOp
ICtz
            Word8
0x69 -> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall (m :: * -> *) a. Monad m => a -> m a
return (Instruction TypeIndex -> Get (Instruction TypeIndex))
-> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall a b. (a -> b) -> a -> b
$ BitSize -> IUnOp -> Instruction TypeIndex
forall index. BitSize -> IUnOp -> Instruction index
IUnOp BitSize
BS32 IUnOp
IPopcnt
            Word8
0x6A -> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall (m :: * -> *) a. Monad m => a -> m a
return (Instruction TypeIndex -> Get (Instruction TypeIndex))
-> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall a b. (a -> b) -> a -> b
$ BitSize -> IBinOp -> Instruction TypeIndex
forall index. BitSize -> IBinOp -> Instruction index
IBinOp BitSize
BS32 IBinOp
IAdd
            Word8
0x6B -> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall (m :: * -> *) a. Monad m => a -> m a
return (Instruction TypeIndex -> Get (Instruction TypeIndex))
-> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall a b. (a -> b) -> a -> b
$ BitSize -> IBinOp -> Instruction TypeIndex
forall index. BitSize -> IBinOp -> Instruction index
IBinOp BitSize
BS32 IBinOp
ISub
            Word8
0x6C -> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall (m :: * -> *) a. Monad m => a -> m a
return (Instruction TypeIndex -> Get (Instruction TypeIndex))
-> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall a b. (a -> b) -> a -> b
$ BitSize -> IBinOp -> Instruction TypeIndex
forall index. BitSize -> IBinOp -> Instruction index
IBinOp BitSize
BS32 IBinOp
IMul
            Word8
0x6D -> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall (m :: * -> *) a. Monad m => a -> m a
return (Instruction TypeIndex -> Get (Instruction TypeIndex))
-> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall a b. (a -> b) -> a -> b
$ BitSize -> IBinOp -> Instruction TypeIndex
forall index. BitSize -> IBinOp -> Instruction index
IBinOp BitSize
BS32 IBinOp
IDivS
            Word8
0x6E -> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall (m :: * -> *) a. Monad m => a -> m a
return (Instruction TypeIndex -> Get (Instruction TypeIndex))
-> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall a b. (a -> b) -> a -> b
$ BitSize -> IBinOp -> Instruction TypeIndex
forall index. BitSize -> IBinOp -> Instruction index
IBinOp BitSize
BS32 IBinOp
IDivU
            Word8
0x6F -> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall (m :: * -> *) a. Monad m => a -> m a
return (Instruction TypeIndex -> Get (Instruction TypeIndex))
-> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall a b. (a -> b) -> a -> b
$ BitSize -> IBinOp -> Instruction TypeIndex
forall index. BitSize -> IBinOp -> Instruction index
IBinOp BitSize
BS32 IBinOp
IRemS
            Word8
0x70 -> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall (m :: * -> *) a. Monad m => a -> m a
return (Instruction TypeIndex -> Get (Instruction TypeIndex))
-> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall a b. (a -> b) -> a -> b
$ BitSize -> IBinOp -> Instruction TypeIndex
forall index. BitSize -> IBinOp -> Instruction index
IBinOp BitSize
BS32 IBinOp
IRemU
            Word8
0x71 -> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall (m :: * -> *) a. Monad m => a -> m a
return (Instruction TypeIndex -> Get (Instruction TypeIndex))
-> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall a b. (a -> b) -> a -> b
$ BitSize -> IBinOp -> Instruction TypeIndex
forall index. BitSize -> IBinOp -> Instruction index
IBinOp BitSize
BS32 IBinOp
IAnd
            Word8
0x72 -> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall (m :: * -> *) a. Monad m => a -> m a
return (Instruction TypeIndex -> Get (Instruction TypeIndex))
-> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall a b. (a -> b) -> a -> b
$ BitSize -> IBinOp -> Instruction TypeIndex
forall index. BitSize -> IBinOp -> Instruction index
IBinOp BitSize
BS32 IBinOp
IOr
            Word8
0x73 -> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall (m :: * -> *) a. Monad m => a -> m a
return (Instruction TypeIndex -> Get (Instruction TypeIndex))
-> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall a b. (a -> b) -> a -> b
$ BitSize -> IBinOp -> Instruction TypeIndex
forall index. BitSize -> IBinOp -> Instruction index
IBinOp BitSize
BS32 IBinOp
IXor
            Word8
0x74 -> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall (m :: * -> *) a. Monad m => a -> m a
return (Instruction TypeIndex -> Get (Instruction TypeIndex))
-> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall a b. (a -> b) -> a -> b
$ BitSize -> IBinOp -> Instruction TypeIndex
forall index. BitSize -> IBinOp -> Instruction index
IBinOp BitSize
BS32 IBinOp
IShl
            Word8
0x75 -> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall (m :: * -> *) a. Monad m => a -> m a
return (Instruction TypeIndex -> Get (Instruction TypeIndex))
-> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall a b. (a -> b) -> a -> b
$ BitSize -> IBinOp -> Instruction TypeIndex
forall index. BitSize -> IBinOp -> Instruction index
IBinOp BitSize
BS32 IBinOp
IShrS
            Word8
0x76 -> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall (m :: * -> *) a. Monad m => a -> m a
return (Instruction TypeIndex -> Get (Instruction TypeIndex))
-> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall a b. (a -> b) -> a -> b
$ BitSize -> IBinOp -> Instruction TypeIndex
forall index. BitSize -> IBinOp -> Instruction index
IBinOp BitSize
BS32 IBinOp
IShrU
            Word8
0x77 -> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall (m :: * -> *) a. Monad m => a -> m a
return (Instruction TypeIndex -> Get (Instruction TypeIndex))
-> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall a b. (a -> b) -> a -> b
$ BitSize -> IBinOp -> Instruction TypeIndex
forall index. BitSize -> IBinOp -> Instruction index
IBinOp BitSize
BS32 IBinOp
IRotl
            Word8
0x78 -> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall (m :: * -> *) a. Monad m => a -> m a
return (Instruction TypeIndex -> Get (Instruction TypeIndex))
-> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall a b. (a -> b) -> a -> b
$ BitSize -> IBinOp -> Instruction TypeIndex
forall index. BitSize -> IBinOp -> Instruction index
IBinOp BitSize
BS32 IBinOp
IRotr
            Word8
0x79 -> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall (m :: * -> *) a. Monad m => a -> m a
return (Instruction TypeIndex -> Get (Instruction TypeIndex))
-> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall a b. (a -> b) -> a -> b
$ BitSize -> IUnOp -> Instruction TypeIndex
forall index. BitSize -> IUnOp -> Instruction index
IUnOp BitSize
BS64 IUnOp
IClz
            Word8
0x7A -> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall (m :: * -> *) a. Monad m => a -> m a
return (Instruction TypeIndex -> Get (Instruction TypeIndex))
-> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall a b. (a -> b) -> a -> b
$ BitSize -> IUnOp -> Instruction TypeIndex
forall index. BitSize -> IUnOp -> Instruction index
IUnOp BitSize
BS64 IUnOp
ICtz
            Word8
0x7B -> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall (m :: * -> *) a. Monad m => a -> m a
return (Instruction TypeIndex -> Get (Instruction TypeIndex))
-> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall a b. (a -> b) -> a -> b
$ BitSize -> IUnOp -> Instruction TypeIndex
forall index. BitSize -> IUnOp -> Instruction index
IUnOp BitSize
BS64 IUnOp
IPopcnt
            Word8
0x7C -> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall (m :: * -> *) a. Monad m => a -> m a
return (Instruction TypeIndex -> Get (Instruction TypeIndex))
-> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall a b. (a -> b) -> a -> b
$ BitSize -> IBinOp -> Instruction TypeIndex
forall index. BitSize -> IBinOp -> Instruction index
IBinOp BitSize
BS64 IBinOp
IAdd
            Word8
0x7D -> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall (m :: * -> *) a. Monad m => a -> m a
return (Instruction TypeIndex -> Get (Instruction TypeIndex))
-> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall a b. (a -> b) -> a -> b
$ BitSize -> IBinOp -> Instruction TypeIndex
forall index. BitSize -> IBinOp -> Instruction index
IBinOp BitSize
BS64 IBinOp
ISub
            Word8
0x7E -> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall (m :: * -> *) a. Monad m => a -> m a
return (Instruction TypeIndex -> Get (Instruction TypeIndex))
-> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall a b. (a -> b) -> a -> b
$ BitSize -> IBinOp -> Instruction TypeIndex
forall index. BitSize -> IBinOp -> Instruction index
IBinOp BitSize
BS64 IBinOp
IMul
            Word8
0x7F -> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall (m :: * -> *) a. Monad m => a -> m a
return (Instruction TypeIndex -> Get (Instruction TypeIndex))
-> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall a b. (a -> b) -> a -> b
$ BitSize -> IBinOp -> Instruction TypeIndex
forall index. BitSize -> IBinOp -> Instruction index
IBinOp BitSize
BS64 IBinOp
IDivS
            Word8
0x80 -> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall (m :: * -> *) a. Monad m => a -> m a
return (Instruction TypeIndex -> Get (Instruction TypeIndex))
-> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall a b. (a -> b) -> a -> b
$ BitSize -> IBinOp -> Instruction TypeIndex
forall index. BitSize -> IBinOp -> Instruction index
IBinOp BitSize
BS64 IBinOp
IDivU
            Word8
0x81 -> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall (m :: * -> *) a. Monad m => a -> m a
return (Instruction TypeIndex -> Get (Instruction TypeIndex))
-> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall a b. (a -> b) -> a -> b
$ BitSize -> IBinOp -> Instruction TypeIndex
forall index. BitSize -> IBinOp -> Instruction index
IBinOp BitSize
BS64 IBinOp
IRemS
            Word8
0x82 -> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall (m :: * -> *) a. Monad m => a -> m a
return (Instruction TypeIndex -> Get (Instruction TypeIndex))
-> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall a b. (a -> b) -> a -> b
$ BitSize -> IBinOp -> Instruction TypeIndex
forall index. BitSize -> IBinOp -> Instruction index
IBinOp BitSize
BS64 IBinOp
IRemU
            Word8
0x83 -> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall (m :: * -> *) a. Monad m => a -> m a
return (Instruction TypeIndex -> Get (Instruction TypeIndex))
-> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall a b. (a -> b) -> a -> b
$ BitSize -> IBinOp -> Instruction TypeIndex
forall index. BitSize -> IBinOp -> Instruction index
IBinOp BitSize
BS64 IBinOp
IAnd
            Word8
0x84 -> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall (m :: * -> *) a. Monad m => a -> m a
return (Instruction TypeIndex -> Get (Instruction TypeIndex))
-> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall a b. (a -> b) -> a -> b
$ BitSize -> IBinOp -> Instruction TypeIndex
forall index. BitSize -> IBinOp -> Instruction index
IBinOp BitSize
BS64 IBinOp
IOr
            Word8
0x85 -> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall (m :: * -> *) a. Monad m => a -> m a
return (Instruction TypeIndex -> Get (Instruction TypeIndex))
-> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall a b. (a -> b) -> a -> b
$ BitSize -> IBinOp -> Instruction TypeIndex
forall index. BitSize -> IBinOp -> Instruction index
IBinOp BitSize
BS64 IBinOp
IXor
            Word8
0x86 -> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall (m :: * -> *) a. Monad m => a -> m a
return (Instruction TypeIndex -> Get (Instruction TypeIndex))
-> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall a b. (a -> b) -> a -> b
$ BitSize -> IBinOp -> Instruction TypeIndex
forall index. BitSize -> IBinOp -> Instruction index
IBinOp BitSize
BS64 IBinOp
IShl
            Word8
0x87 -> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall (m :: * -> *) a. Monad m => a -> m a
return (Instruction TypeIndex -> Get (Instruction TypeIndex))
-> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall a b. (a -> b) -> a -> b
$ BitSize -> IBinOp -> Instruction TypeIndex
forall index. BitSize -> IBinOp -> Instruction index
IBinOp BitSize
BS64 IBinOp
IShrS
            Word8
0x88 -> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall (m :: * -> *) a. Monad m => a -> m a
return (Instruction TypeIndex -> Get (Instruction TypeIndex))
-> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall a b. (a -> b) -> a -> b
$ BitSize -> IBinOp -> Instruction TypeIndex
forall index. BitSize -> IBinOp -> Instruction index
IBinOp BitSize
BS64 IBinOp
IShrU
            Word8
0x89 -> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall (m :: * -> *) a. Monad m => a -> m a
return (Instruction TypeIndex -> Get (Instruction TypeIndex))
-> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall a b. (a -> b) -> a -> b
$ BitSize -> IBinOp -> Instruction TypeIndex
forall index. BitSize -> IBinOp -> Instruction index
IBinOp BitSize
BS64 IBinOp
IRotl
            Word8
0x8A -> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall (m :: * -> *) a. Monad m => a -> m a
return (Instruction TypeIndex -> Get (Instruction TypeIndex))
-> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall a b. (a -> b) -> a -> b
$ BitSize -> IBinOp -> Instruction TypeIndex
forall index. BitSize -> IBinOp -> Instruction index
IBinOp BitSize
BS64 IBinOp
IRotr
            Word8
0x8B -> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall (m :: * -> *) a. Monad m => a -> m a
return (Instruction TypeIndex -> Get (Instruction TypeIndex))
-> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall a b. (a -> b) -> a -> b
$ BitSize -> FUnOp -> Instruction TypeIndex
forall index. BitSize -> FUnOp -> Instruction index
FUnOp BitSize
BS32 FUnOp
FAbs
            Word8
0x8C -> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall (m :: * -> *) a. Monad m => a -> m a
return (Instruction TypeIndex -> Get (Instruction TypeIndex))
-> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall a b. (a -> b) -> a -> b
$ BitSize -> FUnOp -> Instruction TypeIndex
forall index. BitSize -> FUnOp -> Instruction index
FUnOp BitSize
BS32 FUnOp
FNeg
            Word8
0x8D -> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall (m :: * -> *) a. Monad m => a -> m a
return (Instruction TypeIndex -> Get (Instruction TypeIndex))
-> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall a b. (a -> b) -> a -> b
$ BitSize -> FUnOp -> Instruction TypeIndex
forall index. BitSize -> FUnOp -> Instruction index
FUnOp BitSize
BS32 FUnOp
FCeil
            Word8
0x8E -> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall (m :: * -> *) a. Monad m => a -> m a
return (Instruction TypeIndex -> Get (Instruction TypeIndex))
-> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall a b. (a -> b) -> a -> b
$ BitSize -> FUnOp -> Instruction TypeIndex
forall index. BitSize -> FUnOp -> Instruction index
FUnOp BitSize
BS32 FUnOp
FFloor
            Word8
0x8F -> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall (m :: * -> *) a. Monad m => a -> m a
return (Instruction TypeIndex -> Get (Instruction TypeIndex))
-> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall a b. (a -> b) -> a -> b
$ BitSize -> FUnOp -> Instruction TypeIndex
forall index. BitSize -> FUnOp -> Instruction index
FUnOp BitSize
BS32 FUnOp
FTrunc
            Word8
0x90 -> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall (m :: * -> *) a. Monad m => a -> m a
return (Instruction TypeIndex -> Get (Instruction TypeIndex))
-> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall a b. (a -> b) -> a -> b
$ BitSize -> FUnOp -> Instruction TypeIndex
forall index. BitSize -> FUnOp -> Instruction index
FUnOp BitSize
BS32 FUnOp
FNearest
            Word8
0x91 -> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall (m :: * -> *) a. Monad m => a -> m a
return (Instruction TypeIndex -> Get (Instruction TypeIndex))
-> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall a b. (a -> b) -> a -> b
$ BitSize -> FUnOp -> Instruction TypeIndex
forall index. BitSize -> FUnOp -> Instruction index
FUnOp BitSize
BS32 FUnOp
FSqrt
            Word8
0x92 -> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall (m :: * -> *) a. Monad m => a -> m a
return (Instruction TypeIndex -> Get (Instruction TypeIndex))
-> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall a b. (a -> b) -> a -> b
$ BitSize -> FBinOp -> Instruction TypeIndex
forall index. BitSize -> FBinOp -> Instruction index
FBinOp BitSize
BS32 FBinOp
FAdd
            Word8
0x93 -> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall (m :: * -> *) a. Monad m => a -> m a
return (Instruction TypeIndex -> Get (Instruction TypeIndex))
-> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall a b. (a -> b) -> a -> b
$ BitSize -> FBinOp -> Instruction TypeIndex
forall index. BitSize -> FBinOp -> Instruction index
FBinOp BitSize
BS32 FBinOp
FSub
            Word8
0x94 -> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall (m :: * -> *) a. Monad m => a -> m a
return (Instruction TypeIndex -> Get (Instruction TypeIndex))
-> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall a b. (a -> b) -> a -> b
$ BitSize -> FBinOp -> Instruction TypeIndex
forall index. BitSize -> FBinOp -> Instruction index
FBinOp BitSize
BS32 FBinOp
FMul
            Word8
0x95 -> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall (m :: * -> *) a. Monad m => a -> m a
return (Instruction TypeIndex -> Get (Instruction TypeIndex))
-> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall a b. (a -> b) -> a -> b
$ BitSize -> FBinOp -> Instruction TypeIndex
forall index. BitSize -> FBinOp -> Instruction index
FBinOp BitSize
BS32 FBinOp
FDiv
            Word8
0x96 -> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall (m :: * -> *) a. Monad m => a -> m a
return (Instruction TypeIndex -> Get (Instruction TypeIndex))
-> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall a b. (a -> b) -> a -> b
$ BitSize -> FBinOp -> Instruction TypeIndex
forall index. BitSize -> FBinOp -> Instruction index
FBinOp BitSize
BS32 FBinOp
FMin
            Word8
0x97 -> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall (m :: * -> *) a. Monad m => a -> m a
return (Instruction TypeIndex -> Get (Instruction TypeIndex))
-> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall a b. (a -> b) -> a -> b
$ BitSize -> FBinOp -> Instruction TypeIndex
forall index. BitSize -> FBinOp -> Instruction index
FBinOp BitSize
BS32 FBinOp
FMax
            Word8
0x98 -> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall (m :: * -> *) a. Monad m => a -> m a
return (Instruction TypeIndex -> Get (Instruction TypeIndex))
-> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall a b. (a -> b) -> a -> b
$ BitSize -> FBinOp -> Instruction TypeIndex
forall index. BitSize -> FBinOp -> Instruction index
FBinOp BitSize
BS32 FBinOp
FCopySign
            Word8
0x99 -> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall (m :: * -> *) a. Monad m => a -> m a
return (Instruction TypeIndex -> Get (Instruction TypeIndex))
-> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall a b. (a -> b) -> a -> b
$ BitSize -> FUnOp -> Instruction TypeIndex
forall index. BitSize -> FUnOp -> Instruction index
FUnOp BitSize
BS64 FUnOp
FAbs
            Word8
0x9A -> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall (m :: * -> *) a. Monad m => a -> m a
return (Instruction TypeIndex -> Get (Instruction TypeIndex))
-> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall a b. (a -> b) -> a -> b
$ BitSize -> FUnOp -> Instruction TypeIndex
forall index. BitSize -> FUnOp -> Instruction index
FUnOp BitSize
BS64 FUnOp
FNeg
            Word8
0x9B -> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall (m :: * -> *) a. Monad m => a -> m a
return (Instruction TypeIndex -> Get (Instruction TypeIndex))
-> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall a b. (a -> b) -> a -> b
$ BitSize -> FUnOp -> Instruction TypeIndex
forall index. BitSize -> FUnOp -> Instruction index
FUnOp BitSize
BS64 FUnOp
FCeil
            Word8
0x9C -> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall (m :: * -> *) a. Monad m => a -> m a
return (Instruction TypeIndex -> Get (Instruction TypeIndex))
-> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall a b. (a -> b) -> a -> b
$ BitSize -> FUnOp -> Instruction TypeIndex
forall index. BitSize -> FUnOp -> Instruction index
FUnOp BitSize
BS64 FUnOp
FFloor
            Word8
0x9D -> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall (m :: * -> *) a. Monad m => a -> m a
return (Instruction TypeIndex -> Get (Instruction TypeIndex))
-> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall a b. (a -> b) -> a -> b
$ BitSize -> FUnOp -> Instruction TypeIndex
forall index. BitSize -> FUnOp -> Instruction index
FUnOp BitSize
BS64 FUnOp
FTrunc
            Word8
0x9E -> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall (m :: * -> *) a. Monad m => a -> m a
return (Instruction TypeIndex -> Get (Instruction TypeIndex))
-> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall a b. (a -> b) -> a -> b
$ BitSize -> FUnOp -> Instruction TypeIndex
forall index. BitSize -> FUnOp -> Instruction index
FUnOp BitSize
BS64 FUnOp
FNearest
            Word8
0x9F -> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall (m :: * -> *) a. Monad m => a -> m a
return (Instruction TypeIndex -> Get (Instruction TypeIndex))
-> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall a b. (a -> b) -> a -> b
$ BitSize -> FUnOp -> Instruction TypeIndex
forall index. BitSize -> FUnOp -> Instruction index
FUnOp BitSize
BS64 FUnOp
FSqrt
            Word8
0xA0 -> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall (m :: * -> *) a. Monad m => a -> m a
return (Instruction TypeIndex -> Get (Instruction TypeIndex))
-> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall a b. (a -> b) -> a -> b
$ BitSize -> FBinOp -> Instruction TypeIndex
forall index. BitSize -> FBinOp -> Instruction index
FBinOp BitSize
BS64 FBinOp
FAdd
            Word8
0xA1 -> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall (m :: * -> *) a. Monad m => a -> m a
return (Instruction TypeIndex -> Get (Instruction TypeIndex))
-> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall a b. (a -> b) -> a -> b
$ BitSize -> FBinOp -> Instruction TypeIndex
forall index. BitSize -> FBinOp -> Instruction index
FBinOp BitSize
BS64 FBinOp
FSub
            Word8
0xA2 -> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall (m :: * -> *) a. Monad m => a -> m a
return (Instruction TypeIndex -> Get (Instruction TypeIndex))
-> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall a b. (a -> b) -> a -> b
$ BitSize -> FBinOp -> Instruction TypeIndex
forall index. BitSize -> FBinOp -> Instruction index
FBinOp BitSize
BS64 FBinOp
FMul
            Word8
0xA3 -> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall (m :: * -> *) a. Monad m => a -> m a
return (Instruction TypeIndex -> Get (Instruction TypeIndex))
-> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall a b. (a -> b) -> a -> b
$ BitSize -> FBinOp -> Instruction TypeIndex
forall index. BitSize -> FBinOp -> Instruction index
FBinOp BitSize
BS64 FBinOp
FDiv
            Word8
0xA4 -> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall (m :: * -> *) a. Monad m => a -> m a
return (Instruction TypeIndex -> Get (Instruction TypeIndex))
-> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall a b. (a -> b) -> a -> b
$ BitSize -> FBinOp -> Instruction TypeIndex
forall index. BitSize -> FBinOp -> Instruction index
FBinOp BitSize
BS64 FBinOp
FMin
            Word8
0xA5 -> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall (m :: * -> *) a. Monad m => a -> m a
return (Instruction TypeIndex -> Get (Instruction TypeIndex))
-> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall a b. (a -> b) -> a -> b
$ BitSize -> FBinOp -> Instruction TypeIndex
forall index. BitSize -> FBinOp -> Instruction index
FBinOp BitSize
BS64 FBinOp
FMax
            Word8
0xA6 -> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall (m :: * -> *) a. Monad m => a -> m a
return (Instruction TypeIndex -> Get (Instruction TypeIndex))
-> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall a b. (a -> b) -> a -> b
$ BitSize -> FBinOp -> Instruction TypeIndex
forall index. BitSize -> FBinOp -> Instruction index
FBinOp BitSize
BS64 FBinOp
FCopySign
            Word8
0xA7 -> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall (m :: * -> *) a. Monad m => a -> m a
return (Instruction TypeIndex -> Get (Instruction TypeIndex))
-> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall a b. (a -> b) -> a -> b
$ Instruction TypeIndex
forall index. Instruction index
I32WrapI64
            Word8
0xA8 -> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall (m :: * -> *) a. Monad m => a -> m a
return (Instruction TypeIndex -> Get (Instruction TypeIndex))
-> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall a b. (a -> b) -> a -> b
$ BitSize -> BitSize -> Instruction TypeIndex
forall index. BitSize -> BitSize -> Instruction index
ITruncFS BitSize
BS32 BitSize
BS32
            Word8
0xA9 -> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall (m :: * -> *) a. Monad m => a -> m a
return (Instruction TypeIndex -> Get (Instruction TypeIndex))
-> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall a b. (a -> b) -> a -> b
$ BitSize -> BitSize -> Instruction TypeIndex
forall index. BitSize -> BitSize -> Instruction index
ITruncFU BitSize
BS32 BitSize
BS32
            Word8
0xAA -> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall (m :: * -> *) a. Monad m => a -> m a
return (Instruction TypeIndex -> Get (Instruction TypeIndex))
-> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall a b. (a -> b) -> a -> b
$ BitSize -> BitSize -> Instruction TypeIndex
forall index. BitSize -> BitSize -> Instruction index
ITruncFS BitSize
BS32 BitSize
BS64
            Word8
0xAB -> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall (m :: * -> *) a. Monad m => a -> m a
return (Instruction TypeIndex -> Get (Instruction TypeIndex))
-> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall a b. (a -> b) -> a -> b
$ BitSize -> BitSize -> Instruction TypeIndex
forall index. BitSize -> BitSize -> Instruction index
ITruncFU BitSize
BS32 BitSize
BS64
            Word8
0xAC -> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall (m :: * -> *) a. Monad m => a -> m a
return (Instruction TypeIndex -> Get (Instruction TypeIndex))
-> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall a b. (a -> b) -> a -> b
$ Instruction TypeIndex
forall index. Instruction index
I64ExtendSI32
            Word8
0xAD -> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall (m :: * -> *) a. Monad m => a -> m a
return (Instruction TypeIndex -> Get (Instruction TypeIndex))
-> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall a b. (a -> b) -> a -> b
$ Instruction TypeIndex
forall index. Instruction index
I64ExtendUI32
            Word8
0xAE -> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall (m :: * -> *) a. Monad m => a -> m a
return (Instruction TypeIndex -> Get (Instruction TypeIndex))
-> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall a b. (a -> b) -> a -> b
$ BitSize -> BitSize -> Instruction TypeIndex
forall index. BitSize -> BitSize -> Instruction index
ITruncFS BitSize
BS64 BitSize
BS32
            Word8
0xAF -> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall (m :: * -> *) a. Monad m => a -> m a
return (Instruction TypeIndex -> Get (Instruction TypeIndex))
-> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall a b. (a -> b) -> a -> b
$ BitSize -> BitSize -> Instruction TypeIndex
forall index. BitSize -> BitSize -> Instruction index
ITruncFU BitSize
BS64 BitSize
BS32
            Word8
0xB0 -> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall (m :: * -> *) a. Monad m => a -> m a
return (Instruction TypeIndex -> Get (Instruction TypeIndex))
-> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall a b. (a -> b) -> a -> b
$ BitSize -> BitSize -> Instruction TypeIndex
forall index. BitSize -> BitSize -> Instruction index
ITruncFS BitSize
BS64 BitSize
BS64
            Word8
0xB1 -> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall (m :: * -> *) a. Monad m => a -> m a
return (Instruction TypeIndex -> Get (Instruction TypeIndex))
-> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall a b. (a -> b) -> a -> b
$ BitSize -> BitSize -> Instruction TypeIndex
forall index. BitSize -> BitSize -> Instruction index
ITruncFU BitSize
BS64 BitSize
BS64
            Word8
0xB2 -> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall (m :: * -> *) a. Monad m => a -> m a
return (Instruction TypeIndex -> Get (Instruction TypeIndex))
-> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall a b. (a -> b) -> a -> b
$ BitSize -> BitSize -> Instruction TypeIndex
forall index. BitSize -> BitSize -> Instruction index
FConvertIS BitSize
BS32 BitSize
BS32
            Word8
0xB3 -> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall (m :: * -> *) a. Monad m => a -> m a
return (Instruction TypeIndex -> Get (Instruction TypeIndex))
-> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall a b. (a -> b) -> a -> b
$ BitSize -> BitSize -> Instruction TypeIndex
forall index. BitSize -> BitSize -> Instruction index
FConvertIU BitSize
BS32 BitSize
BS32
            Word8
0xB4 -> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall (m :: * -> *) a. Monad m => a -> m a
return (Instruction TypeIndex -> Get (Instruction TypeIndex))
-> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall a b. (a -> b) -> a -> b
$ BitSize -> BitSize -> Instruction TypeIndex
forall index. BitSize -> BitSize -> Instruction index
FConvertIS BitSize
BS32 BitSize
BS64
            Word8
0xB5 -> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall (m :: * -> *) a. Monad m => a -> m a
return (Instruction TypeIndex -> Get (Instruction TypeIndex))
-> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall a b. (a -> b) -> a -> b
$ BitSize -> BitSize -> Instruction TypeIndex
forall index. BitSize -> BitSize -> Instruction index
FConvertIU BitSize
BS32 BitSize
BS64
            Word8
0xB6 -> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall (m :: * -> *) a. Monad m => a -> m a
return (Instruction TypeIndex -> Get (Instruction TypeIndex))
-> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall a b. (a -> b) -> a -> b
$ Instruction TypeIndex
forall index. Instruction index
F32DemoteF64
            Word8
0xB7 -> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall (m :: * -> *) a. Monad m => a -> m a
return (Instruction TypeIndex -> Get (Instruction TypeIndex))
-> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall a b. (a -> b) -> a -> b
$ BitSize -> BitSize -> Instruction TypeIndex
forall index. BitSize -> BitSize -> Instruction index
FConvertIS BitSize
BS64 BitSize
BS32
            Word8
0xB8 -> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall (m :: * -> *) a. Monad m => a -> m a
return (Instruction TypeIndex -> Get (Instruction TypeIndex))
-> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall a b. (a -> b) -> a -> b
$ BitSize -> BitSize -> Instruction TypeIndex
forall index. BitSize -> BitSize -> Instruction index
FConvertIU BitSize
BS64 BitSize
BS32
            Word8
0xB9 -> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall (m :: * -> *) a. Monad m => a -> m a
return (Instruction TypeIndex -> Get (Instruction TypeIndex))
-> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall a b. (a -> b) -> a -> b
$ BitSize -> BitSize -> Instruction TypeIndex
forall index. BitSize -> BitSize -> Instruction index
FConvertIS BitSize
BS64 BitSize
BS64
            Word8
0xBA -> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall (m :: * -> *) a. Monad m => a -> m a
return (Instruction TypeIndex -> Get (Instruction TypeIndex))
-> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall a b. (a -> b) -> a -> b
$ BitSize -> BitSize -> Instruction TypeIndex
forall index. BitSize -> BitSize -> Instruction index
FConvertIU BitSize
BS64 BitSize
BS64
            Word8
0xBB -> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall (m :: * -> *) a. Monad m => a -> m a
return (Instruction TypeIndex -> Get (Instruction TypeIndex))
-> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall a b. (a -> b) -> a -> b
$ Instruction TypeIndex
forall index. Instruction index
F64PromoteF32
            Word8
0xBC -> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall (m :: * -> *) a. Monad m => a -> m a
return (Instruction TypeIndex -> Get (Instruction TypeIndex))
-> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall a b. (a -> b) -> a -> b
$ BitSize -> Instruction TypeIndex
forall index. BitSize -> Instruction index
IReinterpretF BitSize
BS32
            Word8
0xBD -> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall (m :: * -> *) a. Monad m => a -> m a
return (Instruction TypeIndex -> Get (Instruction TypeIndex))
-> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall a b. (a -> b) -> a -> b
$ BitSize -> Instruction TypeIndex
forall index. BitSize -> Instruction index
IReinterpretF BitSize
BS64
            Word8
0xBE -> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall (m :: * -> *) a. Monad m => a -> m a
return (Instruction TypeIndex -> Get (Instruction TypeIndex))
-> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall a b. (a -> b) -> a -> b
$ BitSize -> Instruction TypeIndex
forall index. BitSize -> Instruction index
FReinterpretI BitSize
BS32
            Word8
0xBF -> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall (m :: * -> *) a. Monad m => a -> m a
return (Instruction TypeIndex -> Get (Instruction TypeIndex))
-> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall a b. (a -> b) -> a -> b
$ BitSize -> Instruction TypeIndex
forall index. BitSize -> Instruction index
FReinterpretI BitSize
BS64
            Word8
0xC0 -> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall (m :: * -> *) a. Monad m => a -> m a
return (Instruction TypeIndex -> Get (Instruction TypeIndex))
-> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall a b. (a -> b) -> a -> b
$ BitSize -> IUnOp -> Instruction TypeIndex
forall index. BitSize -> IUnOp -> Instruction index
IUnOp BitSize
BS32 IUnOp
IExtend8S
            Word8
0xC1 -> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall (m :: * -> *) a. Monad m => a -> m a
return (Instruction TypeIndex -> Get (Instruction TypeIndex))
-> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall a b. (a -> b) -> a -> b
$ BitSize -> IUnOp -> Instruction TypeIndex
forall index. BitSize -> IUnOp -> Instruction index
IUnOp BitSize
BS32 IUnOp
IExtend16S
            Word8
0xC2 -> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall (m :: * -> *) a. Monad m => a -> m a
return (Instruction TypeIndex -> Get (Instruction TypeIndex))
-> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall a b. (a -> b) -> a -> b
$ BitSize -> IUnOp -> Instruction TypeIndex
forall index. BitSize -> IUnOp -> Instruction index
IUnOp BitSize
BS64 IUnOp
IExtend8S
            Word8
0xC3 -> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall (m :: * -> *) a. Monad m => a -> m a
return (Instruction TypeIndex -> Get (Instruction TypeIndex))
-> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall a b. (a -> b) -> a -> b
$ BitSize -> IUnOp -> Instruction TypeIndex
forall index. BitSize -> IUnOp -> Instruction index
IUnOp BitSize
BS64 IUnOp
IExtend16S
            Word8
0xC4 -> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall (m :: * -> *) a. Monad m => a -> m a
return (Instruction TypeIndex -> Get (Instruction TypeIndex))
-> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall a b. (a -> b) -> a -> b
$ BitSize -> IUnOp -> Instruction TypeIndex
forall index. BitSize -> IUnOp -> Instruction index
IUnOp BitSize
BS64 IUnOp
IExtend32S
            Word8
0xFC -> do -- misc
                Word32
ext <- Int -> Get Word32
forall a. (Integral a, Bits a) => Int -> Get a
getULEB128 Int
32
                case (Word32
ext :: Word32) of
                    Word32
0x00 -> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall (m :: * -> *) a. Monad m => a -> m a
return (Instruction TypeIndex -> Get (Instruction TypeIndex))
-> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall a b. (a -> b) -> a -> b
$ BitSize -> BitSize -> Instruction TypeIndex
forall index. BitSize -> BitSize -> Instruction index
ITruncSatFS BitSize
BS32 BitSize
BS32
                    Word32
0x01 -> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall (m :: * -> *) a. Monad m => a -> m a
return (Instruction TypeIndex -> Get (Instruction TypeIndex))
-> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall a b. (a -> b) -> a -> b
$ BitSize -> BitSize -> Instruction TypeIndex
forall index. BitSize -> BitSize -> Instruction index
ITruncSatFU BitSize
BS32 BitSize
BS32
                    Word32
0x02 -> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall (m :: * -> *) a. Monad m => a -> m a
return (Instruction TypeIndex -> Get (Instruction TypeIndex))
-> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall a b. (a -> b) -> a -> b
$ BitSize -> BitSize -> Instruction TypeIndex
forall index. BitSize -> BitSize -> Instruction index
ITruncSatFS BitSize
BS32 BitSize
BS64
                    Word32
0x03 -> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall (m :: * -> *) a. Monad m => a -> m a
return (Instruction TypeIndex -> Get (Instruction TypeIndex))
-> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall a b. (a -> b) -> a -> b
$ BitSize -> BitSize -> Instruction TypeIndex
forall index. BitSize -> BitSize -> Instruction index
ITruncSatFU BitSize
BS32 BitSize
BS64
                    Word32
0x04 -> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall (m :: * -> *) a. Monad m => a -> m a
return (Instruction TypeIndex -> Get (Instruction TypeIndex))
-> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall a b. (a -> b) -> a -> b
$ BitSize -> BitSize -> Instruction TypeIndex
forall index. BitSize -> BitSize -> Instruction index
ITruncSatFS BitSize
BS64 BitSize
BS32
                    Word32
0x05 -> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall (m :: * -> *) a. Monad m => a -> m a
return (Instruction TypeIndex -> Get (Instruction TypeIndex))
-> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall a b. (a -> b) -> a -> b
$ BitSize -> BitSize -> Instruction TypeIndex
forall index. BitSize -> BitSize -> Instruction index
ITruncSatFU BitSize
BS64 BitSize
BS32
                    Word32
0x06 -> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall (m :: * -> *) a. Monad m => a -> m a
return (Instruction TypeIndex -> Get (Instruction TypeIndex))
-> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall a b. (a -> b) -> a -> b
$ BitSize -> BitSize -> Instruction TypeIndex
forall index. BitSize -> BitSize -> Instruction index
ITruncSatFS BitSize
BS64 BitSize
BS64
                    Word32
0x07 -> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall (m :: * -> *) a. Monad m => a -> m a
return (Instruction TypeIndex -> Get (Instruction TypeIndex))
-> Instruction TypeIndex -> Get (Instruction TypeIndex)
forall a b. (a -> b) -> a -> b
$ BitSize -> BitSize -> Instruction TypeIndex
forall index. BitSize -> BitSize -> Instruction index
ITruncSatFU BitSize
BS64 BitSize
BS64
                    Word32
_ -> String -> Get (Instruction TypeIndex)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Unknown byte value after misc instruction byte"
            Word8
_ -> String -> Get (Instruction TypeIndex)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Unknown byte value in place of instruction opcode"

putExpression :: Expression -> Put
putExpression :: Expression -> Put
putExpression Expression
expr = do
    Putter (Instruction TypeIndex) -> Expression -> Put
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Putter (Instruction TypeIndex)
forall t. Serialize t => Putter t
put Expression
expr
    Putter Word8
putWord8 Word8
0x0B -- END

getExpression :: Get Expression
getExpression :: Get Expression
getExpression = Expression -> Get Expression
go []
    where
        go :: Expression -> Get Expression
        go :: Expression -> Get Expression
go Expression
acc = do
            Word8
nextByte <- Get Word8 -> Get Word8
forall a. Get a -> Get a
lookAhead Get Word8
getWord8
            if Word8
nextByte Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0x0B -- END OF EXPR
            then Get Word8
getWord8 Get Word8 -> Get Expression -> Get Expression
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (Expression -> Get Expression
forall (m :: * -> *) a. Monad m => a -> m a
return (Expression -> Get Expression) -> Expression -> Get Expression
forall a b. (a -> b) -> a -> b
$ Expression -> Expression
forall a. [a] -> [a]
reverse Expression
acc)
            else Get (Instruction TypeIndex)
forall t. Serialize t => Get t
get Get (Instruction TypeIndex)
-> (Instruction TypeIndex -> Get Expression) -> Get Expression
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Instruction TypeIndex
instr -> Expression -> Get Expression
go (Instruction TypeIndex
instr Instruction TypeIndex -> Expression -> Expression
forall a. a -> [a] -> [a]
: Expression
acc)

getTrueBranch :: Get (Expression, Bool)
getTrueBranch :: Get (Expression, Bool)
getTrueBranch = Expression -> Get (Expression, Bool)
go []
    where
        go :: Expression -> Get (Expression, Bool)
        go :: Expression -> Get (Expression, Bool)
go Expression
acc = do
            Word8
nextByte <- Get Word8 -> Get Word8
forall a. Get a -> Get a
lookAhead Get Word8
getWord8
            case Word8
nextByte of
                -- END OF EXPR
                Word8
0x0B -> Get Word8
getWord8 Get Word8 -> Get (Expression, Bool) -> Get (Expression, Bool)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ((Expression, Bool) -> Get (Expression, Bool)
forall (m :: * -> *) a. Monad m => a -> m a
return ((Expression, Bool) -> Get (Expression, Bool))
-> (Expression, Bool) -> Get (Expression, Bool)
forall a b. (a -> b) -> a -> b
$ (Expression -> Expression
forall a. [a] -> [a]
reverse Expression
acc, Bool
False))
                -- ELSE 
                Word8
0x05 -> Get Word8
getWord8 Get Word8 -> Get (Expression, Bool) -> Get (Expression, Bool)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ((Expression, Bool) -> Get (Expression, Bool)
forall (m :: * -> *) a. Monad m => a -> m a
return ((Expression, Bool) -> Get (Expression, Bool))
-> (Expression, Bool) -> Get (Expression, Bool)
forall a b. (a -> b) -> a -> b
$ (Expression -> Expression
forall a. [a] -> [a]
reverse Expression
acc, Bool
True))
                Word8
_ -> Get (Instruction TypeIndex)
forall t. Serialize t => Get t
get Get (Instruction TypeIndex)
-> (Instruction TypeIndex -> Get (Expression, Bool))
-> Get (Expression, Bool)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Instruction TypeIndex
instr -> Expression -> Get (Expression, Bool)
go (Instruction TypeIndex
instr Instruction TypeIndex -> Expression -> Expression
forall a. a -> [a] -> [a]
: Expression
acc)

instance Serialize Global where
    put :: Putter Global
put (Global GlobalType
globalType Expression
expr) = do
        Putter GlobalType
forall t. Serialize t => Putter t
put GlobalType
globalType
        Expression -> Put
putExpression Expression
expr
    get :: Get Global
get = GlobalType -> Expression -> Global
Global (GlobalType -> Expression -> Global)
-> Get GlobalType -> Get (Expression -> Global)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get GlobalType
forall t. Serialize t => Get t
get Get (Expression -> Global) -> Get Expression -> Get Global
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Expression
getExpression

instance Serialize ExportDesc where
    put :: Putter ExportDesc
put (ExportFunc TypeIndex
idx) = Putter Word8
putWord8 Word8
0x00 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> TypeIndex -> Put
forall a. (Integral a, Bits a) => a -> Put
putULEB128 TypeIndex
idx
    put (ExportTable TypeIndex
idx) = Putter Word8
putWord8 Word8
0x01 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> TypeIndex -> Put
forall a. (Integral a, Bits a) => a -> Put
putULEB128 TypeIndex
idx
    put (ExportMemory TypeIndex
idx) = Putter Word8
putWord8 Word8
0x02 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> TypeIndex -> Put
forall a. (Integral a, Bits a) => a -> Put
putULEB128 TypeIndex
idx
    put (ExportGlobal TypeIndex
idx) = Putter Word8
putWord8 Word8
0x03 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> TypeIndex -> Put
forall a. (Integral a, Bits a) => a -> Put
putULEB128 TypeIndex
idx
    get :: Get ExportDesc
get = do
        Word8
op <- Get Word8
getWord8
        TypeIndex
idx <- Int -> Get TypeIndex
forall a. (Integral a, Bits a) => Int -> Get a
getULEB128 Int
32
        case Word8
op of
            Word8
0x00 -> ExportDesc -> Get ExportDesc
forall (m :: * -> *) a. Monad m => a -> m a
return (ExportDesc -> Get ExportDesc) -> ExportDesc -> Get ExportDesc
forall a b. (a -> b) -> a -> b
$ TypeIndex -> ExportDesc
ExportFunc TypeIndex
idx
            Word8
0x01 -> ExportDesc -> Get ExportDesc
forall (m :: * -> *) a. Monad m => a -> m a
return (ExportDesc -> Get ExportDesc) -> ExportDesc -> Get ExportDesc
forall a b. (a -> b) -> a -> b
$ TypeIndex -> ExportDesc
ExportTable TypeIndex
idx
            Word8
0x02 -> ExportDesc -> Get ExportDesc
forall (m :: * -> *) a. Monad m => a -> m a
return (ExportDesc -> Get ExportDesc) -> ExportDesc -> Get ExportDesc
forall a b. (a -> b) -> a -> b
$ TypeIndex -> ExportDesc
ExportMemory TypeIndex
idx
            Word8
0x03 -> ExportDesc -> Get ExportDesc
forall (m :: * -> *) a. Monad m => a -> m a
return (ExportDesc -> Get ExportDesc) -> ExportDesc -> Get ExportDesc
forall a b. (a -> b) -> a -> b
$ TypeIndex -> ExportDesc
ExportGlobal TypeIndex
idx
            Word8
_ -> String -> Get ExportDesc
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Unexpected byte value in position of Export Description opcode"

instance Serialize Export where
    put :: Putter Export
put (Export Text
name ExportDesc
desc) = do
        Text -> Put
putName Text
name
        Putter ExportDesc
forall t. Serialize t => Putter t
put ExportDesc
desc
    get :: Get Export
get = Text -> ExportDesc -> Export
Export (Text -> ExportDesc -> Export)
-> Get Text -> Get (ExportDesc -> Export)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Text
getName Get (ExportDesc -> Export) -> Get ExportDesc -> Get Export
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get ExportDesc
forall t. Serialize t => Get t
get

instance Serialize ElemSegment where
    put :: Putter ElemSegment
put (ElemSegment TypeIndex
tableIndex Expression
offset [TypeIndex]
funcIndexes) = do
        TypeIndex -> Put
forall a. (Integral a, Bits a) => a -> Put
putULEB128 TypeIndex
tableIndex
        Expression -> Put
putExpression Expression
offset
        [Index] -> Put
forall a. Serialize a => [a] -> Put
putVec ([Index] -> Put) -> [Index] -> Put
forall a b. (a -> b) -> a -> b
$ (TypeIndex -> Index) -> [TypeIndex] -> [Index]
forall a b. (a -> b) -> [a] -> [b]
map TypeIndex -> Index
Index [TypeIndex]
funcIndexes
    get :: Get ElemSegment
get = TypeIndex -> Expression -> [TypeIndex] -> ElemSegment
ElemSegment (TypeIndex -> Expression -> [TypeIndex] -> ElemSegment)
-> Get TypeIndex -> Get (Expression -> [TypeIndex] -> ElemSegment)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Get TypeIndex
forall a. (Integral a, Bits a) => Int -> Get a
getULEB128 Int
32 Get (Expression -> [TypeIndex] -> ElemSegment)
-> Get Expression -> Get ([TypeIndex] -> ElemSegment)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Expression
getExpression Get ([TypeIndex] -> ElemSegment)
-> Get [TypeIndex] -> Get ElemSegment
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((Index -> TypeIndex) -> [Index] -> [TypeIndex]
forall a b. (a -> b) -> [a] -> [b]
map Index -> TypeIndex
unIndex ([Index] -> [TypeIndex]) -> Get [Index] -> Get [TypeIndex]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get [Index]
forall a. Serialize a => Get [a]
getVec)

data LocalTypeRange = LocalTypeRange Natural ValueType deriving (Int -> LocalTypeRange -> String -> String
[LocalTypeRange] -> String -> String
LocalTypeRange -> String
(Int -> LocalTypeRange -> String -> String)
-> (LocalTypeRange -> String)
-> ([LocalTypeRange] -> String -> String)
-> Show LocalTypeRange
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [LocalTypeRange] -> String -> String
$cshowList :: [LocalTypeRange] -> String -> String
show :: LocalTypeRange -> String
$cshow :: LocalTypeRange -> String
showsPrec :: Int -> LocalTypeRange -> String -> String
$cshowsPrec :: Int -> LocalTypeRange -> String -> String
Show, LocalTypeRange -> LocalTypeRange -> Bool
(LocalTypeRange -> LocalTypeRange -> Bool)
-> (LocalTypeRange -> LocalTypeRange -> Bool) -> Eq LocalTypeRange
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LocalTypeRange -> LocalTypeRange -> Bool
$c/= :: LocalTypeRange -> LocalTypeRange -> Bool
== :: LocalTypeRange -> LocalTypeRange -> Bool
$c== :: LocalTypeRange -> LocalTypeRange -> Bool
Eq)

instance Serialize LocalTypeRange where
    put :: Putter LocalTypeRange
put (LocalTypeRange TypeIndex
len ValueType
valType) = do
        TypeIndex -> Put
forall a. (Integral a, Bits a) => a -> Put
putULEB128 TypeIndex
len
        Putter ValueType
forall t. Serialize t => Putter t
put ValueType
valType
    get :: Get LocalTypeRange
get = TypeIndex -> ValueType -> LocalTypeRange
LocalTypeRange (TypeIndex -> ValueType -> LocalTypeRange)
-> Get TypeIndex -> Get (ValueType -> LocalTypeRange)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Get TypeIndex
forall a. (Integral a, Bits a) => Int -> Get a
getULEB128 Int
32 Get (ValueType -> LocalTypeRange)
-> Get ValueType -> Get LocalTypeRange
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get ValueType
forall t. Serialize t => Get t
get

instance Serialize Function where
    put :: Putter Function
put Function {$sel:localTypes:Function :: Function -> ResultType
localTypes = ResultType
locals, Expression
$sel:body:Function :: Function -> Expression
body :: Expression
body} = do
        let bs :: ByteString
bs = Put -> ByteString
runPut (Put -> ByteString) -> Put -> ByteString
forall a b. (a -> b) -> a -> b
$ do
                [LocalTypeRange] -> Put
forall a. Serialize a => [a] -> Put
putVec ([LocalTypeRange] -> Put) -> [LocalTypeRange] -> Put
forall a b. (a -> b) -> a -> b
$ (ValueType -> LocalTypeRange) -> ResultType -> [LocalTypeRange]
forall a b. (a -> b) -> [a] -> [b]
map (TypeIndex -> ValueType -> LocalTypeRange
LocalTypeRange TypeIndex
1) ResultType
locals
                Expression -> Put
putExpression Expression
body
        Int -> Put
forall a. (Integral a, Bits a) => a -> Put
putULEB128 (Int -> Put) -> Int -> Put
forall a b. (a -> b) -> a -> b
$ ByteString -> Int
BS.length ByteString
bs
        Putter ByteString
putByteString ByteString
bs
    get :: Get Function
get = do
        TypeIndex
_size <- Int -> Get TypeIndex
forall a. (Integral a, Bits a) => Int -> Get a
getULEB128 Int
32 :: Get Natural
        [LocalTypeRange]
localRanges <- Get [LocalTypeRange]
forall a. Serialize a => Get [a]
getVec
        let localLen :: TypeIndex
localLen = [TypeIndex] -> TypeIndex
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([TypeIndex] -> TypeIndex) -> [TypeIndex] -> TypeIndex
forall a b. (a -> b) -> a -> b
$ (LocalTypeRange -> TypeIndex) -> [LocalTypeRange] -> [TypeIndex]
forall a b. (a -> b) -> [a] -> [b]
map (\(LocalTypeRange TypeIndex
n ValueType
_) -> TypeIndex
n) [LocalTypeRange]
localRanges
        if TypeIndex
localLen TypeIndex -> TypeIndex -> Bool
forall a. Ord a => a -> a -> Bool
< TypeIndex
2TypeIndex -> Integer -> TypeIndex
forall a b. (Num a, Integral b) => a -> b -> a
^Integer
32 then () -> Get ()
forall (m :: * -> *) a. Monad m => a -> m a
return () else String -> Get ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"too many locals"
        let locals :: ResultType
locals = [ResultType] -> ResultType
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([ResultType] -> ResultType) -> [ResultType] -> ResultType
forall a b. (a -> b) -> a -> b
$ (LocalTypeRange -> ResultType) -> [LocalTypeRange] -> [ResultType]
forall a b. (a -> b) -> [a] -> [b]
map (\(LocalTypeRange TypeIndex
n ValueType
val) -> Int -> ValueType -> ResultType
forall a. Int -> a -> [a]
replicate (TypeIndex -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral TypeIndex
n) ValueType
val) [LocalTypeRange]
localRanges 
        Expression
body <- Get Expression
getExpression
        Function -> Get Function
forall (m :: * -> *) a. Monad m => a -> m a
return (Function -> Get Function) -> Function -> Get Function
forall a b. (a -> b) -> a -> b
$ TypeIndex -> ResultType -> Expression -> Function
Function TypeIndex
0 ResultType
locals Expression
body

instance Serialize DataSegment where
    put :: Putter DataSegment
put (DataSegment TypeIndex
memIdx Expression
offset ByteString
init) = do
        TypeIndex -> Put
forall a. (Integral a, Bits a) => a -> Put
putULEB128 TypeIndex
memIdx
        Expression -> Put
putExpression Expression
offset
        Int64 -> Put
forall a. (Integral a, Bits a) => a -> Put
putULEB128 (Int64 -> Put) -> Int64 -> Put
forall a b. (a -> b) -> a -> b
$ ByteString -> Int64
LBS.length ByteString
init
        Putter ByteString
putLazyByteString ByteString
init
    get :: Get DataSegment
get = do
        TypeIndex
memIdx <- Int -> Get TypeIndex
forall a. (Integral a, Bits a) => Int -> Get a
getULEB128 Int
32
        Expression
offset <- Get Expression
getExpression
        Int64
len <- Int -> Get Int64
forall a. (Integral a, Bits a) => Int -> Get a
getULEB128 Int
32
        ByteString
init <- Int64 -> Get ByteString
getLazyByteString Int64
len
        DataSegment -> Get DataSegment
forall (m :: * -> *) a. Monad m => a -> m a
return (DataSegment -> Get DataSegment) -> DataSegment -> Get DataSegment
forall a b. (a -> b) -> a -> b
$ TypeIndex -> Expression -> ByteString -> DataSegment
DataSegment TypeIndex
memIdx Expression
offset ByteString
init

instance Serialize Module where
    put :: Putter Module
put Module
mod = do
        -- magic
        Putter Word8 -> [Word8] -> Put
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Putter Word8
putWord8 [Word8
0x00, Word8
0x61, Word8
0x73, Word8
0x6D]
        -- version
        Putter Word8 -> [Word8] -> Put
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Putter Word8
putWord8 [Word8
0x01, Word8
0x00, Word8
0x00, Word8
0x00]

        SectionType -> Put -> Put
putSection SectionType
TypeSection (Put -> Put) -> Put -> Put
forall a b. (a -> b) -> a -> b
$ [FuncType] -> Put
forall a. Serialize a => [a] -> Put
putVec ([FuncType] -> Put) -> [FuncType] -> Put
forall a b. (a -> b) -> a -> b
$ Module -> [FuncType]
types Module
mod
        SectionType -> Put -> Put
putSection SectionType
ImportSection (Put -> Put) -> Put -> Put
forall a b. (a -> b) -> a -> b
$ [Import] -> Put
forall a. Serialize a => [a] -> Put
putVec ([Import] -> Put) -> [Import] -> Put
forall a b. (a -> b) -> a -> b
$ Module -> [Import]
imports Module
mod
        SectionType -> Put -> Put
putSection SectionType
FunctionSection (Put -> Put) -> Put -> Put
forall a b. (a -> b) -> a -> b
$ [Index] -> Put
forall a. Serialize a => [a] -> Put
putVec ([Index] -> Put) -> [Index] -> Put
forall a b. (a -> b) -> a -> b
$ (Function -> Index) -> [Function] -> [Index]
forall a b. (a -> b) -> [a] -> [b]
map (TypeIndex -> Index
Index (TypeIndex -> Index)
-> (Function -> TypeIndex) -> Function -> Index
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Function -> TypeIndex
funcType) ([Function] -> [Index]) -> [Function] -> [Index]
forall a b. (a -> b) -> a -> b
$ Module -> [Function]
functions Module
mod
        SectionType -> Put -> Put
putSection SectionType
TableSection (Put -> Put) -> Put -> Put
forall a b. (a -> b) -> a -> b
$ [Table] -> Put
forall a. Serialize a => [a] -> Put
putVec ([Table] -> Put) -> [Table] -> Put
forall a b. (a -> b) -> a -> b
$ Module -> [Table]
tables Module
mod
        SectionType -> Put -> Put
putSection SectionType
MemorySection (Put -> Put) -> Put -> Put
forall a b. (a -> b) -> a -> b
$ [Memory] -> Put
forall a. Serialize a => [a] -> Put
putVec ([Memory] -> Put) -> [Memory] -> Put
forall a b. (a -> b) -> a -> b
$ Module -> [Memory]
mems Module
mod
        SectionType -> Put -> Put
putSection SectionType
GlobalSection (Put -> Put) -> Put -> Put
forall a b. (a -> b) -> a -> b
$ [Global] -> Put
forall a. Serialize a => [a] -> Put
putVec ([Global] -> Put) -> [Global] -> Put
forall a b. (a -> b) -> a -> b
$ Module -> [Global]
globals Module
mod
        SectionType -> Put -> Put
putSection SectionType
ExportSection (Put -> Put) -> Put -> Put
forall a b. (a -> b) -> a -> b
$ [Export] -> Put
forall a. Serialize a => [a] -> Put
putVec ([Export] -> Put) -> [Export] -> Put
forall a b. (a -> b) -> a -> b
$ Module -> [Export]
exports Module
mod
        case Module -> Maybe StartFunction
start Module
mod of
            Just (StartFunction TypeIndex
idx) -> SectionType -> Put -> Put
putSection SectionType
StartSection (Put -> Put) -> Put -> Put
forall a b. (a -> b) -> a -> b
$ TypeIndex -> Put
forall a. (Integral a, Bits a) => a -> Put
putULEB128 TypeIndex
idx
            Maybe StartFunction
Nothing -> () -> Put
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        SectionType -> Put -> Put
putSection SectionType
ElementSection (Put -> Put) -> Put -> Put
forall a b. (a -> b) -> a -> b
$ [ElemSegment] -> Put
forall a. Serialize a => [a] -> Put
putVec ([ElemSegment] -> Put) -> [ElemSegment] -> Put
forall a b. (a -> b) -> a -> b
$ Module -> [ElemSegment]
elems Module
mod
        SectionType -> Put -> Put
putSection SectionType
CodeSection (Put -> Put) -> Put -> Put
forall a b. (a -> b) -> a -> b
$ [Function] -> Put
forall a. Serialize a => [a] -> Put
putVec ([Function] -> Put) -> [Function] -> Put
forall a b. (a -> b) -> a -> b
$ Module -> [Function]
functions Module
mod
        SectionType -> Put -> Put
putSection SectionType
DataSection (Put -> Put) -> Put -> Put
forall a b. (a -> b) -> a -> b
$ [DataSegment] -> Put
forall a. Serialize a => [a] -> Put
putVec ([DataSegment] -> Put) -> [DataSegment] -> Put
forall a b. (a -> b) -> a -> b
$ Module -> [DataSegment]
datas Module
mod
        
    get :: Get Module
get = do
        Word32
magic <- Get Word32
getWord32be
        if Word32
magic Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
0x0061736D then () -> Get ()
forall (m :: * -> *) a. Monad m => a -> m a
return () else String -> Get ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"magic header not detected"
        Word32
version <- Get Word32
getWord32be
        if Word32
version Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
0x01000000 then () -> Get ()
forall (m :: * -> *) a. Monad m => a -> m a
return () else String -> Get ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"unknown binary version"
        [FuncType]
types <- SectionType -> Get [FuncType] -> [FuncType] -> Get [FuncType]
forall a. SectionType -> Get a -> a -> Get a
getSection SectionType
TypeSection Get [FuncType]
forall a. Serialize a => Get [a]
getVec []
        [Import]
imports <- SectionType -> Get [Import] -> [Import] -> Get [Import]
forall a. SectionType -> Get a -> a -> Get a
getSection SectionType
ImportSection Get [Import]
forall a. Serialize a => Get [a]
getVec []
        [Index]
funcTypes <- SectionType -> Get [Index] -> [Index] -> Get [Index]
forall a. SectionType -> Get a -> a -> Get a
getSection SectionType
FunctionSection Get [Index]
forall a. Serialize a => Get [a]
getVec []
        [Table]
tables <- SectionType -> Get [Table] -> [Table] -> Get [Table]
forall a. SectionType -> Get a -> a -> Get a
getSection SectionType
TableSection Get [Table]
forall a. Serialize a => Get [a]
getVec []
        [Memory]
mems <- SectionType -> Get [Memory] -> [Memory] -> Get [Memory]
forall a. SectionType -> Get a -> a -> Get a
getSection SectionType
MemorySection Get [Memory]
forall a. Serialize a => Get [a]
getVec []
        [Global]
globals <- SectionType -> Get [Global] -> [Global] -> Get [Global]
forall a. SectionType -> Get a -> a -> Get a
getSection SectionType
GlobalSection Get [Global]
forall a. Serialize a => Get [a]
getVec []
        [Export]
exports <- SectionType -> Get [Export] -> [Export] -> Get [Export]
forall a. SectionType -> Get a -> a -> Get a
getSection SectionType
ExportSection Get [Export]
forall a. Serialize a => Get [a]
getVec []
        Maybe StartFunction
start <- SectionType
-> Get (Maybe StartFunction)
-> Maybe StartFunction
-> Get (Maybe StartFunction)
forall a. SectionType -> Get a -> a -> Get a
getSection SectionType
StartSection (StartFunction -> Maybe StartFunction
forall a. a -> Maybe a
Just (StartFunction -> Maybe StartFunction)
-> (TypeIndex -> StartFunction) -> TypeIndex -> Maybe StartFunction
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeIndex -> StartFunction
StartFunction (TypeIndex -> Maybe StartFunction)
-> Get TypeIndex -> Get (Maybe StartFunction)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Get TypeIndex
forall a. (Integral a, Bits a) => Int -> Get a
getULEB128 Int
32) Maybe StartFunction
forall a. Maybe a
Nothing
        [ElemSegment]
elems <- SectionType
-> Get [ElemSegment] -> [ElemSegment] -> Get [ElemSegment]
forall a. SectionType -> Get a -> a -> Get a
getSection SectionType
ElementSection Get [ElemSegment]
forall a. Serialize a => Get [a]
getVec []
        [Function]
functions <- SectionType -> Get [Function] -> [Function] -> Get [Function]
forall a. SectionType -> Get a -> a -> Get a
getSection SectionType
CodeSection Get [Function]
forall a. Serialize a => Get [a]
getVec []
        [DataSegment]
datas <- SectionType
-> Get [DataSegment] -> [DataSegment] -> Get [DataSegment]
forall a. SectionType -> Get a -> a -> Get a
getSection SectionType
DataSection Get [DataSegment]
forall a. Serialize a => Get [a]
getVec []
        if [Index] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Index]
funcTypes Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= [Function] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Function]
functions
        then String -> Get ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"function and code section have inconsistent lengths"
        else () -> Get ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        Module -> Get Module
forall (m :: * -> *) a. Monad m => a -> m a
return (Module -> Get Module) -> Module -> Get Module
forall a b. (a -> b) -> a -> b
$ Module
emptyModule {
            [FuncType]
types :: [FuncType]
$sel:types:Module :: [FuncType]
types,
            [Import]
imports :: [Import]
$sel:imports:Module :: [Import]
imports,
            [Table]
tables :: [Table]
$sel:tables:Module :: [Table]
tables,
            [Memory]
mems :: [Memory]
$sel:mems:Module :: [Memory]
mems,
            [Global]
globals :: [Global]
$sel:globals:Module :: [Global]
globals,
            [Export]
exports :: [Export]
$sel:exports:Module :: [Export]
exports,
            Maybe StartFunction
start :: Maybe StartFunction
$sel:start:Module :: Maybe StartFunction
start,
            [ElemSegment]
elems :: [ElemSegment]
$sel:elems:Module :: [ElemSegment]
elems,
            $sel:functions:Module :: [Function]
functions = (Index -> Function -> Function)
-> [Index] -> [Function] -> [Function]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\(Index TypeIndex
funcType) Function
fun -> Function
fun { TypeIndex
funcType :: TypeIndex
$sel:funcType:Function :: TypeIndex
funcType }) [Index]
funcTypes [Function]
functions,
            [DataSegment]
datas :: [DataSegment]
$sel:datas:Module :: [DataSegment]
datas
        }


dumpModule :: Module -> BS.ByteString
dumpModule :: Module -> ByteString
dumpModule = Module -> ByteString
forall a. Serialize a => a -> ByteString
encode

dumpModuleLazy :: Module -> LBS.ByteString
dumpModuleLazy :: Module -> ByteString
dumpModuleLazy = Module -> ByteString
forall a. Serialize a => a -> ByteString
encodeLazy

decodeModule :: BS.ByteString -> Either String Module
decodeModule :: ByteString -> Either String Module
decodeModule = ByteString -> Either String Module
forall a. Serialize a => ByteString -> Either String a
decode

decodeModuleLazy :: LBS.ByteString -> Either String Module
decodeModuleLazy :: ByteString -> Either String Module
decodeModuleLazy = ByteString -> Either String Module
forall a. Serialize a => ByteString -> Either String a
decodeLazy