{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveAnyClass #-}

module Language.Wasm.Structure (
    Module(..),
    DataSegment(..),
    ElemSegment(..),
    StartFunction(..),
    Export(..),
    ExportDesc(..),
    Table(..),
    Memory(..),
    Global(..),
    Function(..),
    Import(..),
    ImportDesc(..),
    Instruction(..),
    MemArg(..),
    IUnOp(..),
    IBinOp(..),
    IRelOp(..),
    FUnOp(..),
    FBinOp(..),
    FRelOp(..),
    BitSize(..),
    TableType(..),
    ElemType(..),
    Limit(..),
    GlobalType(..),
    FuncType(..),
    ValueType(..),
    BlockType(..),
    ParamsType,
    ResultType,
    LocalsType,
    Expression,
    LabelIndex,
    FuncIndex,
    TypeIndex,
    LocalIndex,
    GlobalIndex,
    MemoryIndex,
    TableIndex,
    emptyModule,
    isFuncImport,
    isTableImport,
    isMemImport,
    isGlobalImport
) where

import Numeric.Natural (Natural)
import Data.Word (Word32, Word64)
import qualified Data.ByteString.Lazy as LBS
import qualified Data.Text.Lazy as TL
import Control.DeepSeq (NFData)
import GHC.Generics (Generic)

data BitSize = BS32 | BS64 deriving (Int -> BitSize -> ShowS
[BitSize] -> ShowS
BitSize -> String
(Int -> BitSize -> ShowS)
-> (BitSize -> String) -> ([BitSize] -> ShowS) -> Show BitSize
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BitSize] -> ShowS
$cshowList :: [BitSize] -> ShowS
show :: BitSize -> String
$cshow :: BitSize -> String
showsPrec :: Int -> BitSize -> ShowS
$cshowsPrec :: Int -> BitSize -> ShowS
Show, BitSize -> BitSize -> Bool
(BitSize -> BitSize -> Bool)
-> (BitSize -> BitSize -> Bool) -> Eq BitSize
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BitSize -> BitSize -> Bool
$c/= :: BitSize -> BitSize -> Bool
== :: BitSize -> BitSize -> Bool
$c== :: BitSize -> BitSize -> Bool
Eq, (forall x. BitSize -> Rep BitSize x)
-> (forall x. Rep BitSize x -> BitSize) -> Generic BitSize
forall x. Rep BitSize x -> BitSize
forall x. BitSize -> Rep BitSize x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep BitSize x -> BitSize
$cfrom :: forall x. BitSize -> Rep BitSize x
Generic, BitSize -> ()
(BitSize -> ()) -> NFData BitSize
forall a. (a -> ()) -> NFData a
rnf :: BitSize -> ()
$crnf :: BitSize -> ()
NFData)

data IUnOp =
    IClz
    | ICtz
    | IPopcnt
    | IExtend8S
    | IExtend16S
    | IExtend32S
    deriving (Int -> IUnOp -> ShowS
[IUnOp] -> ShowS
IUnOp -> String
(Int -> IUnOp -> ShowS)
-> (IUnOp -> String) -> ([IUnOp] -> ShowS) -> Show IUnOp
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [IUnOp] -> ShowS
$cshowList :: [IUnOp] -> ShowS
show :: IUnOp -> String
$cshow :: IUnOp -> String
showsPrec :: Int -> IUnOp -> ShowS
$cshowsPrec :: Int -> IUnOp -> ShowS
Show, IUnOp -> IUnOp -> Bool
(IUnOp -> IUnOp -> Bool) -> (IUnOp -> IUnOp -> Bool) -> Eq IUnOp
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IUnOp -> IUnOp -> Bool
$c/= :: IUnOp -> IUnOp -> Bool
== :: IUnOp -> IUnOp -> Bool
$c== :: IUnOp -> IUnOp -> Bool
Eq, (forall x. IUnOp -> Rep IUnOp x)
-> (forall x. Rep IUnOp x -> IUnOp) -> Generic IUnOp
forall x. Rep IUnOp x -> IUnOp
forall x. IUnOp -> Rep IUnOp x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep IUnOp x -> IUnOp
$cfrom :: forall x. IUnOp -> Rep IUnOp x
Generic, IUnOp -> ()
(IUnOp -> ()) -> NFData IUnOp
forall a. (a -> ()) -> NFData a
rnf :: IUnOp -> ()
$crnf :: IUnOp -> ()
NFData)

data IBinOp =
    IAdd
    | ISub
    | IMul
    | IDivU
    | IDivS
    | IRemU
    | IRemS
    | IAnd
    | IOr
    | IXor
    | IShl
    | IShrU
    | IShrS
    | IRotl
    | IRotr
    deriving (Int -> IBinOp -> ShowS
[IBinOp] -> ShowS
IBinOp -> String
(Int -> IBinOp -> ShowS)
-> (IBinOp -> String) -> ([IBinOp] -> ShowS) -> Show IBinOp
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [IBinOp] -> ShowS
$cshowList :: [IBinOp] -> ShowS
show :: IBinOp -> String
$cshow :: IBinOp -> String
showsPrec :: Int -> IBinOp -> ShowS
$cshowsPrec :: Int -> IBinOp -> ShowS
Show, IBinOp -> IBinOp -> Bool
(IBinOp -> IBinOp -> Bool)
-> (IBinOp -> IBinOp -> Bool) -> Eq IBinOp
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IBinOp -> IBinOp -> Bool
$c/= :: IBinOp -> IBinOp -> Bool
== :: IBinOp -> IBinOp -> Bool
$c== :: IBinOp -> IBinOp -> Bool
Eq, (forall x. IBinOp -> Rep IBinOp x)
-> (forall x. Rep IBinOp x -> IBinOp) -> Generic IBinOp
forall x. Rep IBinOp x -> IBinOp
forall x. IBinOp -> Rep IBinOp x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep IBinOp x -> IBinOp
$cfrom :: forall x. IBinOp -> Rep IBinOp x
Generic, IBinOp -> ()
(IBinOp -> ()) -> NFData IBinOp
forall a. (a -> ()) -> NFData a
rnf :: IBinOp -> ()
$crnf :: IBinOp -> ()
NFData)

data IRelOp = IEq | INe | ILtU | ILtS | IGtU | IGtS | ILeU | ILeS | IGeU | IGeS deriving (Int -> IRelOp -> ShowS
[IRelOp] -> ShowS
IRelOp -> String
(Int -> IRelOp -> ShowS)
-> (IRelOp -> String) -> ([IRelOp] -> ShowS) -> Show IRelOp
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [IRelOp] -> ShowS
$cshowList :: [IRelOp] -> ShowS
show :: IRelOp -> String
$cshow :: IRelOp -> String
showsPrec :: Int -> IRelOp -> ShowS
$cshowsPrec :: Int -> IRelOp -> ShowS
Show, IRelOp -> IRelOp -> Bool
(IRelOp -> IRelOp -> Bool)
-> (IRelOp -> IRelOp -> Bool) -> Eq IRelOp
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IRelOp -> IRelOp -> Bool
$c/= :: IRelOp -> IRelOp -> Bool
== :: IRelOp -> IRelOp -> Bool
$c== :: IRelOp -> IRelOp -> Bool
Eq, (forall x. IRelOp -> Rep IRelOp x)
-> (forall x. Rep IRelOp x -> IRelOp) -> Generic IRelOp
forall x. Rep IRelOp x -> IRelOp
forall x. IRelOp -> Rep IRelOp x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep IRelOp x -> IRelOp
$cfrom :: forall x. IRelOp -> Rep IRelOp x
Generic, IRelOp -> ()
(IRelOp -> ()) -> NFData IRelOp
forall a. (a -> ()) -> NFData a
rnf :: IRelOp -> ()
$crnf :: IRelOp -> ()
NFData)

data FUnOp = FAbs | FNeg | FCeil | FFloor | FTrunc | FNearest | FSqrt deriving (Int -> FUnOp -> ShowS
[FUnOp] -> ShowS
FUnOp -> String
(Int -> FUnOp -> ShowS)
-> (FUnOp -> String) -> ([FUnOp] -> ShowS) -> Show FUnOp
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FUnOp] -> ShowS
$cshowList :: [FUnOp] -> ShowS
show :: FUnOp -> String
$cshow :: FUnOp -> String
showsPrec :: Int -> FUnOp -> ShowS
$cshowsPrec :: Int -> FUnOp -> ShowS
Show, FUnOp -> FUnOp -> Bool
(FUnOp -> FUnOp -> Bool) -> (FUnOp -> FUnOp -> Bool) -> Eq FUnOp
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FUnOp -> FUnOp -> Bool
$c/= :: FUnOp -> FUnOp -> Bool
== :: FUnOp -> FUnOp -> Bool
$c== :: FUnOp -> FUnOp -> Bool
Eq, (forall x. FUnOp -> Rep FUnOp x)
-> (forall x. Rep FUnOp x -> FUnOp) -> Generic FUnOp
forall x. Rep FUnOp x -> FUnOp
forall x. FUnOp -> Rep FUnOp x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep FUnOp x -> FUnOp
$cfrom :: forall x. FUnOp -> Rep FUnOp x
Generic, FUnOp -> ()
(FUnOp -> ()) -> NFData FUnOp
forall a. (a -> ()) -> NFData a
rnf :: FUnOp -> ()
$crnf :: FUnOp -> ()
NFData)

data FBinOp = FAdd | FSub | FMul | FDiv | FMin | FMax | FCopySign deriving (Int -> FBinOp -> ShowS
[FBinOp] -> ShowS
FBinOp -> String
(Int -> FBinOp -> ShowS)
-> (FBinOp -> String) -> ([FBinOp] -> ShowS) -> Show FBinOp
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FBinOp] -> ShowS
$cshowList :: [FBinOp] -> ShowS
show :: FBinOp -> String
$cshow :: FBinOp -> String
showsPrec :: Int -> FBinOp -> ShowS
$cshowsPrec :: Int -> FBinOp -> ShowS
Show, FBinOp -> FBinOp -> Bool
(FBinOp -> FBinOp -> Bool)
-> (FBinOp -> FBinOp -> Bool) -> Eq FBinOp
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FBinOp -> FBinOp -> Bool
$c/= :: FBinOp -> FBinOp -> Bool
== :: FBinOp -> FBinOp -> Bool
$c== :: FBinOp -> FBinOp -> Bool
Eq, (forall x. FBinOp -> Rep FBinOp x)
-> (forall x. Rep FBinOp x -> FBinOp) -> Generic FBinOp
forall x. Rep FBinOp x -> FBinOp
forall x. FBinOp -> Rep FBinOp x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep FBinOp x -> FBinOp
$cfrom :: forall x. FBinOp -> Rep FBinOp x
Generic, FBinOp -> ()
(FBinOp -> ()) -> NFData FBinOp
forall a. (a -> ()) -> NFData a
rnf :: FBinOp -> ()
$crnf :: FBinOp -> ()
NFData)

data FRelOp = FEq | FNe | FLt | FGt | FLe | FGe deriving (Int -> FRelOp -> ShowS
[FRelOp] -> ShowS
FRelOp -> String
(Int -> FRelOp -> ShowS)
-> (FRelOp -> String) -> ([FRelOp] -> ShowS) -> Show FRelOp
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FRelOp] -> ShowS
$cshowList :: [FRelOp] -> ShowS
show :: FRelOp -> String
$cshow :: FRelOp -> String
showsPrec :: Int -> FRelOp -> ShowS
$cshowsPrec :: Int -> FRelOp -> ShowS
Show, FRelOp -> FRelOp -> Bool
(FRelOp -> FRelOp -> Bool)
-> (FRelOp -> FRelOp -> Bool) -> Eq FRelOp
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FRelOp -> FRelOp -> Bool
$c/= :: FRelOp -> FRelOp -> Bool
== :: FRelOp -> FRelOp -> Bool
$c== :: FRelOp -> FRelOp -> Bool
Eq, (forall x. FRelOp -> Rep FRelOp x)
-> (forall x. Rep FRelOp x -> FRelOp) -> Generic FRelOp
forall x. Rep FRelOp x -> FRelOp
forall x. FRelOp -> Rep FRelOp x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep FRelOp x -> FRelOp
$cfrom :: forall x. FRelOp -> Rep FRelOp x
Generic, FRelOp -> ()
(FRelOp -> ()) -> NFData FRelOp
forall a. (a -> ()) -> NFData a
rnf :: FRelOp -> ()
$crnf :: FRelOp -> ()
NFData)

data MemArg = MemArg { MemArg -> Natural
offset :: Natural, MemArg -> Natural
align :: Natural } deriving (Int -> MemArg -> ShowS
[MemArg] -> ShowS
MemArg -> String
(Int -> MemArg -> ShowS)
-> (MemArg -> String) -> ([MemArg] -> ShowS) -> Show MemArg
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MemArg] -> ShowS
$cshowList :: [MemArg] -> ShowS
show :: MemArg -> String
$cshow :: MemArg -> String
showsPrec :: Int -> MemArg -> ShowS
$cshowsPrec :: Int -> MemArg -> ShowS
Show, MemArg -> MemArg -> Bool
(MemArg -> MemArg -> Bool)
-> (MemArg -> MemArg -> Bool) -> Eq MemArg
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MemArg -> MemArg -> Bool
$c/= :: MemArg -> MemArg -> Bool
== :: MemArg -> MemArg -> Bool
$c== :: MemArg -> MemArg -> Bool
Eq, (forall x. MemArg -> Rep MemArg x)
-> (forall x. Rep MemArg x -> MemArg) -> Generic MemArg
forall x. Rep MemArg x -> MemArg
forall x. MemArg -> Rep MemArg x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep MemArg x -> MemArg
$cfrom :: forall x. MemArg -> Rep MemArg x
Generic, MemArg -> ()
(MemArg -> ()) -> NFData MemArg
forall a. (a -> ()) -> NFData a
rnf :: MemArg -> ()
$crnf :: MemArg -> ()
NFData)

type LabelIndex = Natural
type FuncIndex = Natural
type TypeIndex = Natural
type LocalIndex = Natural
type GlobalIndex = Natural
type MemoryIndex = Natural
type TableIndex = Natural

data ValueType =
    I32
    | I64
    | F32
    | F64
    deriving (Int -> ValueType -> ShowS
[ValueType] -> ShowS
ValueType -> String
(Int -> ValueType -> ShowS)
-> (ValueType -> String)
-> ([ValueType] -> ShowS)
-> Show ValueType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ValueType] -> ShowS
$cshowList :: [ValueType] -> ShowS
show :: ValueType -> String
$cshow :: ValueType -> String
showsPrec :: Int -> ValueType -> ShowS
$cshowsPrec :: Int -> ValueType -> ShowS
Show, ValueType -> ValueType -> Bool
(ValueType -> ValueType -> Bool)
-> (ValueType -> ValueType -> Bool) -> Eq ValueType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ValueType -> ValueType -> Bool
$c/= :: ValueType -> ValueType -> Bool
== :: ValueType -> ValueType -> Bool
$c== :: ValueType -> ValueType -> Bool
Eq, (forall x. ValueType -> Rep ValueType x)
-> (forall x. Rep ValueType x -> ValueType) -> Generic ValueType
forall x. Rep ValueType x -> ValueType
forall x. ValueType -> Rep ValueType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ValueType x -> ValueType
$cfrom :: forall x. ValueType -> Rep ValueType x
Generic, ValueType -> ()
(ValueType -> ()) -> NFData ValueType
forall a. (a -> ()) -> NFData a
rnf :: ValueType -> ()
$crnf :: ValueType -> ()
NFData)

type ResultType = [ValueType]
type ParamsType = [ValueType]
type LocalsType = [ValueType]

data FuncType = FuncType { FuncType -> [ValueType]
params :: ParamsType, FuncType -> [ValueType]
results :: ResultType } deriving (Int -> FuncType -> ShowS
[FuncType] -> ShowS
FuncType -> String
(Int -> FuncType -> ShowS)
-> (FuncType -> String) -> ([FuncType] -> ShowS) -> Show FuncType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FuncType] -> ShowS
$cshowList :: [FuncType] -> ShowS
show :: FuncType -> String
$cshow :: FuncType -> String
showsPrec :: Int -> FuncType -> ShowS
$cshowsPrec :: Int -> FuncType -> ShowS
Show, FuncType -> FuncType -> Bool
(FuncType -> FuncType -> Bool)
-> (FuncType -> FuncType -> Bool) -> Eq FuncType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FuncType -> FuncType -> Bool
$c/= :: FuncType -> FuncType -> Bool
== :: FuncType -> FuncType -> Bool
$c== :: FuncType -> FuncType -> Bool
Eq, (forall x. FuncType -> Rep FuncType x)
-> (forall x. Rep FuncType x -> FuncType) -> Generic FuncType
forall x. Rep FuncType x -> FuncType
forall x. FuncType -> Rep FuncType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep FuncType x -> FuncType
$cfrom :: forall x. FuncType -> Rep FuncType x
Generic, FuncType -> ()
(FuncType -> ()) -> NFData FuncType
forall a. (a -> ()) -> NFData a
rnf :: FuncType -> ()
$crnf :: FuncType -> ()
NFData)

data BlockType =
    Inline (Maybe ValueType)
    | TypeIndex TypeIndex
    deriving (Int -> BlockType -> ShowS
[BlockType] -> ShowS
BlockType -> String
(Int -> BlockType -> ShowS)
-> (BlockType -> String)
-> ([BlockType] -> ShowS)
-> Show BlockType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BlockType] -> ShowS
$cshowList :: [BlockType] -> ShowS
show :: BlockType -> String
$cshow :: BlockType -> String
showsPrec :: Int -> BlockType -> ShowS
$cshowsPrec :: Int -> BlockType -> ShowS
Show, BlockType -> BlockType -> Bool
(BlockType -> BlockType -> Bool)
-> (BlockType -> BlockType -> Bool) -> Eq BlockType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BlockType -> BlockType -> Bool
$c/= :: BlockType -> BlockType -> Bool
== :: BlockType -> BlockType -> Bool
$c== :: BlockType -> BlockType -> Bool
Eq, (forall x. BlockType -> Rep BlockType x)
-> (forall x. Rep BlockType x -> BlockType) -> Generic BlockType
forall x. Rep BlockType x -> BlockType
forall x. BlockType -> Rep BlockType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep BlockType x -> BlockType
$cfrom :: forall x. BlockType -> Rep BlockType x
Generic, BlockType -> ()
(BlockType -> ()) -> NFData BlockType
forall a. (a -> ()) -> NFData a
rnf :: BlockType -> ()
$crnf :: BlockType -> ()
NFData)

data Instruction index =
    -- Control instructions
    Unreachable
    | Nop
    | Block { Instruction index -> BlockType
blockType :: BlockType, Instruction index -> Expression
body :: Expression }
    | Loop { blockType :: BlockType, body :: Expression }
    | If { blockType :: BlockType, Instruction index -> Expression
true :: Expression, Instruction index -> Expression
false :: Expression }
    | Br index
    | BrIf index
    | BrTable [index] index
    | Return
    | Call index
    | CallIndirect index
    -- Parametric instructions
    | Drop
    | Select
    -- Variable instructions
    | GetLocal index
    | SetLocal index
    | TeeLocal index
    | GetGlobal index
    | SetGlobal index
    -- Memory instructions
    | I32Load MemArg
    | I64Load MemArg
    | F32Load MemArg
    | F64Load MemArg
    | I32Load8S MemArg
    | I32Load8U MemArg
    | I32Load16S MemArg
    | I32Load16U MemArg
    | I64Load8S MemArg
    | I64Load8U MemArg
    | I64Load16S MemArg
    | I64Load16U MemArg
    | I64Load32S MemArg
    | I64Load32U MemArg
    | I32Store MemArg
    | I64Store MemArg
    | F32Store MemArg
    | F64Store MemArg
    | I32Store8 MemArg
    | I32Store16 MemArg
    | I64Store8 MemArg
    | I64Store16 MemArg
    | I64Store32 MemArg
    | CurrentMemory
    | GrowMemory
    -- Numeric instructions
    | I32Const Word32
    | I64Const Word64
    | F32Const Float
    | F64Const Double
    | IUnOp BitSize IUnOp
    | IBinOp BitSize IBinOp
    | I32Eqz
    | I64Eqz
    | IRelOp BitSize IRelOp
    | FUnOp BitSize FUnOp
    | FBinOp BitSize FBinOp
    | FRelOp BitSize FRelOp
    | I32WrapI64
    | ITruncFU {- Int Size -} BitSize {- Float Size -} BitSize
    | ITruncFS {- Int Size -} BitSize {- Float Size -} BitSize
    | ITruncSatFU {- Int Size -} BitSize {- Float Size -} BitSize
    | ITruncSatFS {- Int Size -} BitSize {- Float Size -} BitSize
    | I64ExtendSI32
    | I64ExtendUI32
    | FConvertIU {- Float Size -} BitSize {- Int Size -} BitSize
    | FConvertIS {- Float Size -} BitSize {- Int Size -} BitSize
    | F32DemoteF64
    | F64PromoteF32
    | IReinterpretF BitSize
    | FReinterpretI BitSize
    deriving (Int -> Instruction index -> ShowS
[Instruction index] -> ShowS
Instruction index -> String
(Int -> Instruction index -> ShowS)
-> (Instruction index -> String)
-> ([Instruction index] -> ShowS)
-> Show (Instruction index)
forall index. Show index => Int -> Instruction index -> ShowS
forall index. Show index => [Instruction index] -> ShowS
forall index. Show index => Instruction index -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Instruction index] -> ShowS
$cshowList :: forall index. Show index => [Instruction index] -> ShowS
show :: Instruction index -> String
$cshow :: forall index. Show index => Instruction index -> String
showsPrec :: Int -> Instruction index -> ShowS
$cshowsPrec :: forall index. Show index => Int -> Instruction index -> ShowS
Show, Instruction index -> Instruction index -> Bool
(Instruction index -> Instruction index -> Bool)
-> (Instruction index -> Instruction index -> Bool)
-> Eq (Instruction index)
forall index.
Eq index =>
Instruction index -> Instruction index -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Instruction index -> Instruction index -> Bool
$c/= :: forall index.
Eq index =>
Instruction index -> Instruction index -> Bool
== :: Instruction index -> Instruction index -> Bool
$c== :: forall index.
Eq index =>
Instruction index -> Instruction index -> Bool
Eq, (forall x. Instruction index -> Rep (Instruction index) x)
-> (forall x. Rep (Instruction index) x -> Instruction index)
-> Generic (Instruction index)
forall x. Rep (Instruction index) x -> Instruction index
forall x. Instruction index -> Rep (Instruction index) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall index x. Rep (Instruction index) x -> Instruction index
forall index x. Instruction index -> Rep (Instruction index) x
$cto :: forall index x. Rep (Instruction index) x -> Instruction index
$cfrom :: forall index x. Instruction index -> Rep (Instruction index) x
Generic, Instruction index -> ()
(Instruction index -> ()) -> NFData (Instruction index)
forall index. NFData index => Instruction index -> ()
forall a. (a -> ()) -> NFData a
rnf :: Instruction index -> ()
$crnf :: forall index. NFData index => Instruction index -> ()
NFData)

type Expression = [Instruction Natural]

data Function = Function {
    Function -> Natural
funcType :: TypeIndex,
    Function -> [ValueType]
localTypes :: LocalsType,
    Function -> Expression
body :: Expression
} deriving (Int -> Function -> ShowS
[Function] -> ShowS
Function -> String
(Int -> Function -> ShowS)
-> (Function -> String) -> ([Function] -> ShowS) -> Show Function
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Function] -> ShowS
$cshowList :: [Function] -> ShowS
show :: Function -> String
$cshow :: Function -> String
showsPrec :: Int -> Function -> ShowS
$cshowsPrec :: Int -> Function -> ShowS
Show, Function -> Function -> Bool
(Function -> Function -> Bool)
-> (Function -> Function -> Bool) -> Eq Function
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Function -> Function -> Bool
$c/= :: Function -> Function -> Bool
== :: Function -> Function -> Bool
$c== :: Function -> Function -> Bool
Eq, (forall x. Function -> Rep Function x)
-> (forall x. Rep Function x -> Function) -> Generic Function
forall x. Rep Function x -> Function
forall x. Function -> Rep Function x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Function x -> Function
$cfrom :: forall x. Function -> Rep Function x
Generic, Function -> ()
(Function -> ()) -> NFData Function
forall a. (a -> ()) -> NFData a
rnf :: Function -> ()
$crnf :: Function -> ()
NFData)

data Limit = Limit Natural (Maybe Natural) deriving (Int -> Limit -> ShowS
[Limit] -> ShowS
Limit -> String
(Int -> Limit -> ShowS)
-> (Limit -> String) -> ([Limit] -> ShowS) -> Show Limit
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Limit] -> ShowS
$cshowList :: [Limit] -> ShowS
show :: Limit -> String
$cshow :: Limit -> String
showsPrec :: Int -> Limit -> ShowS
$cshowsPrec :: Int -> Limit -> ShowS
Show, Limit -> Limit -> Bool
(Limit -> Limit -> Bool) -> (Limit -> Limit -> Bool) -> Eq Limit
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Limit -> Limit -> Bool
$c/= :: Limit -> Limit -> Bool
== :: Limit -> Limit -> Bool
$c== :: Limit -> Limit -> Bool
Eq, (forall x. Limit -> Rep Limit x)
-> (forall x. Rep Limit x -> Limit) -> Generic Limit
forall x. Rep Limit x -> Limit
forall x. Limit -> Rep Limit x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Limit x -> Limit
$cfrom :: forall x. Limit -> Rep Limit x
Generic, Limit -> ()
(Limit -> ()) -> NFData Limit
forall a. (a -> ()) -> NFData a
rnf :: Limit -> ()
$crnf :: Limit -> ()
NFData)

data ElemType = FuncRef deriving (Int -> ElemType -> ShowS
[ElemType] -> ShowS
ElemType -> String
(Int -> ElemType -> ShowS)
-> (ElemType -> String) -> ([ElemType] -> ShowS) -> Show ElemType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ElemType] -> ShowS
$cshowList :: [ElemType] -> ShowS
show :: ElemType -> String
$cshow :: ElemType -> String
showsPrec :: Int -> ElemType -> ShowS
$cshowsPrec :: Int -> ElemType -> ShowS
Show, ElemType -> ElemType -> Bool
(ElemType -> ElemType -> Bool)
-> (ElemType -> ElemType -> Bool) -> Eq ElemType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ElemType -> ElemType -> Bool
$c/= :: ElemType -> ElemType -> Bool
== :: ElemType -> ElemType -> Bool
$c== :: ElemType -> ElemType -> Bool
Eq, (forall x. ElemType -> Rep ElemType x)
-> (forall x. Rep ElemType x -> ElemType) -> Generic ElemType
forall x. Rep ElemType x -> ElemType
forall x. ElemType -> Rep ElemType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ElemType x -> ElemType
$cfrom :: forall x. ElemType -> Rep ElemType x
Generic, ElemType -> ()
(ElemType -> ()) -> NFData ElemType
forall a. (a -> ()) -> NFData a
rnf :: ElemType -> ()
$crnf :: ElemType -> ()
NFData)

data TableType = TableType Limit ElemType deriving (Int -> TableType -> ShowS
[TableType] -> ShowS
TableType -> String
(Int -> TableType -> ShowS)
-> (TableType -> String)
-> ([TableType] -> ShowS)
-> Show TableType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TableType] -> ShowS
$cshowList :: [TableType] -> ShowS
show :: TableType -> String
$cshow :: TableType -> String
showsPrec :: Int -> TableType -> ShowS
$cshowsPrec :: Int -> TableType -> ShowS
Show, TableType -> TableType -> Bool
(TableType -> TableType -> Bool)
-> (TableType -> TableType -> Bool) -> Eq TableType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TableType -> TableType -> Bool
$c/= :: TableType -> TableType -> Bool
== :: TableType -> TableType -> Bool
$c== :: TableType -> TableType -> Bool
Eq, (forall x. TableType -> Rep TableType x)
-> (forall x. Rep TableType x -> TableType) -> Generic TableType
forall x. Rep TableType x -> TableType
forall x. TableType -> Rep TableType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TableType x -> TableType
$cfrom :: forall x. TableType -> Rep TableType x
Generic, TableType -> ()
(TableType -> ()) -> NFData TableType
forall a. (a -> ()) -> NFData a
rnf :: TableType -> ()
$crnf :: TableType -> ()
NFData)

data Table = Table TableType deriving (Int -> Table -> ShowS
[Table] -> ShowS
Table -> String
(Int -> Table -> ShowS)
-> (Table -> String) -> ([Table] -> ShowS) -> Show Table
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Table] -> ShowS
$cshowList :: [Table] -> ShowS
show :: Table -> String
$cshow :: Table -> String
showsPrec :: Int -> Table -> ShowS
$cshowsPrec :: Int -> Table -> ShowS
Show, Table -> Table -> Bool
(Table -> Table -> Bool) -> (Table -> Table -> Bool) -> Eq Table
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Table -> Table -> Bool
$c/= :: Table -> Table -> Bool
== :: Table -> Table -> Bool
$c== :: Table -> Table -> Bool
Eq, (forall x. Table -> Rep Table x)
-> (forall x. Rep Table x -> Table) -> Generic Table
forall x. Rep Table x -> Table
forall x. Table -> Rep Table x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Table x -> Table
$cfrom :: forall x. Table -> Rep Table x
Generic, Table -> ()
(Table -> ()) -> NFData Table
forall a. (a -> ()) -> NFData a
rnf :: Table -> ()
$crnf :: Table -> ()
NFData)

data Memory = Memory Limit deriving (Int -> Memory -> ShowS
[Memory] -> ShowS
Memory -> String
(Int -> Memory -> ShowS)
-> (Memory -> String) -> ([Memory] -> ShowS) -> Show Memory
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Memory] -> ShowS
$cshowList :: [Memory] -> ShowS
show :: Memory -> String
$cshow :: Memory -> String
showsPrec :: Int -> Memory -> ShowS
$cshowsPrec :: Int -> Memory -> ShowS
Show, Memory -> Memory -> Bool
(Memory -> Memory -> Bool)
-> (Memory -> Memory -> Bool) -> Eq Memory
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Memory -> Memory -> Bool
$c/= :: Memory -> Memory -> Bool
== :: Memory -> Memory -> Bool
$c== :: Memory -> Memory -> Bool
Eq, (forall x. Memory -> Rep Memory x)
-> (forall x. Rep Memory x -> Memory) -> Generic Memory
forall x. Rep Memory x -> Memory
forall x. Memory -> Rep Memory x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Memory x -> Memory
$cfrom :: forall x. Memory -> Rep Memory x
Generic, Memory -> ()
(Memory -> ()) -> NFData Memory
forall a. (a -> ()) -> NFData a
rnf :: Memory -> ()
$crnf :: Memory -> ()
NFData)

data GlobalType = Const ValueType | Mut ValueType deriving (Int -> GlobalType -> ShowS
[GlobalType] -> ShowS
GlobalType -> String
(Int -> GlobalType -> ShowS)
-> (GlobalType -> String)
-> ([GlobalType] -> ShowS)
-> Show GlobalType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GlobalType] -> ShowS
$cshowList :: [GlobalType] -> ShowS
show :: GlobalType -> String
$cshow :: GlobalType -> String
showsPrec :: Int -> GlobalType -> ShowS
$cshowsPrec :: Int -> GlobalType -> ShowS
Show, GlobalType -> GlobalType -> Bool
(GlobalType -> GlobalType -> Bool)
-> (GlobalType -> GlobalType -> Bool) -> Eq GlobalType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GlobalType -> GlobalType -> Bool
$c/= :: GlobalType -> GlobalType -> Bool
== :: GlobalType -> GlobalType -> Bool
$c== :: GlobalType -> GlobalType -> Bool
Eq, (forall x. GlobalType -> Rep GlobalType x)
-> (forall x. Rep GlobalType x -> GlobalType) -> Generic GlobalType
forall x. Rep GlobalType x -> GlobalType
forall x. GlobalType -> Rep GlobalType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GlobalType x -> GlobalType
$cfrom :: forall x. GlobalType -> Rep GlobalType x
Generic, GlobalType -> ()
(GlobalType -> ()) -> NFData GlobalType
forall a. (a -> ()) -> NFData a
rnf :: GlobalType -> ()
$crnf :: GlobalType -> ()
NFData)

data Global = Global {
    Global -> GlobalType
globalType :: GlobalType,
    Global -> Expression
initializer :: Expression
} deriving (Int -> Global -> ShowS
[Global] -> ShowS
Global -> String
(Int -> Global -> ShowS)
-> (Global -> String) -> ([Global] -> ShowS) -> Show Global
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Global] -> ShowS
$cshowList :: [Global] -> ShowS
show :: Global -> String
$cshow :: Global -> String
showsPrec :: Int -> Global -> ShowS
$cshowsPrec :: Int -> Global -> ShowS
Show, Global -> Global -> Bool
(Global -> Global -> Bool)
-> (Global -> Global -> Bool) -> Eq Global
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Global -> Global -> Bool
$c/= :: Global -> Global -> Bool
== :: Global -> Global -> Bool
$c== :: Global -> Global -> Bool
Eq, (forall x. Global -> Rep Global x)
-> (forall x. Rep Global x -> Global) -> Generic Global
forall x. Rep Global x -> Global
forall x. Global -> Rep Global x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Global x -> Global
$cfrom :: forall x. Global -> Rep Global x
Generic, Global -> ()
(Global -> ()) -> NFData Global
forall a. (a -> ()) -> NFData a
rnf :: Global -> ()
$crnf :: Global -> ()
NFData)

data ElemSegment = ElemSegment {
    ElemSegment -> Natural
tableIndex :: TableIndex,
    ElemSegment -> Expression
offset :: Expression,
    ElemSegment -> [Natural]
funcIndexes :: [FuncIndex]
} deriving (Int -> ElemSegment -> ShowS
[ElemSegment] -> ShowS
ElemSegment -> String
(Int -> ElemSegment -> ShowS)
-> (ElemSegment -> String)
-> ([ElemSegment] -> ShowS)
-> Show ElemSegment
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ElemSegment] -> ShowS
$cshowList :: [ElemSegment] -> ShowS
show :: ElemSegment -> String
$cshow :: ElemSegment -> String
showsPrec :: Int -> ElemSegment -> ShowS
$cshowsPrec :: Int -> ElemSegment -> ShowS
Show, ElemSegment -> ElemSegment -> Bool
(ElemSegment -> ElemSegment -> Bool)
-> (ElemSegment -> ElemSegment -> Bool) -> Eq ElemSegment
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ElemSegment -> ElemSegment -> Bool
$c/= :: ElemSegment -> ElemSegment -> Bool
== :: ElemSegment -> ElemSegment -> Bool
$c== :: ElemSegment -> ElemSegment -> Bool
Eq, (forall x. ElemSegment -> Rep ElemSegment x)
-> (forall x. Rep ElemSegment x -> ElemSegment)
-> Generic ElemSegment
forall x. Rep ElemSegment x -> ElemSegment
forall x. ElemSegment -> Rep ElemSegment x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ElemSegment x -> ElemSegment
$cfrom :: forall x. ElemSegment -> Rep ElemSegment x
Generic, ElemSegment -> ()
(ElemSegment -> ()) -> NFData ElemSegment
forall a. (a -> ()) -> NFData a
rnf :: ElemSegment -> ()
$crnf :: ElemSegment -> ()
NFData)

data DataSegment = DataSegment {
    DataSegment -> Natural
memIndex :: MemoryIndex,
    DataSegment -> Expression
offset :: Expression,
    DataSegment -> ByteString
chunk :: LBS.ByteString
} deriving (Int -> DataSegment -> ShowS
[DataSegment] -> ShowS
DataSegment -> String
(Int -> DataSegment -> ShowS)
-> (DataSegment -> String)
-> ([DataSegment] -> ShowS)
-> Show DataSegment
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DataSegment] -> ShowS
$cshowList :: [DataSegment] -> ShowS
show :: DataSegment -> String
$cshow :: DataSegment -> String
showsPrec :: Int -> DataSegment -> ShowS
$cshowsPrec :: Int -> DataSegment -> ShowS
Show, DataSegment -> DataSegment -> Bool
(DataSegment -> DataSegment -> Bool)
-> (DataSegment -> DataSegment -> Bool) -> Eq DataSegment
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DataSegment -> DataSegment -> Bool
$c/= :: DataSegment -> DataSegment -> Bool
== :: DataSegment -> DataSegment -> Bool
$c== :: DataSegment -> DataSegment -> Bool
Eq, (forall x. DataSegment -> Rep DataSegment x)
-> (forall x. Rep DataSegment x -> DataSegment)
-> Generic DataSegment
forall x. Rep DataSegment x -> DataSegment
forall x. DataSegment -> Rep DataSegment x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DataSegment x -> DataSegment
$cfrom :: forall x. DataSegment -> Rep DataSegment x
Generic, DataSegment -> ()
(DataSegment -> ()) -> NFData DataSegment
forall a. (a -> ()) -> NFData a
rnf :: DataSegment -> ()
$crnf :: DataSegment -> ()
NFData)

data StartFunction = StartFunction FuncIndex deriving (Int -> StartFunction -> ShowS
[StartFunction] -> ShowS
StartFunction -> String
(Int -> StartFunction -> ShowS)
-> (StartFunction -> String)
-> ([StartFunction] -> ShowS)
-> Show StartFunction
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StartFunction] -> ShowS
$cshowList :: [StartFunction] -> ShowS
show :: StartFunction -> String
$cshow :: StartFunction -> String
showsPrec :: Int -> StartFunction -> ShowS
$cshowsPrec :: Int -> StartFunction -> ShowS
Show, StartFunction -> StartFunction -> Bool
(StartFunction -> StartFunction -> Bool)
-> (StartFunction -> StartFunction -> Bool) -> Eq StartFunction
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StartFunction -> StartFunction -> Bool
$c/= :: StartFunction -> StartFunction -> Bool
== :: StartFunction -> StartFunction -> Bool
$c== :: StartFunction -> StartFunction -> Bool
Eq, (forall x. StartFunction -> Rep StartFunction x)
-> (forall x. Rep StartFunction x -> StartFunction)
-> Generic StartFunction
forall x. Rep StartFunction x -> StartFunction
forall x. StartFunction -> Rep StartFunction x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep StartFunction x -> StartFunction
$cfrom :: forall x. StartFunction -> Rep StartFunction x
Generic, StartFunction -> ()
(StartFunction -> ()) -> NFData StartFunction
forall a. (a -> ()) -> NFData a
rnf :: StartFunction -> ()
$crnf :: StartFunction -> ()
NFData)

data ExportDesc =
    ExportFunc FuncIndex
    | ExportTable TableIndex
    | ExportMemory MemoryIndex
    | ExportGlobal GlobalIndex
    deriving (Int -> ExportDesc -> ShowS
[ExportDesc] -> ShowS
ExportDesc -> String
(Int -> ExportDesc -> ShowS)
-> (ExportDesc -> String)
-> ([ExportDesc] -> ShowS)
-> Show ExportDesc
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ExportDesc] -> ShowS
$cshowList :: [ExportDesc] -> ShowS
show :: ExportDesc -> String
$cshow :: ExportDesc -> String
showsPrec :: Int -> ExportDesc -> ShowS
$cshowsPrec :: Int -> ExportDesc -> ShowS
Show, ExportDesc -> ExportDesc -> Bool
(ExportDesc -> ExportDesc -> Bool)
-> (ExportDesc -> ExportDesc -> Bool) -> Eq ExportDesc
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ExportDesc -> ExportDesc -> Bool
$c/= :: ExportDesc -> ExportDesc -> Bool
== :: ExportDesc -> ExportDesc -> Bool
$c== :: ExportDesc -> ExportDesc -> Bool
Eq, (forall x. ExportDesc -> Rep ExportDesc x)
-> (forall x. Rep ExportDesc x -> ExportDesc) -> Generic ExportDesc
forall x. Rep ExportDesc x -> ExportDesc
forall x. ExportDesc -> Rep ExportDesc x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ExportDesc x -> ExportDesc
$cfrom :: forall x. ExportDesc -> Rep ExportDesc x
Generic, ExportDesc -> ()
(ExportDesc -> ()) -> NFData ExportDesc
forall a. (a -> ()) -> NFData a
rnf :: ExportDesc -> ()
$crnf :: ExportDesc -> ()
NFData)

data Export = Export {
    Export -> Text
name :: TL.Text,
    Export -> ExportDesc
desc :: ExportDesc
} deriving (Int -> Export -> ShowS
[Export] -> ShowS
Export -> String
(Int -> Export -> ShowS)
-> (Export -> String) -> ([Export] -> ShowS) -> Show Export
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Export] -> ShowS
$cshowList :: [Export] -> ShowS
show :: Export -> String
$cshow :: Export -> String
showsPrec :: Int -> Export -> ShowS
$cshowsPrec :: Int -> Export -> ShowS
Show, Export -> Export -> Bool
(Export -> Export -> Bool)
-> (Export -> Export -> Bool) -> Eq Export
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Export -> Export -> Bool
$c/= :: Export -> Export -> Bool
== :: Export -> Export -> Bool
$c== :: Export -> Export -> Bool
Eq, (forall x. Export -> Rep Export x)
-> (forall x. Rep Export x -> Export) -> Generic Export
forall x. Rep Export x -> Export
forall x. Export -> Rep Export x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Export x -> Export
$cfrom :: forall x. Export -> Rep Export x
Generic, Export -> ()
(Export -> ()) -> NFData Export
forall a. (a -> ()) -> NFData a
rnf :: Export -> ()
$crnf :: Export -> ()
NFData)

data ImportDesc =
    ImportFunc TypeIndex
    | ImportTable TableType
    | ImportMemory Limit
    | ImportGlobal GlobalType
    deriving (Int -> ImportDesc -> ShowS
[ImportDesc] -> ShowS
ImportDesc -> String
(Int -> ImportDesc -> ShowS)
-> (ImportDesc -> String)
-> ([ImportDesc] -> ShowS)
-> Show ImportDesc
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ImportDesc] -> ShowS
$cshowList :: [ImportDesc] -> ShowS
show :: ImportDesc -> String
$cshow :: ImportDesc -> String
showsPrec :: Int -> ImportDesc -> ShowS
$cshowsPrec :: Int -> ImportDesc -> ShowS
Show, ImportDesc -> ImportDesc -> Bool
(ImportDesc -> ImportDesc -> Bool)
-> (ImportDesc -> ImportDesc -> Bool) -> Eq ImportDesc
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ImportDesc -> ImportDesc -> Bool
$c/= :: ImportDesc -> ImportDesc -> Bool
== :: ImportDesc -> ImportDesc -> Bool
$c== :: ImportDesc -> ImportDesc -> Bool
Eq, (forall x. ImportDesc -> Rep ImportDesc x)
-> (forall x. Rep ImportDesc x -> ImportDesc) -> Generic ImportDesc
forall x. Rep ImportDesc x -> ImportDesc
forall x. ImportDesc -> Rep ImportDesc x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ImportDesc x -> ImportDesc
$cfrom :: forall x. ImportDesc -> Rep ImportDesc x
Generic, ImportDesc -> ()
(ImportDesc -> ()) -> NFData ImportDesc
forall a. (a -> ()) -> NFData a
rnf :: ImportDesc -> ()
$crnf :: ImportDesc -> ()
NFData)

data Import = Import {
    Import -> Text
sourceModule :: TL.Text,
    Import -> Text
name :: TL.Text,
    Import -> ImportDesc
desc :: ImportDesc
} deriving (Int -> Import -> ShowS
[Import] -> ShowS
Import -> String
(Int -> Import -> ShowS)
-> (Import -> String) -> ([Import] -> ShowS) -> Show Import
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Import] -> ShowS
$cshowList :: [Import] -> ShowS
show :: Import -> String
$cshow :: Import -> String
showsPrec :: Int -> Import -> ShowS
$cshowsPrec :: Int -> Import -> ShowS
Show, Import -> Import -> Bool
(Import -> Import -> Bool)
-> (Import -> Import -> Bool) -> Eq Import
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Import -> Import -> Bool
$c/= :: Import -> Import -> Bool
== :: Import -> Import -> Bool
$c== :: Import -> Import -> Bool
Eq, (forall x. Import -> Rep Import x)
-> (forall x. Rep Import x -> Import) -> Generic Import
forall x. Rep Import x -> Import
forall x. Import -> Rep Import x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Import x -> Import
$cfrom :: forall x. Import -> Rep Import x
Generic, Import -> ()
(Import -> ()) -> NFData Import
forall a. (a -> ()) -> NFData a
rnf :: Import -> ()
$crnf :: Import -> ()
NFData)

isFuncImport :: Import -> Bool
isFuncImport :: Import -> Bool
isFuncImport (Import Text
_ Text
_ (ImportFunc Natural
_)) = Bool
True
isFuncImport Import
_ = Bool
False

isTableImport :: Import -> Bool
isTableImport :: Import -> Bool
isTableImport (Import Text
_ Text
_ (ImportTable TableType
_)) = Bool
True
isTableImport Import
_ = Bool
False

isMemImport :: Import -> Bool
isMemImport :: Import -> Bool
isMemImport (Import Text
_ Text
_ (ImportMemory Limit
_)) = Bool
True
isMemImport Import
_ = Bool
False

isGlobalImport :: Import -> Bool
isGlobalImport :: Import -> Bool
isGlobalImport (Import Text
_ Text
_ (ImportGlobal GlobalType
_)) = Bool
True
isGlobalImport Import
_ = Bool
False

data Module = Module {
    Module -> [FuncType]
types :: [FuncType],
    Module -> [Function]
functions :: [Function],
    Module -> [Table]
tables :: [Table],
    Module -> [Memory]
mems :: [Memory],
    Module -> [Global]
globals :: [Global],
    Module -> [ElemSegment]
elems :: [ElemSegment],
    Module -> [DataSegment]
datas :: [DataSegment],
    Module -> Maybe StartFunction
start :: Maybe StartFunction,
    Module -> [Import]
imports :: [Import],
    Module -> [Export]
exports :: [Export]
} deriving (Int -> Module -> ShowS
[Module] -> ShowS
Module -> String
(Int -> Module -> ShowS)
-> (Module -> String) -> ([Module] -> ShowS) -> Show Module
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Module] -> ShowS
$cshowList :: [Module] -> ShowS
show :: Module -> String
$cshow :: Module -> String
showsPrec :: Int -> Module -> ShowS
$cshowsPrec :: Int -> Module -> ShowS
Show, Module -> Module -> Bool
(Module -> Module -> Bool)
-> (Module -> Module -> Bool) -> Eq Module
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Module -> Module -> Bool
$c/= :: Module -> Module -> Bool
== :: Module -> Module -> Bool
$c== :: Module -> Module -> Bool
Eq, (forall x. Module -> Rep Module x)
-> (forall x. Rep Module x -> Module) -> Generic Module
forall x. Rep Module x -> Module
forall x. Module -> Rep Module x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Module x -> Module
$cfrom :: forall x. Module -> Rep Module x
Generic, Module -> ()
(Module -> ()) -> NFData Module
forall a. (a -> ()) -> NFData a
rnf :: Module -> ()
$crnf :: Module -> ()
NFData)

emptyModule :: Module
emptyModule :: Module
emptyModule = Module :: [FuncType]
-> [Function]
-> [Table]
-> [Memory]
-> [Global]
-> [ElemSegment]
-> [DataSegment]
-> Maybe StartFunction
-> [Import]
-> [Export]
-> Module
Module {
    $sel:types:Module :: [FuncType]
types = [],
    $sel:functions:Module :: [Function]
functions = [],
    $sel:tables:Module :: [Table]
tables = [],
    $sel:mems:Module :: [Memory]
mems = [],
    $sel:globals:Module :: [Global]
globals = [],
    $sel:elems:Module :: [ElemSegment]
elems = [],
    $sel:datas:Module :: [DataSegment]
datas = [],
    $sel:start:Module :: Maybe StartFunction
start = Maybe StartFunction
forall a. Maybe a
Nothing,
    $sel:imports:Module :: [Import]
imports = [],
    $sel:exports:Module :: [Export]
exports = []
}