From 66458e11f360598c262090b0e4b8a41bb26764d2 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?=D0=98=D0=BB=D1=8C=D1=8F=20=D0=A0=D0=B5=D0=B7=D0=B2=D0=BE?=
 =?UTF-8?q?=D0=B2?= <irezvov@Ilas-iMac.local>
Date: Sat, 11 Dec 2021 20:59:34 -0700
Subject: [PATCH 01/28] update test specs to bring fixed SIMD and reference
 types

---
 tests/spec | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/tests/spec b/tests/spec
index 9994915..6241ce9 160000
--- a/tests/spec
+++ b/tests/spec
@@ -1 +1 @@
-Subproject commit 9994915e0cca8b42a16c577e4c85491822367dde
+Subproject commit 6241ce9e153e83ae281998ea8c9f54fe7748ee7c

From 99532adb63eb542be596ef495e28adfc2ab1e2be Mon Sep 17 00:00:00 2001
From: Ilya Rezvov <rezvov.ilya@gmail.com>
Date: Sat, 11 Dec 2021 21:39:18 -0700
Subject: [PATCH 02/28] bump version

---
 .gitignore |  2 ++
 wasm.cabal | 12 ++++++------
 2 files changed, 8 insertions(+), 6 deletions(-)

diff --git a/.gitignore b/.gitignore
index 4df1510..745913c 100644
--- a/.gitignore
+++ b/.gitignore
@@ -8,3 +8,5 @@ dist-newstyle/
 doc/
 setup-config
 wasm-*-docs.tar.gz
+cache
+packagedb
\ No newline at end of file
diff --git a/wasm.cabal b/wasm.cabal
index da65d94..0e6b479 100644
--- a/wasm.cabal
+++ b/wasm.cabal
@@ -1,6 +1,6 @@
 cabal-version:  2.2
 name:           wasm
-version:        1.0.1.0
+version:        1.1.1
 synopsis:       WebAssembly Language Toolkit and Interpreter
 description:
   Library for parsing and interpreting WebAssembly, including:
@@ -33,14 +33,14 @@ library
       Language.Wasm.Script
       Language.Wasm.Lexer
       Language.Wasm.Structure
-      Language.Wasm
-  other-modules:
-      Language.Wasm.Binary
-      Language.Wasm.Builder
-      Language.Wasm.FloatUtils
       Language.Wasm.Interpreter
       Language.Wasm.Parser
       Language.Wasm.Validate
+      Language.Wasm.Binary
+      Language.Wasm.Builder
+      Language.Wasm
+  other-modules:
+      Language.Wasm.FloatUtils
       Paths_wasm
   autogen-modules:
       Paths_wasm

From 960acac955b35a9d5e2db569f413a045aabef6f2 Mon Sep 17 00:00:00 2001
From: Ilya Rezvov <rezvov.ilya@gmail.com>
Date: Sun, 30 Jan 2022 16:21:22 -0700
Subject: [PATCH 03/28] syntax support for ref.ops and pass ref_null.wast

---
 src/Language/Wasm/Interpreter.hs | 16 ++++++++++++++++
 src/Language/Wasm/Parser.y       | 27 +++++++++++++++++++++++++++
 src/Language/Wasm/Script.hs      |  4 ++++
 src/Language/Wasm/Structure.hs   |  8 +++++++-
 src/Language/Wasm/Validate.hs    | 12 ++++++++++++
 tests/Test.hs                    |  2 +-
 6 files changed, 67 insertions(+), 2 deletions(-)

diff --git a/src/Language/Wasm/Interpreter.hs b/src/Language/Wasm/Interpreter.hs
index 99dfd43..f3bdbdf 100644
--- a/src/Language/Wasm/Interpreter.hs
+++ b/src/Language/Wasm/Interpreter.hs
@@ -70,6 +70,8 @@ data Value =
     | VI64 Word64
     | VF32 Float
     | VF64 Double
+    | RF (Maybe Natural)
+    | RE (Maybe Natural)
     deriving (Eq, Show)
 
 asInt32 :: Word32 -> Int32
@@ -187,6 +189,8 @@ getValueType (VI32 _) = I32
 getValueType (VI64 _) = I64
 getValueType (VF32 _) = F32
 getValueType (VF64 _) = F64
+getValueType (RF _) = Func
+genValueType (RE _) = Extern
 
 data ExportInstance = ExportInstance TL.Text ExternalValue deriving (Eq, Show)
 
@@ -422,6 +426,9 @@ evalConstExpr _ _ [I32Const v] = return $ VI32 v
 evalConstExpr _ _ [I64Const v] = return $ VI64 v
 evalConstExpr _ _ [F32Const v] = return $ VF32 v
 evalConstExpr _ _ [F64Const v] = return $ VF64 v
+evalConstExpr _ _ [RefNull FuncRef] = return $ RF Nothing
+evalConstExpr _ _ [RefNull ExternRef] = return $ RE Nothing
+evalConstExpr _ _ [RefFunc idx] = return $ RF $ Just idx
 evalConstExpr inst store [GetGlobal i] = getGlobalValue inst store i
 evalConstExpr _ _ instrs = error $ "Global initializer contains unsupported instructions: " ++ show instrs
 
@@ -718,6 +725,15 @@ eval budget store FunctionInstance { funcType, moduleInstance, code = Function {
                         Just res -> return $ Done ctx { stack = reverse res ++ (drop (length params) rest) }
                         Nothing -> return Trap
                 Nothing -> return Trap
+        step ctx@EvalCtx{ stack = st } (RefNull FuncRef) =
+            return $ Done ctx { stack = RF Nothing : st }
+        step ctx@EvalCtx{ stack = st } (RefNull ExternRef) =
+            return $ Done ctx { stack = RE Nothing : st }
+        step ctx@EvalCtx{ stack = v:rest } RefIsNull =
+            let r = case v of { RE Nothing -> 1; RF Nothing -> 1; _ -> 0 } in
+            return $ Done ctx { stack = VI32 r : rest }
+        step ctx@EvalCtx{ stack = st } (RefFunc index) =
+            return $ Done ctx { stack = RF (Just index) : st }
         step ctx@EvalCtx{ stack = (_:rest) } Drop = return $ Done ctx { stack = rest }
         step ctx@EvalCtx{ stack = (VI32 test:val2:val1:rest) } Select =
             if test == 0
diff --git a/src/Language/Wasm/Parser.y b/src/Language/Wasm/Parser.y
index c0f239a..665f1ae 100644
--- a/src/Language/Wasm/Parser.y
+++ b/src/Language/Wasm/Parser.y
@@ -119,6 +119,8 @@ import Language.Wasm.Lexer (
 'f64'                 { Lexeme _ (TKeyword "f64") }
 'mut'                 { Lexeme _ (TKeyword "mut") }
 'funcref'             { Lexeme _ (TKeyword "funcref") }
+'externref'           { Lexeme _ (TKeyword "externref") }
+'extern'              { Lexeme _ (TKeyword "extern") }
 'type'                { Lexeme _ (TKeyword "type") }
 'unreachable'         { Lexeme _ (TKeyword "unreachable") }
 'nop'                 { Lexeme _ (TKeyword "nop") }
@@ -128,6 +130,9 @@ import Language.Wasm.Lexer (
 'return'              { Lexeme _ (TKeyword "return") }
 'call'                { Lexeme _ (TKeyword "call") }
 'call_indirect'       { Lexeme _ (TKeyword "call_indirect") }
+'ref.null'            { Lexeme _ (TKeyword "ref.null") }
+'ref.is_null'         { Lexeme _ (TKeyword "ref.is_null") }
+'ref.func'            { Lexeme _ (TKeyword "ref.func") }
 'drop'                { Lexeme _ (TKeyword "drop") }
 'select'              { Lexeme _ (TKeyword "select") }
 'get_local'           { Lexeme _ (TKeyword "local.get") }
@@ -363,6 +368,8 @@ valtype :: { ValueType }
     | 'i64' { I64 }
     | 'f32' { F32 }
     | 'f64' { F64 }
+    | 'funcref' { Func }
+    | 'externref' { Extern }
 
 index :: { Index }
     : u32 { Index $1 }
@@ -418,6 +425,10 @@ plaininstr :: { PlainInstr }
     | 'call' index                   { Call $2 }
     | 'drop'                         { Drop }
     | 'select'                       { Select }
+    -- reference instructions
+    | 'ref.null' heaptype            { RefNull $2 }
+    | 'ref.is_null'                  { RefIsNull }
+    | 'ref.func' index               { RefFunc $2 }
     -- variable instructions
     | 'get_local' index              { GetLocal $2 }
     | 'set_local' index              { SetLocal $2 }
@@ -856,6 +867,11 @@ limits :: { Limit }
 
 elemtype :: { ElemType }
     : 'funcref' { FuncRef }
+    | 'externref' { ExternRef }
+
+heaptype :: { ElemType }
+    : 'func' { FuncRef }
+    | 'extern' { ExternRef }
 
 tabletype :: { TableType }
     : limits elemtype { TableType $1 $2 }
@@ -1116,6 +1132,10 @@ data PlainInstr =
     | Return
     | Call FuncIndex
     | CallIndirect TypeUse
+    -- Reference instructions
+    | RefNull ElemType
+    | RefIsNull
+    | RefFunc FuncIndex
     -- Parametric instructions
     | Drop
     | Select
@@ -1376,6 +1396,7 @@ constInstructionToValue (PlainInstr (I32Const v)) = S.I32Const $ integerToWord32
 constInstructionToValue (PlainInstr (F32Const v)) = S.F32Const v
 constInstructionToValue (PlainInstr (I64Const v)) = S.I64Const $ integerToWord64 v
 constInstructionToValue (PlainInstr (F64Const v)) = S.F64Const v
+constInstructionToValue (PlainInstr (RefNull et)) = S.RefNull et
 constInstructionToValue _ = error "Only const instructions supported as arguments for actions"
 
 desugarize :: [ModuleField] -> Either String S.Module
@@ -1562,6 +1583,12 @@ desugarize fields = do
                 Nothing -> Left "unknown type"
         synInstrToStruct _ (PlainInstr Drop) = return $ S.Drop
         synInstrToStruct _ (PlainInstr Select) = return $ S.Select
+        synInstrToStruct _ (PlainInstr (RefNull elType)) = return $ S.RefNull elType
+        synInstrToStruct _ (PlainInstr RefIsNull) = return $ S.RefIsNull
+        synInstrToStruct FunCtx { ctxMod } (PlainInstr (RefFunc funIdx)) =
+            case getFuncIndex ctxMod funIdx of
+                Just idx -> return $ S.RefFunc idx
+                Nothing -> Left "unknown function"
         synInstrToStruct ctx (PlainInstr (GetLocal localIdx)) =
             case getLocalIndex ctx localIdx of
                 Just idx -> return $ S.GetLocal idx
diff --git a/src/Language/Wasm/Script.hs b/src/Language/Wasm/Script.hs
index 08ced60..8cd175c 100644
--- a/src/Language/Wasm/Script.hs
+++ b/src/Language/Wasm/Script.hs
@@ -122,6 +122,8 @@ runScript onAssertFail script = do
         asArg [Struct.F32Const v] = Interpreter.VF32 v
         asArg [Struct.I64Const v] = Interpreter.VI64 v
         asArg [Struct.F64Const v] = Interpreter.VF64 v
+        asArg [Struct.RefNull Struct.FuncRef] = Interpreter.RF Nothing
+        asArg [Struct.RefNull Struct.ExternRef] = Interpreter.RE Nothing
         asArg _                   = error "Only const instructions supported as arguments for actions"
 
         runAction :: ScriptState -> Action -> IO (Maybe [Interpreter.Value])
@@ -139,6 +141,8 @@ runScript onAssertFail script = do
         isValueEqual (Interpreter.VI64 v1) (Interpreter.VI64 v2) = v1 == v2
         isValueEqual (Interpreter.VF32 v1) (Interpreter.VF32 v2) = (isNaN v1 && isNaN v2) || identicalIEEE v1 v2
         isValueEqual (Interpreter.VF64 v1) (Interpreter.VF64 v2) = (isNaN v1 && isNaN v2) || identicalIEEE v1 v2
+        isValueEqual (Interpreter.RF f1) (Interpreter.RF f2) = f1 == f2
+        isValueEqual (Interpreter.RE e1) (Interpreter.RE e2) = e1 == e2
         isValueEqual _ _ = False
 
         isNaNReturned :: Action -> Assertion -> AssertM ()
diff --git a/src/Language/Wasm/Structure.hs b/src/Language/Wasm/Structure.hs
index dcb8c16..0f8e4a4 100644
--- a/src/Language/Wasm/Structure.hs
+++ b/src/Language/Wasm/Structure.hs
@@ -108,6 +108,8 @@ data ValueType =
     | I64
     | F32
     | F64
+    | Func
+    | Extern
     deriving (Show, Eq, Generic, NFData)
 
 type ResultType = [ValueType]
@@ -134,6 +136,10 @@ data Instruction index =
     | Return
     | Call index
     | CallIndirect index
+    -- Reference instructions
+    | RefNull ElemType
+    | RefIsNull
+    | RefFunc index
     -- Parametric instructions
     | Drop
     | Select
@@ -207,7 +213,7 @@ data Function = Function {
 
 data Limit = Limit Natural (Maybe Natural) deriving (Show, Eq, Generic, NFData)
 
-data ElemType = FuncRef deriving (Show, Eq, Generic, NFData)
+data ElemType = FuncRef | ExternRef deriving (Show, Eq, Generic, NFData)
 
 data TableType = TableType Limit ElemType deriving (Show, Eq, Generic, NFData)
 
diff --git a/src/Language/Wasm/Validate.hs b/src/Language/Wasm/Validate.hs
index 5741328..5979553 100644
--- a/src/Language/Wasm/Validate.hs
+++ b/src/Language/Wasm/Validate.hs
@@ -258,6 +258,16 @@ getInstrType Drop = do
 getInstrType Select = do
     var <- freshVar
     return $ [var, var, Val I32] ==> var
+getInstrType (RefNull elType) = do
+    let t = case elType of { FuncRef -> Func; ExternRef -> Extern }
+    return $ empty ==> Val t
+getInstrType RefIsNull = do
+    return $ empty ==> Val I32
+getInstrType (RefFunc funIdx) = do
+    Ctx { funcs } <- ask
+    if fromIntegral funIdx < length funcs
+    then return $ empty ==> Val I32
+    else throwError FunctionIndexOutOfRange
 getInstrType (GetLocal local) = do
     Ctx { locals }  <- ask
     t <- maybeToEither (LocalIndexOutOfRange local) $ locals !? local
@@ -445,6 +455,8 @@ isConstExpression ((I32Const _):rest) = isConstExpression rest
 isConstExpression ((I64Const _):rest) = isConstExpression rest
 isConstExpression ((F32Const _):rest) = isConstExpression rest
 isConstExpression ((F64Const _):rest) = isConstExpression rest
+isConstExpression ((RefNull _):rest) = isConstExpression rest
+isConstExpression ((RefFunc _):rest) = isConstExpression rest
 isConstExpression ((GetGlobal idx):rest) = do
     Ctx {globals, importedGlobals} <- ask
     if importedGlobals <= idx
diff --git a/tests/Test.hs b/tests/Test.hs
index 7cccffe..b541ffe 100644
--- a/tests/Test.hs
+++ b/tests/Test.hs
@@ -17,7 +17,7 @@ import qualified Data.List as List
 main :: IO ()
 main = do
   files <- filter (List.isSuffixOf ".wast") <$> Directory.listDirectory "tests/spec"
-  -- let files = ["const.wast"]
+  let files = ["ref_null.wast", "ref_is_null.wast"]
   scriptTestCases <- (`mapM` files) $ \file -> do
     test <- LBS.readFile ("tests/spec/" ++ file)
     return $ testCase file $ do

From 8af7b4568184a367cb32419079c612956375db80 Mon Sep 17 00:00:00 2001
From: Ilya Rezvov <rezvov.ilya@gmail.com>
Date: Tue, 1 Feb 2022 21:18:12 -0700
Subject: [PATCH 04/28] update text and binary parsers to new elem formats

---
 src/Language/Wasm/Binary.hs    | 58 +++++++++++++++++++++++--
 src/Language/Wasm/Parser.y     | 78 ++++++++++++++++++++++++++--------
 src/Language/Wasm/Structure.hs | 13 ++++--
 tests/Test.hs                  |  3 +-
 4 files changed, 126 insertions(+), 26 deletions(-)

diff --git a/src/Language/Wasm/Binary.hs b/src/Language/Wasm/Binary.hs
index 4a6f0fa..87f19ca 100644
--- a/src/Language/Wasm/Binary.hs
+++ b/src/Language/Wasm/Binary.hs
@@ -244,7 +244,13 @@ instance Serialize FuncType where
 
 instance Serialize ElemType where
     put FuncRef = putWord8 0x70
-    get = byteGuard 0x70 >> return FuncRef
+    put ExternRef = putWord8 0x6F
+    get = do
+        op <- getWord8
+        case op of
+            0x70 -> return FuncRef
+            0x69 -> return ExternRef
+            _ -> fail "unknown reference type"
 
 instance Serialize Limit where
     put (Limit min Nothing) = putWord8 0x00 >> putULEB128 min
@@ -793,11 +799,55 @@ instance Serialize Export where
     get = Export <$> getName <*> get
 
 instance Serialize ElemSegment where
-    put (ElemSegment tableIndex offset funcIndexes) = do
+    put (ElemSegment elemType Passive elements) = do
+        putWord8 0x05
+        put elemType
+        putVec $ map putExpression elements
+    put (ElemSegment elemType (Active tableIndex offset) elements) = do
+        putWord8 0x06
         putULEB128 tableIndex
         putExpression offset
-        putVec $ map Index funcIndexes
-    get = ElemSegment <$> getULEB128 32 <*> getExpression <*> (map unIndex <$> getVec)
+        put elemType
+        putVec $ map putExpression elements
+    put (ElemSegment elemType Declarative elements) = do
+        putWord8 0x07
+        put elemType
+        putVec $ map putExpression elements
+    get = do
+        op <- getWord8
+        let funcIndexes = map ((:[]) . RefFunc . unIndex) <$> getVec
+        let elemKind = byteGuard 0x00 >> return FuncRef
+        case op of
+            0x00 -> do
+                offset <- getExpression
+                ElemSegment FuncRef (Active 0 offset) <$> funcIndexes
+            0x01 -> do
+                elemType <- elemKind
+                ElemSegment elemType Passive <$> funcIndexes
+            0x02 -> do
+                tableIndex <- getULEB128 32
+                offset <- getExpression
+                elemType <- elemKind
+                ElemSegment elemType (Active tableIndex offset) <$> funcIndexes
+            0x03 -> do
+                elemType <- elemKind
+                ElemSegment elemType Declarative <$> funcIndexes
+            0x04 -> do
+                offset <- getExpression
+                ElemSegment FuncRef (Active 0 offset) <$> funcIndexes
+            0x05 -> do
+                elemType <- get
+                ElemSegment elemType Passive <$> getVec
+            0x06 -> do
+                tableIndex <- getULEB128 32
+                offset <- getExpression
+                elemType <- get
+                ElemSegment elemType (Active tableIndex offset) <$> getVec
+            0x07 -> do
+                elemType <- get
+                ElemSegment elemType Declarative <$> getVec
+            _ ->
+                fail "unknown element segment type"
 
 data LocalTypeRange = LocalTypeRange Natural ValueType deriving (Show, Eq)
 
diff --git a/src/Language/Wasm/Parser.y b/src/Language/Wasm/Parser.y
index 665f1ae..6308e60 100644
--- a/src/Language/Wasm/Parser.y
+++ b/src/Language/Wasm/Parser.y
@@ -318,6 +318,8 @@ import Language.Wasm.Lexer (
 'export'              { Lexeme _ (TKeyword "export") }
 'local'               { Lexeme _ (TKeyword "local") }
 'elem'                { Lexeme _ (TKeyword "elem") }
+'item'                { Lexeme _ (TKeyword "item") }
+'declare'             { Lexeme _ (TKeyword "declare") }
 'data'                { Lexeme _ (TKeyword "data") }
 'offset'              { Lexeme _ (TKeyword "offset") }
 'start'               { Lexeme _ (TKeyword "start") }
@@ -885,7 +887,10 @@ limits_elemtype_elem :: { Maybe Ident -> [ModuleField] }
         \ident ->
             let funcsLen = fromIntegral $ length $4 in [
                 MFTable $ Table [] ident $ TableType (Limit funcsLen (Just funcsLen)) $1,
-                MFElem $ ElemSegment (fromMaybe (Index 0) $ Named `fmap` ident) [PlainInstr $ I32Const 0] $4
+                let tableIndex = (fromMaybe (Index 0) $ Named `fmap` ident) in
+                let offset = [PlainInstr $ I32Const 0] in
+                let elements = funcIndexToExpr $4 in
+                MFElem $ ElemSegment Nothing FuncRef (Active tableIndex offset) elements
             ]
     }
     | '(' import_export_table { $2 }
@@ -916,15 +921,38 @@ export :: { Export }
 start :: { StartFunction }
     : 'start' index ')' { StartFunction $2 }
 
--- TODO: Spec from 09 Jan 2018 declares 'offset' keyword as mandatory,
--- but collection of testcases omits 'offset' in this position
--- I am going to support both options for now, but maybe it has to be updated in future.
 offsetexpr :: { [Instruction] }
     : 'offset' mixed_instruction_list(')') { snd $2 }
     | folded_instr1 { $1 }
 
-elemsegment :: { ElemSegment }
-    : 'elem' opt(index) '(' offsetexpr list(index) ')' { ElemSegment (fromMaybe (Index 0) $2) $4 $5 }
+elem :: { ElemSegment }
+    : 'elem' opt(ident) elem1 { $3{ ident = $2 } }
+
+elem1 :: { ElemSegment }
+    : elemlist ')' { let (t, els) = $1 in ElemSegment Nothing t Passive els }
+    | 'declare' elemlist ')' { let (t, els) = $2 in ElemSegment Nothing t Declarative els }
+    | '(' elem1_active { $2 }
+
+elem1_active :: { ElemSegment }
+    : 'table' index ')' '(' elem1_active_offset {
+        let (offset, t, els) = $5 in ElemSegment Nothing t (Active $2 offset) els
+    }
+    | elem1_active_offset {
+        let (offset, t, els) = $1 in ElemSegment Nothing t (Active (Index 0) offset) els
+    }
+
+elem1_active_offset :: { ([Instruction], ElemType, [[Instruction]]) }
+    : 'offset' mixed_instruction_list(')') elemlist { (snd $2, fst $3, snd $3) }
+    | folded_instr1 elemlist { ($1, fst $2, snd $2) }
+
+elemlist :: { (ElemType, [[Instruction]]) }
+    : 'func' list(index) { (FuncRef, funcIndexToExpr $2) }
+    | 'funcref' list(elemexpr) { (FuncRef, $2) }
+
+elemexpr :: { [Instruction] }
+    : plaininstr { [PlainInstr $1] }
+    | '(' 'item' mixed_instruction_list(')') { snd $3 }
+    | '(' folded_instr1 { $2 }
 
 datasegment :: { DataSegment }
     : 'data' opt(index) '(' offsetexpr datastring ')' { DataSegment (fromMaybe (Index 0) $2) $4 $5 }
@@ -934,7 +962,7 @@ modulefield1_single :: { ModuleField }
     | import { MFImport $1 }
     | export { MFExport $1 }
     | start { MFStart $1 }
-    | elemsegment { MFElem $1 }
+    | elem { MFElem $1 }
     | datasegment { MFData $1 }
     | function { $1 }
     | global { $1 }
@@ -1293,10 +1321,17 @@ data Export = Export {
 
 data StartFunction = StartFunction FuncIndex deriving (Show, Eq, Generic, NFData)
 
+data ElemMode
+    = Passive
+    | Active TableIndex [Instruction]
+    | Declarative
+    deriving (Show, Eq, Generic, NFData)
+
 data ElemSegment = ElemSegment {
-        tableIndex :: TableIndex,
-        offset :: [Instruction],
-        funcIndexes :: [FuncIndex]
+        ident :: Maybe Ident,
+        elemType :: ElemType,
+        mode :: ElemMode,
+        elements :: [[Instruction]]
     }
     deriving (Show, Eq, Generic, NFData)
 
@@ -1399,6 +1434,9 @@ constInstructionToValue (PlainInstr (F64Const v)) = S.F64Const v
 constInstructionToValue (PlainInstr (RefNull et)) = S.RefNull et
 constInstructionToValue _ = error "Only const instructions supported as arguments for actions"
 
+funcIndexToExpr :: [FuncIndex] -> [[Instruction]]
+funcIndexToExpr = map $ (:[]) . PlainInstr . RefFunc
+
 desugarize :: [ModuleField] -> Either String S.Module
 desugarize fields = do
     checkImportsOrder fields
@@ -1484,8 +1522,6 @@ desugarize fields = do
             extractTypeDefFromInstructions (matchTypeUse defs funcType) body
         extractTypeDef defs (MFGlobal Global { initializer }) =
             extractTypeDefFromInstructions defs initializer
-        extractTypeDef defs (MFElem ElemSegment { offset }) =
-            extractTypeDefFromInstructions defs offset
         extractTypeDef defs (MFData DataSegment { offset }) =
             extractTypeDefFromInstructions defs offset
         extractTypeDef defs _ = defs
@@ -1905,12 +1941,18 @@ desugarize fields = do
 
         -- elem segment
         synElemToStruct :: Module -> ElemSegment -> Either String S.ElemSegment
-        synElemToStruct mod ElemSegment { tableIndex, offset, funcIndexes } =
-            let ctx = FunCtx mod [] [] [] in
-            let offsetInstrs = mapM (synInstrToStruct ctx) offset in
-            let idx = fromJust $ getTableIndex mod tableIndex in
-            let indexes = map (fromJust . getFuncIndex mod) funcIndexes in
-            S.ElemSegment idx <$> offsetInstrs <*> return indexes
+        synElemToStruct mod ElemSegment { ident, elemType, mode, elements } = do
+            let ctx = FunCtx mod [] [] []
+            m <- case mode of {
+                Active tableIndex offset ->
+                    let offsetInstrs = mapM (synInstrToStruct ctx) offset in
+                    let idx = fromJust $ getTableIndex mod tableIndex in
+                    S.Active idx <$> offsetInstrs;
+                Passive -> return S.Passive;
+                Declarative -> return S.Declarative
+            }
+            let elemExprs = mapM (mapM (synInstrToStruct ctx)) elements
+            S.ElemSegment elemType m <$> elemExprs
 
         extractElemSegment :: [ElemSegment] -> ModuleField -> [ElemSegment]
         extractElemSegment elems (MFElem elem) = elem : elems
diff --git a/src/Language/Wasm/Structure.hs b/src/Language/Wasm/Structure.hs
index 0f8e4a4..042c71b 100644
--- a/src/Language/Wasm/Structure.hs
+++ b/src/Language/Wasm/Structure.hs
@@ -6,6 +6,7 @@ module Language.Wasm.Structure (
     Module(..),
     DataSegment(..),
     ElemSegment(..),
+    ElemMode(..),
     StartFunction(..),
     Export(..),
     ExportDesc(..),
@@ -228,10 +229,16 @@ data Global = Global {
     initializer :: Expression
 } deriving (Show, Eq, Generic, NFData)
 
+data ElemMode =
+    Passive
+    | Active TableIndex Expression
+    | Declarative
+    deriving (Show, Eq, Generic, NFData)
+
 data ElemSegment = ElemSegment {
-    tableIndex :: TableIndex,
-    offset :: Expression,
-    funcIndexes :: [FuncIndex]
+    elemType :: ElemType,
+    mode :: ElemMode,
+    elements :: [Expression]
 } deriving (Show, Eq, Generic, NFData)
 
 data DataSegment = DataSegment {
diff --git a/tests/Test.hs b/tests/Test.hs
index b541ffe..c4411b2 100644
--- a/tests/Test.hs
+++ b/tests/Test.hs
@@ -17,7 +17,8 @@ import qualified Data.List as List
 main :: IO ()
 main = do
   files <- filter (List.isSuffixOf ".wast") <$> Directory.listDirectory "tests/spec"
-  let files = ["ref_null.wast", "ref_is_null.wast"]
+  -- let files = ["ref_null.wast", "ref_is_null.wast"]
+  let files = ["elem.wast"]
   scriptTestCases <- (`mapM` files) $ \file -> do
     test <- LBS.readFile ("tests/spec/" ++ file)
     return $ testCase file $ do

From c08e81fa4035409292ecb1733a5c80f5985be684 Mon Sep 17 00:00:00 2001
From: Ilya Rezvov <rezvov.ilya@gmail.com>
Date: Tue, 1 Feb 2022 21:22:09 -0700
Subject: [PATCH 05/28] newtype for expressions to serialize in vectors

---
 src/Language/Wasm/Binary.hs | 13 ++++++++++---
 1 file changed, 10 insertions(+), 3 deletions(-)

diff --git a/src/Language/Wasm/Binary.hs b/src/Language/Wasm/Binary.hs
index 87f19ca..d711c02 100644
--- a/src/Language/Wasm/Binary.hs
+++ b/src/Language/Wasm/Binary.hs
@@ -326,6 +326,12 @@ instance Serialize Index where
     put (Index idx) = putULEB128 idx
     get = Index <$> getULEB128 32
 
+newtype Expr = Expr { unExpr :: Expression } deriving (Show, Eq)
+
+instance Serialize Expr where
+    put (Expr expr) = putExpression expr
+    get = Expr <$> getExpression
+
 instance Serialize MemArg where
     put MemArg { align, offset } = putULEB128 align >> putULEB128 offset
     get = do
@@ -802,17 +808,18 @@ instance Serialize ElemSegment where
     put (ElemSegment elemType Passive elements) = do
         putWord8 0x05
         put elemType
-        putVec $ map putExpression elements
+        putVec $ map Expr elements
     put (ElemSegment elemType (Active tableIndex offset) elements) = do
         putWord8 0x06
         putULEB128 tableIndex
         putExpression offset
         put elemType
-        putVec $ map putExpression elements
+        putVec $ map Expr elements
     put (ElemSegment elemType Declarative elements) = do
         putWord8 0x07
         put elemType
-        putVec $ map putExpression elements
+        putVec $ map Expr elements
+
     get = do
         op <- getWord8
         let funcIndexes = map ((:[]) . RefFunc . unIndex) <$> getVec

From 286ee40489d8cda6900110d9df56928ca82e3861 Mon Sep 17 00:00:00 2001
From: Ilya Rezvov <rezvov.ilya@gmail.com>
Date: Wed, 9 Feb 2022 21:49:03 -0700
Subject: [PATCH 06/28] fix validator for new elems

---
 src/Language/Wasm/Validate.hs | 30 +++++++++++++-----------------
 1 file changed, 13 insertions(+), 17 deletions(-)

diff --git a/src/Language/Wasm/Validate.hs b/src/Language/Wasm/Validate.hs
index 5979553..d7fa6c0 100644
--- a/src/Language/Wasm/Validate.hs
+++ b/src/Language/Wasm/Validate.hs
@@ -19,7 +19,7 @@ import Data.Maybe (fromMaybe, maybeToList, catMaybes)
 import Numeric.Natural (Natural)
 import Prelude hiding ((<>))
 
-import Control.Monad (foldM)
+import Control.Monad (foldM, forM_, when, unless)
 import Control.Monad.Reader (ReaderT, runReaderT, withReaderT, ask)
 import Control.Monad.Except (Except, runExcept, throwError)
 
@@ -569,24 +569,20 @@ elemsShouldBeValid m@Module { elems, functions, tables, imports } =
     foldMap (isElemValid ctx) elems
     where
         isElemValid :: Ctx -> ElemSegment -> ValidationResult
-        isElemValid ctx (ElemSegment tableIdx offset funs) =
-            let check = runChecker ctx $ do
+        isElemValid ctx (ElemSegment elemType mode elements) = do
+            forM_ elements $ \elem -> runChecker ctx $ do
+                getExpressionType elem
+                isConstExpression elem
+            case mode of
+                Active tableIdx offset -> runChecker ctx $ do
                     isConstExpression offset
                     t <- getExpressionType offset
-                    if isArrowMatch (empty ==> I32) t
-                    then return ()
-                    else throwError $ TypeMismatch t (empty ==> I32) 
-            in
-            let tableImports = filter isTableImport imports in
-            let isTableIndexValid =
-                    if tableIdx < (fromIntegral $ length tableImports + length tables)
-                    then return ()
-                    else Left (TableIndexOutOfRange tableIdx)
-            in
-            let funImports = filter isFuncImport imports in
-            let funsLength = fromIntegral $ length functions + length funImports in
-            let isFunsValid = foldMap (\i -> if i < funsLength then return () else Left FunctionIndexOutOfRange) funs in
-            check <> isFunsValid <> isTableIndexValid
+                    unless (isArrowMatch (empty ==> I32) t) $ do
+                        throwError $ TypeMismatch t (empty ==> I32)
+                    let tableImports = filter isTableImport imports
+                    when (tableIdx >= fromIntegral (length tableImports + length tables)) $ do
+                        throwError $ TableIndexOutOfRange tableIdx
+                _ -> return ()
 
 datasShouldBeValid :: Validator
 datasShouldBeValid m@Module { datas, mems, imports } =

From de40134caf10c99d2b50a485f66dae9a7e73cd81 Mon Sep 17 00:00:00 2001
From: Ilya Rezvov <rezvov.ilya@gmail.com>
Date: Tue, 15 Feb 2022 21:43:45 -0700
Subject: [PATCH 07/28] update initialization sequence for elems

---
 src/Language/Wasm/Interpreter.hs | 68 +++++++++++++++++++++++++-------
 1 file changed, 53 insertions(+), 15 deletions(-)

diff --git a/src/Language/Wasm/Interpreter.hs b/src/Language/Wasm/Interpreter.hs
index f3bdbdf..d7f4f7e 100644
--- a/src/Language/Wasm/Interpreter.hs
+++ b/src/Language/Wasm/Interpreter.hs
@@ -212,11 +212,17 @@ data FunctionInstance =
         hostCode :: HostFunction
     }
 
+data ElemInstance = ElemInstance ElemType (Vector Value) deriving (Eq, Show)
+
+data DataInstance = DataInstance
+
 data Store = Store {
     funcInstances :: Vector FunctionInstance,
     tableInstances :: Vector TableInstance,
     memInstances :: Vector MemoryInstance,
-    globalInstances :: Vector GlobalInstance
+    globalInstances :: Vector GlobalInstance,
+    elemInstances :: Vector ElemInstance,
+    dataInstances :: Vector DataInstance
 }
 
 emptyStore :: Store
@@ -304,6 +310,8 @@ data ModuleInstance = ModuleInstance {
     tableaddrs :: Vector Address,
     memaddrs :: Vector Address,
     globaladdrs :: Vector Address,
+    elemaddrs :: Vector Address,
+    dataaddrs :: Vector Address,
     exports :: Vector ExportInstance
 } deriving (Eq, Show)
 
@@ -314,15 +322,20 @@ emptyModInstance = ModuleInstance {
     tableaddrs = Vector.empty,
     memaddrs = Vector.empty,
     globaladdrs = Vector.empty,
+    elemaddrs = Vector.empty,
+    dataaddrs = Vector.empty,
     exports = Vector.empty
 }
 
 calcInstance :: Store -> Imports -> Module -> Initialize ModuleInstance
-calcInstance (Store fs ts ms gs) imps Module {functions, types, tables, mems, globals, exports, imports} = do
+calcInstance (Store fs ts ms gs es ds) imps mod = do
+    let Module {functions, types, tables, mems, globals, exports, imports, elems, datas} = mod
     let funLen = length fs
     let tableLen = length ts
     let memLen = length ms
     let globalLen = length gs
+    let elemLen = length es
+    let dataLen = length ds
     funImps <- mapM checkImportType $ filter isFuncImport imports
     tableImps <- mapM checkImportType $ filter isTableImport imports
     memImps <- mapM checkImportType $ filter isMemImport imports
@@ -346,6 +359,8 @@ calcInstance (Store fs ts ms gs) imps Module {functions, types, tables, mems, gl
         tableaddrs = tbls,
         memaddrs = memories,
         globaladdrs = globs,
+        elemaddrs = Vector.fromList [elemLen..elemLen + length elems - 1],
+        dataaddrs = Vector.fromList [dataLen..dataLen + length datas - 1],
         exports = Vector.fromList $ map refExport exports
     }
     where
@@ -361,7 +376,7 @@ calcInstance (Store fs ts ms gs) imps Module {functions, types, tables, mems, gl
             funcAddr <- case idx of
                 ExternFunction funcAddr -> return funcAddr
                 other -> throwError "incompatible import type"
-            let expectedType = types !! fromIntegral typeIdx
+            let expectedType = types mod !! fromIntegral typeIdx
             let actualType = Language.Wasm.Interpreter.funcType $ fs ! funcAddr
             if expectedType == actualType
             then return idx
@@ -447,7 +462,7 @@ allocAndInitGlobals inst store globs = Vector.fromList <$> mapM allocGlob globs
             GIMut vt <$> newIORef val
 
 allocTables :: [Table] -> Vector TableInstance
-allocTables tables = Vector.fromList $ map allocTable tables
+allocTables = Vector.fromList . map allocTable
     where
         allocTable :: Table -> TableInstance
         allocTable (Table (TableType lim@(Limit from to) _)) =
@@ -476,12 +491,22 @@ allocMems mems = Vector.fromList <$> mapM allocMem mems
                 memory
             }
 
+allocElems :: ModuleInstance -> Store -> [ElemSegment] -> IO (Vector ElemInstance)
+allocElems inst st = fmap Vector.fromList . mapM allocElem
+    where
+        allocElem :: ElemSegment -> IO ElemInstance
+        allocElem (ElemSegment t _mode refs) =
+            ElemInstance t . Vector.fromList <$> mapM (evalConstExpr inst st) refs
+
+allocDatas :: ModuleInstance -> Store -> [DataSegment] -> Vector DataInstance
+allocDatas _inst _st = Vector.fromList . map (const DataInstance)
+
 type Initialize = ExceptT String (State.StateT Store IO)
 
 initialize :: ModuleInstance -> Module -> Initialize ()
 initialize inst Module {elems, datas, start} = do
     checkedMems <- mapM checkData datas
-    checkedTables <- mapM checkElem elems
+    checkedTables <- mapM checkElem $ filter isActiveElem elems
     mapM_ initData checkedMems
     mapM_ initElem checkedTables
     st <- State.get
@@ -494,12 +519,21 @@ initialize inst Module {elems, datas, start} = do
                 _ -> throwError "Start function terminated with trap"
         Nothing -> return ()
     where
-        checkElem :: ElemSegment -> Initialize (Address, Int, [Address])
-        checkElem ElemSegment {tableIndex, offset, funcIndexes} = do
+        isActiveElem :: ElemSegment -> Bool
+        isActiveElem (ElemSegment FuncRef (Active _ _) _) = True
+        isActiveElem _ = False
+
+        checkElem :: ElemSegment -> Initialize (Address, Int, [Maybe Address])
+        checkElem ElemSegment {elemType, mode, elements} = do
+            (tableIndex, offset) <- case mode of {
+                Active idx off -> return (idx, off);
+                _ -> throwError "only active mode element can be initialized"
+            }
             st <- State.get
             VI32 val <- liftIO $ evalConstExpr inst st offset
             let from = fromIntegral val
-            let funcs = map ((funcaddrs inst !) . fromIntegral) funcIndexes
+            refs <- liftIO $ mapM (evalConstExpr inst st) elements
+            let funcs = map (\(RF ref) -> (funcaddrs inst !) . fromIntegral <$> ref) refs
             let idx = tableaddrs inst ! fromIntegral tableIndex
             let last = from + length funcs
             let TableInstance lim elems = tableInstances st ! idx
@@ -507,10 +541,10 @@ initialize inst Module {elems, datas, start} = do
             Monad.when (last > len) $ throwError "elements segment does not fit"
             return (idx, from, funcs)
 
-        initElem :: (Address, Int, [Address]) -> Initialize ()
+        initElem :: (Address, Int, [Maybe Address]) -> Initialize ()
         initElem (idx, from, funcs) = State.modify $ \st ->
             let TableInstance lim elems = tableInstances st ! idx in
-            let table = TableInstance lim (elems // zip [from..] (map Just funcs)) in
+            let table = TableInstance lim (elems // zip [from..] funcs) in
             st { tableInstances = tableInstances st Vector.// [(idx, table)] }
 
         checkData :: DataSegment -> Initialize (Int, MemoryStore, LBS.ByteString)
@@ -534,15 +568,19 @@ instantiate :: Store -> Imports -> Valid.ValidModule -> IO (Either String Module
 instantiate st imps mod = flip State.runStateT st $ runExceptT $ do
     let m = Valid.getModule mod
     inst <- calcInstance st imps m
-    let functions = funcInstances st <> (allocFunctions inst $ Struct.functions m)
-    globals <- liftIO $ (globalInstances st <>) <$> (allocAndInitGlobals inst st $ Struct.globals m)
-    let tables = tableInstances st <> (allocTables $ Struct.tables m)
-    mems <- liftIO $ (memInstances st <>) <$> (allocMems $ Struct.mems m)
+    let functions = funcInstances st <> allocFunctions inst (Struct.functions m)
+    globals <- liftIO $ (globalInstances st <>) <$> allocAndInitGlobals inst st (Struct.globals m)
+    let tables = tableInstances st <> allocTables (Struct.tables m)
+    mems <- liftIO $ (memInstances st <>) <$> allocMems (Struct.mems m)
+    elems <- liftIO $ (elemInstances st <>) <$> allocElems inst st (Struct.elems m)
+    let datas = dataInstances st <> allocDatas inst st (Struct.datas m)
     State.put $ st {
         funcInstances = functions,
         tableInstances = tables,
         memInstances = mems,
-        globalInstances = globals
+        globalInstances = globals,
+        elemInstances = elems,
+        dataInstances = datas
     }
     initialize inst m
     return inst

From 4753ebceb4ab24c77a50791e14baa524454e9c72 Mon Sep 17 00:00:00 2001
From: Ilya Rezvov <rezvov.ilya@gmail.com>
Date: Mon, 30 May 2022 18:57:21 -0600
Subject: [PATCH 08/28] syntax support for table.init

---
 src/Language/Wasm/Parser.y     | 50 ++++++++++++++++++++++++++++++++--
 src/Language/Wasm/Structure.hs |  9 ++++++
 2 files changed, 56 insertions(+), 3 deletions(-)

diff --git a/src/Language/Wasm/Parser.y b/src/Language/Wasm/Parser.y
index 6308e60..e9aad36 100644
--- a/src/Language/Wasm/Parser.y
+++ b/src/Language/Wasm/Parser.y
@@ -165,6 +165,13 @@ import Language.Wasm.Lexer (
 'i64.store32'         { Lexeme _ (TKeyword "i64.store32") }
 'memory.size'         { Lexeme _ (TKeyword "memory.size") }
 'memory.grow'         { Lexeme _ (TKeyword "memory.grow") }
+'table.init'          { Lexeme _ (TKeyword "table.init") }
+'table.copy'          { Lexeme _ (TKeyword "table.copy") }
+'table.fill'          { Lexeme _ (TKeyword "table.fill") }
+'table.size'          { Lexeme _ (TKeyword "table.size") }
+'table.grow'          { Lexeme _ (TKeyword "table.grow") }
+'table.get'           { Lexeme _ (TKeyword "table.get") }
+'table.set'           { Lexeme _ (TKeyword "table.set") }
 'i32.const'           { Lexeme _ (TKeyword "i32.const") }
 'i64.const'           { Lexeme _ (TKeyword "i64.const") }
 'f32.const'           { Lexeme _ (TKeyword "f32.const") }
@@ -463,6 +470,12 @@ plaininstr :: { PlainInstr }
     | 'i64.store32' memarg4          { I64Store32 $2 }
     | 'memory.size'                  { CurrentMemory }
     | 'memory.grow'                  { GrowMemory }
+    -- table instructions
+    | 'table.init' index opt(index)  {
+        case $3 of
+            Nothing -> TableInit (Index 0) $2
+            Just elemIdx -> TableInit $2 elemIdx
+    }
     -- numeric instructions
     | 'i32.const' int32              { I32Const $2 }
     | 'i64.const' int64              { I64Const $2 }
@@ -883,18 +896,23 @@ table :: { [ModuleField] }
 
 limits_elemtype_elem :: { Maybe Ident -> [ModuleField] }
     : tabletype ')' { \ident -> [MFTable $ Table [] ident $1] }
-    | elemtype '(' 'elem' list(index) ')' ')' {
+    | elemtype '(' 'elem' indexes_or_ref_exprs ')' ')' {
         \ident ->
             let funcsLen = fromIntegral $ length $4 in [
                 MFTable $ Table [] ident $ TableType (Limit funcsLen (Just funcsLen)) $1,
                 let tableIndex = (fromMaybe (Index 0) $ Named `fmap` ident) in
                 let offset = [PlainInstr $ I32Const 0] in
-                let elements = funcIndexToExpr $4 in
+                let elements = $4 in
                 MFElem $ ElemSegment Nothing FuncRef (Active tableIndex offset) elements
             ]
     }
     | '(' import_export_table { $2 }
 
+indexes_or_ref_exprs :: {[[Instruction]]}
+    : index list(index) { funcIndexToExpr ($1:$2) }
+    | elemexpr list(elemexpr) { $1 : $2 }
+    | {- empty -} { [] }
+
 import_export_table :: { Maybe Ident -> [ModuleField] }
     : 'import' name name ')' tabletype ')' {
         \ident -> [MFImport $ Import [] $2 $3 $ ImportTable ident $5]
@@ -931,7 +949,7 @@ elem :: { ElemSegment }
 elem1 :: { ElemSegment }
     : elemlist ')' { let (t, els) = $1 in ElemSegment Nothing t Passive els }
     | 'declare' elemlist ')' { let (t, els) = $2 in ElemSegment Nothing t Declarative els }
-    | '(' elem1_active { $2 }
+    | '(' elem1_active ')' { $2 }
 
 elem1_active :: { ElemSegment }
     : 'table' index ')' '(' elem1_active_offset {
@@ -948,6 +966,7 @@ elem1_active_offset :: { ([Instruction], ElemType, [[Instruction]]) }
 elemlist :: { (ElemType, [[Instruction]]) }
     : 'func' list(index) { (FuncRef, funcIndexToExpr $2) }
     | 'funcref' list(elemexpr) { (FuncRef, $2) }
+    | list(index) { (FuncRef, funcIndexToExpr $1) }
 
 elemexpr :: { [Instruction] }
     : plaininstr { [PlainInstr $1] }
@@ -1149,6 +1168,7 @@ type LocalIndex = Index
 type GlobalIndex = Index
 type TableIndex = Index
 type MemoryIndex = Index
+type ElemIndex = Index
 
 data PlainInstr =
     -- Control instructions
@@ -1199,6 +1219,14 @@ data PlainInstr =
     | I64Store32 MemArg
     | CurrentMemory
     | GrowMemory
+    -- Table instructions
+    | TableInit TableIndex ElemIndex
+    | TableGrow TableIndex
+    | TableSize TableIndex
+    | TableFill TableIndex
+    | TableGet TableIndex
+    | TableSet TableIndex
+    | TableCopy TableIndex TableIndex
     -- Numeric instructions
     | I32Const Integer
     | I64Const Integer
@@ -1670,6 +1698,13 @@ desugarize fields = do
         synInstrToStruct _ (PlainInstr (I64Store32 memArg)) = return $ S.I64Store32 memArg
         synInstrToStruct _ (PlainInstr CurrentMemory) = return $ S.CurrentMemory
         synInstrToStruct _ (PlainInstr GrowMemory) = return $ S.GrowMemory
+        synInstrToStruct FunCtx { ctxMod } (PlainInstr (TableInit tableIdx elemIdx)) =
+            case getTableIndex ctxMod tableIdx of
+                Just tableIdx ->
+                    case getElemIndex ctxMod elemIdx of
+                        Just elemIdx -> return $ S.TableInit tableIdx elemIdx
+                        Nothing -> Left "unknown elem"
+                Nothing -> Left "unknown table"
         synInstrToStruct _ (PlainInstr (I32Const val)) = return $ S.I32Const $ integerToWord32 val
         synInstrToStruct _ (PlainInstr (I64Const val)) = return $ S.I64Const $ integerToWord64 val
         synInstrToStruct _ (PlainInstr (F32Const val)) = return $ S.F32Const val
@@ -1958,6 +1993,15 @@ desugarize fields = do
         extractElemSegment elems (MFElem elem) = elem : elems
         extractElemSegment elems _ = elems
 
+        getElemIndex :: Module -> GlobalIndex -> Maybe Natural
+        getElemIndex mod@Module { elems } (Named id) =
+            let isIdent (_, ElemSegment { ident }) = ident == Just id in
+            let elemIndexes = map fst $ filter isIdent $ zip [0..] elems in
+            case elemIndexes of
+                [idx] -> return idx
+                _ -> Nothing
+        getElemIndex _ (Index idx) = Just idx
+
         -- data segment
         synDataToStruct :: Module -> DataSegment -> Either String S.DataSegment
         synDataToStruct mod DataSegment { memIndex, offset, datastring } =
diff --git a/src/Language/Wasm/Structure.hs b/src/Language/Wasm/Structure.hs
index 042c71b..4a7e7d9 100644
--- a/src/Language/Wasm/Structure.hs
+++ b/src/Language/Wasm/Structure.hs
@@ -103,6 +103,7 @@ type LocalIndex = Natural
 type GlobalIndex = Natural
 type MemoryIndex = Natural
 type TableIndex = Natural
+type ElemIndex = Natural
 
 data ValueType =
     I32
@@ -176,6 +177,14 @@ data Instruction index =
     | I64Store32 MemArg
     | CurrentMemory
     | GrowMemory
+    -- Table instructions
+    | TableInit TableIndex ElemIndex
+    | TableGrow TableIndex
+    | TableSize TableIndex
+    | TableFill TableIndex
+    | TableGet TableIndex
+    | TableSet TableIndex
+    | TableCopy TableIndex TableIndex
     -- Numeric instructions
     | I32Const Word32
     | I64Const Word64

From 5bcd863671b8a5f6590d69bf50e324be66e3d5cf Mon Sep 17 00:00:00 2001
From: Ilya Rezvov <rezvov.ilya@gmail.com>
Date: Mon, 30 May 2022 21:43:44 -0600
Subject: [PATCH 09/28] validate table.init and use mutable vector as a table
 storage

---
 src/Language/Wasm/Interpreter.hs | 80 ++++++++++++++++++--------------
 src/Language/Wasm/Script.hs      |  3 +-
 src/Language/Wasm/Validate.hs    | 16 ++++++-
 3 files changed, 62 insertions(+), 37 deletions(-)

diff --git a/src/Language/Wasm/Interpreter.hs b/src/Language/Wasm/Interpreter.hs
index d7f4f7e..35989ee 100644
--- a/src/Language/Wasm/Interpreter.hs
+++ b/src/Language/Wasm/Interpreter.hs
@@ -30,6 +30,8 @@ import Data.Maybe (fromMaybe, isNothing)
 
 import Data.Vector (Vector, (!), (!?), (//))
 import qualified Data.Vector as Vector
+import Data.Vector.Mutable (IOVector)
+import qualified Data.Vector.Mutable as MVector
 import qualified Data.Primitive.ByteArray as ByteArray
 import qualified Data.Primitive.Types as Primitive
 import qualified Control.Monad.Primitive as Primitive
@@ -164,9 +166,11 @@ data Label = Label ResultType deriving (Show, Eq)
 
 type Address = Int
 
+type TableStore = IOVector (Maybe Address)
+
 data TableInstance = TableInstance {
     lim :: Limit,
-    elements :: Vector (Maybe Address)
+    items :: TableStore
 }
 
 type MemoryStore = ByteArray.MutableByteArray (Primitive.PrimState IO)
@@ -294,8 +298,8 @@ makeHostModule st items = do
         makeHostTables :: (Store, ModuleInstance) -> IO (Store, ModuleInstance)
         makeHostTables (st, inst) = do
             let tableLen = Vector.length $ tableInstances st
-            let (names, tables) = unzip [(name, Table (TableType lim FuncRef)) | (name, (HostTable lim)) <- items]
-            let instances = allocTables tables
+            let (names, tables) = unzip [(name, Table (TableType lim FuncRef)) | (name, HostTable lim) <- items]
+            instances <- allocTables tables
             let exps = Vector.fromList $ zipWith (\name i -> ExportInstance name (ExternTable i)) names [tableLen..]
             let inst' = inst {
                     tableaddrs = Vector.fromList [tableLen..tableLen + length instances - 1],
@@ -461,15 +465,13 @@ allocAndInitGlobals inst store globs = Vector.fromList <$> mapM allocGlob globs
             val <- runIniter initer
             GIMut vt <$> newIORef val
 
-allocTables :: [Table] -> Vector TableInstance
-allocTables = Vector.fromList . map allocTable
+allocTables :: [Table] -> IO (Vector TableInstance)
+allocTables = fmap Vector.fromList . mapM allocTable
     where
-        allocTable :: Table -> TableInstance
+        allocTable :: Table -> IO TableInstance
         allocTable (Table (TableType lim@(Limit from to) _)) =
-            TableInstance {
-                lim,
-                elements = Vector.fromList $ replicate (fromIntegral from) Nothing
-            }
+            let elements = MVector.replicate (fromIntegral from) Nothing in
+            TableInstance lim <$> elements
 
 defaultBudget :: Natural
 defaultBudget = 300
@@ -537,15 +539,15 @@ initialize inst Module {elems, datas, start} = do
             let idx = tableaddrs inst ! fromIntegral tableIndex
             let last = from + length funcs
             let TableInstance lim elems = tableInstances st ! idx
-            let len = Vector.length elems
-            Monad.when (last > len) $ throwError "elements segment does not fit"
+            let len = MVector.length elems
+            Monad.when (last > len) $ throwError "out of bounds table access"
             return (idx, from, funcs)
 
         initElem :: (Address, Int, [Maybe Address]) -> Initialize ()
-        initElem (idx, from, funcs) = State.modify $ \st ->
-            let TableInstance lim elems = tableInstances st ! idx in
-            let table = TableInstance lim (elems // zip [from..] funcs) in
-            st { tableInstances = tableInstances st Vector.// [(idx, table)] }
+        initElem (idx, from, funcs) = do
+            Store {tableInstances} <- State.get
+            let elems = items $ tableInstances ! idx
+            Monad.forM_ (zip [from..] funcs) $ uncurry $ MVector.unsafeWrite elems
 
         checkData :: DataSegment -> Initialize (Int, MemoryStore, LBS.ByteString)
         checkData DataSegment {memIndex, offset, chunk} = do
@@ -570,7 +572,7 @@ instantiate st imps mod = flip State.runStateT st $ runExceptT $ do
     inst <- calcInstance st imps m
     let functions = funcInstances st <> allocFunctions inst (Struct.functions m)
     globals <- liftIO $ (globalInstances st <>) <$> allocAndInitGlobals inst st (Struct.globals m)
-    let tables = tableInstances st <> allocTables (Struct.tables m)
+    tables <- (tableInstances st <>) <$> liftIO (allocTables (Struct.tables m))
     mems <- liftIO $ (memInstances st <>) <$> allocMems (Struct.mems m)
     elems <- liftIO $ (elemInstances st <>) <$> allocElems inst st (Struct.elems m)
     let datas = dataInstances st <> allocDatas inst st (Struct.datas m)
@@ -746,23 +748,28 @@ eval budget store FunctionInstance { funcType, moduleInstance, code = Function {
                 Nothing -> return Trap
         step ctx@EvalCtx{ stack = (VI32 v): rest } (CallIndirect typeIdx) = do
             let funcType = funcTypes moduleInstance ! fromIntegral typeIdx
-            let TableInstance { elements } = tableInstances store ! (tableaddrs moduleInstance ! 0)
-            let checks = do
-                    addr <- Monad.join $ elements !? fromIntegral v
-                    let funcInst = funcInstances store ! addr
-                    let targetType = Language.Wasm.Interpreter.funcType funcInst
-                    Monad.guard $ targetType == funcType
-                    let args = params targetType
-                    Monad.guard $ length args <= length rest
-                    params <- sequence $ zipWith checkValType args $ reverse $ take (length args) rest
-                    return (funcInst, params)
-            case checks of
-                Just (funcInst, params) -> do
-                    res <- eval (budget - 1) store funcInst params
-                    case res of
-                        Just res -> return $ Done ctx { stack = reverse res ++ (drop (length params) rest) }
-                        Nothing -> return Trap
-                Nothing -> return Trap
+            let TableInstance { items } = tableInstances store ! (tableaddrs moduleInstance ! 0)
+            let pos = fromIntegral v
+            if pos >= MVector.length items
+            then return Trap
+            else do
+                maybeAddr <- liftIO $ MVector.read items pos
+                let checks = do
+                        addr <- maybeAddr
+                        let funcInst = funcInstances store ! addr
+                        let targetType = Language.Wasm.Interpreter.funcType funcInst
+                        Monad.guard $ targetType == funcType
+                        let args = params targetType
+                        Monad.guard $ length args <= length rest
+                        params <- sequence $ zipWith checkValType args $ reverse $ take (length args) rest
+                        return (funcInst, params)
+                case checks of
+                    Just (funcInst, params) -> do
+                        res <- eval (budget - 1) store funcInst params
+                        case res of
+                            Just res -> return $ Done ctx { stack = reverse res ++ (drop (length params) rest) }
+                            Nothing -> return Trap
+                    Nothing -> return Trap
         step ctx@EvalCtx{ stack = st } (RefNull FuncRef) =
             return $ Done ctx { stack = RF Nothing : st }
         step ctx@EvalCtx{ stack = st } (RefNull ExternRef) =
@@ -876,6 +883,11 @@ eval budget store FunctionInstance { funcType, moduleInstance, code = Function {
                     else return $ -1
                 )
             return $ Done ctx { stack = VI32 (asWord32 $ fromIntegral result) : rest }
+        -- step ctx@EvalCtx{ stack = (VI32 n:rest) } (TableInit tableIdx elemIdx) = do
+        --     let tableAddr = tableaddrs moduleInstance ! fromIntegral tableIdx
+        --     let TableInstance { items } = tableInstances store ! tableAddr
+
+        --     return $ Done ctx { stack = rest }
         step ctx (I32Const v) = return $ Done ctx { stack = VI32 v : stack ctx }
         step ctx (I64Const v) = return $ Done ctx { stack = VI64 v : stack ctx }
         step ctx (F32Const v) = return $ Done ctx { stack = VF32 v : stack ctx }
diff --git a/src/Language/Wasm/Script.hs b/src/Language/Wasm/Script.hs
index 8cd175c..fcc4b99 100644
--- a/src/Language/Wasm/Script.hs
+++ b/src/Language/Wasm/Script.hs
@@ -260,9 +260,10 @@ runScript onAssertFail script = do
                     st <- fst <$> State.get
                     (res, store') <- liftIO $ Interpreter.instantiate (store st) (buildImports st) m
                     case res of
+                        Left failureString -> return ()
                         Left "Start function terminated with trap" ->
                             State.modify $ \(st, pos) -> (st { store = store' }, pos)
-                        _ -> printFailedAssert ("Module linking should fail with trap during execution of a start function") assert
+                        r -> printFailedAssert "Module linking should fail with trap during execution of a start function" assert
                 Left reason -> error $ "Module linking failed due to invalid module with reason: " ++ show reason
         runAssert assert@(AssertExhaustion action failureString) = do
             result <- runActionInAssert action
diff --git a/src/Language/Wasm/Validate.hs b/src/Language/Wasm/Validate.hs
index d7fa6c0..cfbadd7 100644
--- a/src/Language/Wasm/Validate.hs
+++ b/src/Language/Wasm/Validate.hs
@@ -38,10 +38,12 @@ data ValidationError =
     | MemoryIndexOutOfRange Natural
     | LocalIndexOutOfRange Natural
     | GlobalIndexOutOfRange Natural
+    | ElemIndexOutOfRange Natural
     | LabelIndexOutOfRange
     | TypeIndexOutOfRange
     | ResultTypeDoesntMatch
     | TypeMismatch { actual :: Arrow, expected :: Arrow }
+    | RefTypeMismatch ElemType ElemType
     | InvalidResultArity
     | InvalidConstantExpr
     | InvalidStartFunctionType
@@ -127,6 +129,7 @@ data Ctx = Ctx {
     types :: [FuncType],
     funcs :: [FuncType],
     tables :: [TableType],
+    elems :: [ElemType],
     mems :: [Limit],
     globals :: [GlobalType],
     locals :: [ValueType],
@@ -362,8 +365,16 @@ getInstrType CurrentMemory = do
     Ctx { mems } <- ask 
     if length mems < 1 then throwError (MemoryIndexOutOfRange 0) else return $ empty ==> I32
 getInstrType GrowMemory = do
-    Ctx { mems } <- ask 
+    Ctx { mems } <- ask
     if length mems < 1 then throwError (MemoryIndexOutOfRange 0) else return $ I32 ==> I32
+getInstrType (TableInit tableIdx elemIdx) = do
+    Ctx { tables, elems } <- ask
+    when (length tables <= fromIntegral tableIdx) $ throwError (TableIndexOutOfRange tableIdx)
+    when (length elems <= fromIntegral elemIdx) $ throwError (ElemIndexOutOfRange elemIdx)
+    let TableType _ tableType = tables !! fromIntegral tableIdx
+    let elemType = elems !! fromIntegral elemIdx
+    when (elemType /= tableType) $ throwError (RefTypeMismatch tableType elemType)
+    return $ [I32, I32, I32] ==> empty
 getInstrType (I32Const _) = return $ empty ==> I32
 getInstrType (I64Const _) = return $ empty ==> I64
 getInstrType (F32Const _) = return $ empty ==> F32
@@ -476,7 +487,7 @@ getFuncTypes Module {types, functions, imports} =
         getFuncType _ = Nothing
 
 ctxFromModule :: [ValueType] -> [[ValueType]] -> [ValueType] -> Module -> Ctx
-ctxFromModule locals labels returns m@Module {types, tables, mems, globals, imports} =
+ctxFromModule locals labels returns m@Module {types, tables, mems, globals, imports, elems} =
     let tableImports = catMaybes $ map getTableType imports in
     let memsImports = catMaybes $ map getMemType imports in
     let globalImports = catMaybes $ map getGlobalType imports in
@@ -484,6 +495,7 @@ ctxFromModule locals labels returns m@Module {types, tables, mems, globals, impo
         types,
         funcs = getFuncTypes m,
         tables = tableImports ++ map (\(Table t) -> t) tables,
+        elems = map elemType elems,
         mems = memsImports ++ map (\(Memory l) -> l) mems,
         globals = globalImports ++ map (\(Global g _) -> g) globals,
         locals,

From 95fdcc2f80d4cd635bf8f3fe52f7ced60945c1ef Mon Sep 17 00:00:00 2001
From: Ilya Rezvov <rezvov.ilya@gmail.com>
Date: Tue, 31 May 2022 19:39:06 -0600
Subject: [PATCH 10/28] drop flag for elems was added. initial table.init
 implementation

---
 src/Language/Wasm/Interpreter.hs | 52 +++++++++++++++++++++-----------
 src/Language/Wasm/Script.hs      |  2 +-
 2 files changed, 35 insertions(+), 19 deletions(-)

diff --git a/src/Language/Wasm/Interpreter.hs b/src/Language/Wasm/Interpreter.hs
index 35989ee..ca00661 100644
--- a/src/Language/Wasm/Interpreter.hs
+++ b/src/Language/Wasm/Interpreter.hs
@@ -216,7 +216,7 @@ data FunctionInstance =
         hostCode :: HostFunction
     }
 
-data ElemInstance = ElemInstance ElemType (Vector Value) deriving (Eq, Show)
+data ElemInstance = ElemInstance ElemType (Vector Value) (IORef Bool)
 
 data DataInstance = DataInstance
 
@@ -234,7 +234,9 @@ emptyStore = Store {
     funcInstances = Vector.empty,
     tableInstances = Vector.empty,
     memInstances = Vector.empty,
-    globalInstances = Vector.empty
+    globalInstances = Vector.empty,
+    elemInstances = Vector.empty,
+    dataInstances = Vector.empty
 }
 
 type HostFunction = [Value] -> IO [Value]
@@ -498,7 +500,9 @@ allocElems inst st = fmap Vector.fromList . mapM allocElem
     where
         allocElem :: ElemSegment -> IO ElemInstance
         allocElem (ElemSegment t _mode refs) =
-            ElemInstance t . Vector.fromList <$> mapM (evalConstExpr inst st) refs
+            ElemInstance t
+                <$> (Vector.fromList <$> mapM (evalConstExpr inst st) refs)
+                <*> newIORef False -- is dropped
 
 allocDatas :: ModuleInstance -> Store -> [DataSegment] -> Vector DataInstance
 allocDatas _inst _st = Vector.fromList . map (const DataInstance)
@@ -508,7 +512,7 @@ type Initialize = ExceptT String (State.StateT Store IO)
 initialize :: ModuleInstance -> Module -> Initialize ()
 initialize inst Module {elems, datas, start} = do
     checkedMems <- mapM checkData datas
-    checkedTables <- mapM checkElem $ filter isActiveElem elems
+    checkedTables <- mapM checkElem $ filter isActiveElem $ zip [0..] elems
     mapM_ initData checkedMems
     mapM_ initElem checkedTables
     st <- State.get
@@ -521,12 +525,12 @@ initialize inst Module {elems, datas, start} = do
                 _ -> throwError "Start function terminated with trap"
         Nothing -> return ()
     where
-        isActiveElem :: ElemSegment -> Bool
-        isActiveElem (ElemSegment FuncRef (Active _ _) _) = True
+        isActiveElem :: (Int, ElemSegment) -> Bool
+        isActiveElem (_, ElemSegment FuncRef (Active _ _) _) = True
         isActiveElem _ = False
 
-        checkElem :: ElemSegment -> Initialize (Address, Int, [Maybe Address])
-        checkElem ElemSegment {elemType, mode, elements} = do
+        checkElem :: (Int, ElemSegment) -> Initialize (Address, Address, Int, [Maybe Address])
+        checkElem (elemN, ElemSegment {elemType, mode, elements}) = do
             (tableIndex, offset) <- case mode of {
                 Active idx off -> return (idx, off);
                 _ -> throwError "only active mode element can be initialized"
@@ -541,12 +545,14 @@ initialize inst Module {elems, datas, start} = do
             let TableInstance lim elems = tableInstances st ! idx
             let len = MVector.length elems
             Monad.when (last > len) $ throwError "out of bounds table access"
-            return (idx, from, funcs)
+            return (idx, elemaddrs inst ! elemN, from, funcs)
 
-        initElem :: (Address, Int, [Maybe Address]) -> Initialize ()
-        initElem (idx, from, funcs) = do
-            Store {tableInstances} <- State.get
-            let elems = items $ tableInstances ! idx
+        initElem :: (Address, Address, Int, [Maybe Address]) -> Initialize ()
+        initElem (tableIdx, elemIdx, from, funcs) = do
+            Store {tableInstances, elemInstances} <- State.get
+            let elems = items $ tableInstances ! tableIdx
+            let ElemInstance _ _ isDropped = elemInstances ! elemIdx
+            liftIO $ writeIORef isDropped True
             Monad.forM_ (zip [from..] funcs) $ uncurry $ MVector.unsafeWrite elems
 
         checkData :: DataSegment -> Initialize (Int, MemoryStore, LBS.ByteString)
@@ -883,11 +889,21 @@ eval budget store FunctionInstance { funcType, moduleInstance, code = Function {
                     else return $ -1
                 )
             return $ Done ctx { stack = VI32 (asWord32 $ fromIntegral result) : rest }
-        -- step ctx@EvalCtx{ stack = (VI32 n:rest) } (TableInit tableIdx elemIdx) = do
-        --     let tableAddr = tableaddrs moduleInstance ! fromIntegral tableIdx
-        --     let TableInstance { items } = tableInstances store ! tableAddr
-
-        --     return $ Done ctx { stack = rest }
+        step ctx@EvalCtx{ stack = (VI32 n:VI32 s:VI32 d:rest) } (TableInit tableIdx elemIdx) = do
+            let tableAddr = tableaddrs moduleInstance ! fromIntegral tableIdx
+            let TableInstance { items } = tableInstances store ! tableAddr
+            let elemAddr = elemaddrs moduleInstance ! fromIntegral elemIdx
+            let ElemInstance _ refs dropFlag = elemInstances store ! elemAddr
+            let src = fromIntegral s
+            let dst = fromIntegral d
+            let len = fromIntegral n
+            isDropped <- readIORef dropFlag
+            if src + len > Vector.length refs || dst + len > MVector.length items || isDropped
+            then return Trap
+            else do
+                Vector.iforM_ (Vector.slice src len refs) $ \idx (RF fn) ->
+                    MVector.unsafeWrite items (dst + idx) (fromIntegral <$> fn)
+                return $ Done ctx { stack = rest }
         step ctx (I32Const v) = return $ Done ctx { stack = VI32 v : stack ctx }
         step ctx (I64Const v) = return $ Done ctx { stack = VI64 v : stack ctx }
         step ctx (F32Const v) = return $ Done ctx { stack = VF32 v : stack ctx }
diff --git a/src/Language/Wasm/Script.hs b/src/Language/Wasm/Script.hs
index fcc4b99..ddb659c 100644
--- a/src/Language/Wasm/Script.hs
+++ b/src/Language/Wasm/Script.hs
@@ -260,7 +260,7 @@ runScript onAssertFail script = do
                     st <- fst <$> State.get
                     (res, store') <- liftIO $ Interpreter.instantiate (store st) (buildImports st) m
                     case res of
-                        Left failureString -> return ()
+                        Left err | err == TL.unpack failureString -> return ()
                         Left "Start function terminated with trap" ->
                             State.modify $ \(st, pos) -> (st { store = store' }, pos)
                         r -> printFailedAssert "Module linking should fail with trap during execution of a start function" assert

From e388e21370ac69a230c0e15042977eb61b4a6b14 Mon Sep 17 00:00:00 2001
From: Ilya Rezvov <rezvov.ilya@gmail.com>
Date: Thu, 2 Jun 2022 20:54:15 -0600
Subject: [PATCH 11/28] pass tests in elem.wat test suit

---
 src/Language/Wasm/Interpreter.hs | 28 ++++++++++++++++++++++------
 src/Language/Wasm/Script.hs      |  1 +
 src/Language/Wasm/Validate.hs    | 13 ++++++++++---
 3 files changed, 33 insertions(+), 9 deletions(-)

diff --git a/src/Language/Wasm/Interpreter.hs b/src/Language/Wasm/Interpreter.hs
index ca00661..6b023e9 100644
--- a/src/Language/Wasm/Interpreter.hs
+++ b/src/Language/Wasm/Interpreter.hs
@@ -216,7 +216,16 @@ data FunctionInstance =
         hostCode :: HostFunction
     }
 
-data ElemInstance = ElemInstance ElemType (Vector Value) (IORef Bool)
+data ElemInstance = ElemInstance {
+        eiMode :: ElemMode,
+        eiType :: ElemType,
+        eiItems :: Vector Value,
+        isDropped :: IORef Bool
+    }
+
+isDeclarative :: ElemMode -> Bool 
+isDeclarative Declarative = True
+isDeclarative _           = False
 
 data DataInstance = DataInstance
 
@@ -499,8 +508,8 @@ allocElems :: ModuleInstance -> Store -> [ElemSegment] -> IO (Vector ElemInstanc
 allocElems inst st = fmap Vector.fromList . mapM allocElem
     where
         allocElem :: ElemSegment -> IO ElemInstance
-        allocElem (ElemSegment t _mode refs) =
-            ElemInstance t
+        allocElem (ElemSegment t mode refs) =
+            ElemInstance mode t
                 <$> (Vector.fromList <$> mapM (evalConstExpr inst st) refs)
                 <*> newIORef False -- is dropped
 
@@ -551,7 +560,7 @@ initialize inst Module {elems, datas, start} = do
         initElem (tableIdx, elemIdx, from, funcs) = do
             Store {tableInstances, elemInstances} <- State.get
             let elems = items $ tableInstances ! tableIdx
-            let ElemInstance _ _ isDropped = elemInstances ! elemIdx
+            let ElemInstance {isDropped} = elemInstances ! elemIdx
             liftIO $ writeIORef isDropped True
             Monad.forM_ (zip [from..] funcs) $ uncurry $ MVector.unsafeWrite elems
 
@@ -893,12 +902,19 @@ eval budget store FunctionInstance { funcType, moduleInstance, code = Function {
             let tableAddr = tableaddrs moduleInstance ! fromIntegral tableIdx
             let TableInstance { items } = tableInstances store ! tableAddr
             let elemAddr = elemaddrs moduleInstance ! fromIntegral elemIdx
-            let ElemInstance _ refs dropFlag = elemInstances store ! elemAddr
+            let ElemInstance {
+                    eiItems = refs,
+                    eiMode = mode,
+                    isDropped = dropFlag
+                } = elemInstances store ! elemAddr
             let src = fromIntegral s
             let dst = fromIntegral d
             let len = fromIntegral n
             isDropped <- readIORef dropFlag
-            if src + len > Vector.length refs || dst + len > MVector.length items || isDropped
+            if src + len > Vector.length refs
+                || dst + len > MVector.length items
+                || isDropped
+                || isDeclarative mode
             then return Trap
             else do
                 Vector.iforM_ (Vector.slice src len refs) $ \idx (RF fn) ->
diff --git a/src/Language/Wasm/Script.hs b/src/Language/Wasm/Script.hs
index ddb659c..a4ce926 100644
--- a/src/Language/Wasm/Script.hs
+++ b/src/Language/Wasm/Script.hs
@@ -173,6 +173,7 @@ runScript onAssertFail script = do
 
         getFailureString :: Validate.ValidationError -> [TL.Text]
         getFailureString (Validate.TypeMismatch _ _) = ["type mismatch"]
+        getFailureString (Validate.RefTypeMismatch _ _) = ["type mismatch"]
         getFailureString Validate.ResultTypeDoesntMatch = ["type mismatch"]
         getFailureString Validate.MoreThanOneMemory = ["multiple memories"]
         getFailureString Validate.MoreThanOneTable = ["multiple tables"]
diff --git a/src/Language/Wasm/Validate.hs b/src/Language/Wasm/Validate.hs
index cfbadd7..6ef2824 100644
--- a/src/Language/Wasm/Validate.hs
+++ b/src/Language/Wasm/Validate.hs
@@ -15,7 +15,7 @@ import Language.Wasm.Structure
 import qualified Data.Set as Set
 import Data.List (foldl')
 import qualified Data.Text.Lazy as TL
-import Data.Maybe (fromMaybe, maybeToList, catMaybes)
+import Data.Maybe (fromMaybe, catMaybes)
 import Numeric.Natural (Natural)
 import Prelude hiding ((<>))
 
@@ -269,7 +269,7 @@ getInstrType RefIsNull = do
 getInstrType (RefFunc funIdx) = do
     Ctx { funcs } <- ask
     if fromIntegral funIdx < length funcs
-    then return $ empty ==> Val I32
+    then return $ empty ==> Val Func
     else throwError FunctionIndexOutOfRange
 getInstrType (GetLocal local) = do
     Ctx { locals }  <- ask
@@ -583,8 +583,10 @@ elemsShouldBeValid m@Module { elems, functions, tables, imports } =
         isElemValid :: Ctx -> ElemSegment -> ValidationResult
         isElemValid ctx (ElemSegment elemType mode elements) = do
             forM_ elements $ \elem -> runChecker ctx $ do
-                getExpressionType elem
+                arr <- getExpressionType elem
                 isConstExpression elem
+                unless (isValidRef elemType arr)
+                    $ throwError $ RefTypeMismatch elemType elemType
             case mode of
                 Active tableIdx offset -> runChecker ctx $ do
                     isConstExpression offset
@@ -595,6 +597,11 @@ elemsShouldBeValid m@Module { elems, functions, tables, imports } =
                     when (tableIdx >= fromIntegral (length tableImports + length tables)) $ do
                         throwError $ TableIndexOutOfRange tableIdx
                 _ -> return ()
+        
+        isValidRef :: ElemType -> Arrow -> Bool
+        isValidRef FuncRef arr | arr == (empty ==> Func) = True
+        isValidRef ExternRef arr | arr == (empty ==> Extern) = True
+        isValidRef _ _ = False
 
 datasShouldBeValid :: Validator
 datasShouldBeValid m@Module { datas, mems, imports } =

From 6eb3acde17eda4515737febaa957820eb69675b8 Mon Sep 17 00:00:00 2001
From: Ilya Rezvov <rezvov.ilya@gmail.com>
Date: Sat, 4 Jun 2022 16:32:20 -0600
Subject: [PATCH 12/28] implement table.get and table.set and pass ref_is_null
 test suit

---
 src/Language/Wasm/Interpreter.hs | 35 ++++++++++++++++++++++++++++----
 src/Language/Wasm/Parser.y       | 18 +++++++++++++++-
 src/Language/Wasm/Script.hs      |  4 ++--
 src/Language/Wasm/Structure.hs   |  1 +
 src/Language/Wasm/Validate.hs    | 23 +++++++++++++++------
 tests/Test.hs                    |  3 +--
 6 files changed, 69 insertions(+), 15 deletions(-)

diff --git a/src/Language/Wasm/Interpreter.hs b/src/Language/Wasm/Interpreter.hs
index 6b023e9..7bd6705 100644
--- a/src/Language/Wasm/Interpreter.hs
+++ b/src/Language/Wasm/Interpreter.hs
@@ -67,6 +67,8 @@ import Language.Wasm.FloatUtils (
         doubleToWord
     )
 
+import Debug.Trace as Debug
+
 data Value =
     VI32 Word32
     | VI64 Word64
@@ -169,7 +171,7 @@ type Address = Int
 type TableStore = IOVector (Maybe Address)
 
 data TableInstance = TableInstance {
-    lim :: Limit,
+    t :: TableType,
     items :: TableStore
 }
 
@@ -422,7 +424,7 @@ calcInstance (Store fs ts ms gs es ds) imps mod = do
             tableAddr <- case idx of
                 ExternTable tableAddr -> return tableAddr
                 _ -> throwError "incompatible import type"
-            let TableInstance { lim } = ts ! tableAddr
+            let TableInstance { t = TableType lim _ } = ts ! tableAddr
             if limitMatch lim limit
             then return idx
             else throwError "incompatible import type"
@@ -480,9 +482,9 @@ allocTables :: [Table] -> IO (Vector TableInstance)
 allocTables = fmap Vector.fromList . mapM allocTable
     where
         allocTable :: Table -> IO TableInstance
-        allocTable (Table (TableType lim@(Limit from to) _)) =
+        allocTable (Table t@(TableType lim@(Limit from to) _)) =
             let elements = MVector.replicate (fromIntegral from) Nothing in
-            TableInstance lim <$> elements
+            TableInstance t <$> elements
 
 defaultBudget :: Natural
 defaultBudget = 300
@@ -641,6 +643,8 @@ eval budget store FunctionInstance { funcType, moduleInstance, code = Function {
         checkValType I64 (VI64 v) = Just $ VI64 v
         checkValType F32 (VF32 v) = Just $ VF32 v
         checkValType F64 (VF64 v) = Just $ VF64 v
+        checkValType Func (RF v)  = Just $ RF v
+        checkValType Extern (RE v) = Just $ RE v
         checkValType _   _        = Nothing
 
         initLocal :: ValueType -> Value
@@ -920,6 +924,29 @@ eval budget store FunctionInstance { funcType, moduleInstance, code = Function {
                 Vector.iforM_ (Vector.slice src len refs) $ \idx (RF fn) ->
                     MVector.unsafeWrite items (dst + idx) (fromIntegral <$> fn)
                 return $ Done ctx { stack = rest }
+        step ctx@EvalCtx{ stack = (ref:VI32 offset:rest) } (TableSet tableIdx) = do
+            let tableAddr = tableaddrs moduleInstance ! fromIntegral tableIdx
+            let TableInstance { items } = tableInstances store ! tableAddr
+            let dst = fromIntegral offset
+            let val = case ref of
+                    RE extRef -> extRef
+                    RF fnRef -> fnRef
+                    v -> error "Impossible due to validation"
+            if dst > MVector.length items
+            then return Trap
+            else do
+                MVector.unsafeWrite items dst (fromIntegral <$> val)
+                return $ Done ctx { stack = rest }
+        step ctx@EvalCtx{ stack = (VI32 offset:rest) } (TableGet tableIdx) = do
+            let tableAddr = tableaddrs moduleInstance ! fromIntegral tableIdx
+            let TableInstance { t = TableType _ et, items } = tableInstances store ! tableAddr
+            let dst = fromIntegral offset
+            if dst > MVector.length items
+            then return Trap
+            else do
+                v <- MVector.unsafeRead items dst
+                let val = (case et of {FuncRef -> RF; ExternRef -> RE}) (fromIntegral <$> v)
+                return $ Done ctx { stack = val : rest }
         step ctx (I32Const v) = return $ Done ctx { stack = VI32 v : stack ctx }
         step ctx (I64Const v) = return $ Done ctx { stack = VI64 v : stack ctx }
         step ctx (F32Const v) = return $ Done ctx { stack = VF32 v : stack ctx }
diff --git a/src/Language/Wasm/Parser.y b/src/Language/Wasm/Parser.y
index e9aad36..076d5d9 100644
--- a/src/Language/Wasm/Parser.y
+++ b/src/Language/Wasm/Parser.y
@@ -133,6 +133,7 @@ import Language.Wasm.Lexer (
 'ref.null'            { Lexeme _ (TKeyword "ref.null") }
 'ref.is_null'         { Lexeme _ (TKeyword "ref.is_null") }
 'ref.func'            { Lexeme _ (TKeyword "ref.func") }
+'ref.extern'          { Lexeme _ (TKeyword "ref.extern") }
 'drop'                { Lexeme _ (TKeyword "drop") }
 'select'              { Lexeme _ (TKeyword "select") }
 'get_local'           { Lexeme _ (TKeyword "local.get") }
@@ -438,6 +439,7 @@ plaininstr :: { PlainInstr }
     | 'ref.null' heaptype            { RefNull $2 }
     | 'ref.is_null'                  { RefIsNull }
     | 'ref.func' index               { RefFunc $2 }
+    | 'ref.extern' u32               { RefExtern $2 }
     -- variable instructions
     | 'get_local' index              { GetLocal $2 }
     | 'set_local' index              { SetLocal $2 }
@@ -471,11 +473,13 @@ plaininstr :: { PlainInstr }
     | 'memory.size'                  { CurrentMemory }
     | 'memory.grow'                  { GrowMemory }
     -- table instructions
-    | 'table.init' index opt(index)  {
+    | 'table.init' index opt(index) {
         case $3 of
             Nothing -> TableInit (Index 0) $2
             Just elemIdx -> TableInit $2 elemIdx
     }
+    | 'table.get' index              { TableGet $2 }
+    | 'table.set' index              { TableSet $2 }
     -- numeric instructions
     | 'i32.const' int32              { I32Const $2 }
     | 'i64.const' int64              { I64Const $2 }
@@ -1184,6 +1188,7 @@ data PlainInstr =
     | RefNull ElemType
     | RefIsNull
     | RefFunc FuncIndex
+    | RefExtern Natural
     -- Parametric instructions
     | Drop
     | Select
@@ -1460,6 +1465,7 @@ constInstructionToValue (PlainInstr (F32Const v)) = S.F32Const v
 constInstructionToValue (PlainInstr (I64Const v)) = S.I64Const $ integerToWord64 v
 constInstructionToValue (PlainInstr (F64Const v)) = S.F64Const v
 constInstructionToValue (PlainInstr (RefNull et)) = S.RefNull et
+constInstructionToValue (PlainInstr (RefExtern n)) = S.RefExtern n
 constInstructionToValue _ = error "Only const instructions supported as arguments for actions"
 
 funcIndexToExpr :: [FuncIndex] -> [[Instruction]]
@@ -1653,6 +1659,8 @@ desugarize fields = do
             case getFuncIndex ctxMod funIdx of
                 Just idx -> return $ S.RefFunc idx
                 Nothing -> Left "unknown function"
+        synInstrToStruct FunCtx { ctxMod } (PlainInstr (RefExtern idx)) =
+            return $ S.RefExtern idx
         synInstrToStruct ctx (PlainInstr (GetLocal localIdx)) =
             case getLocalIndex ctx localIdx of
                 Just idx -> return $ S.GetLocal idx
@@ -1705,6 +1713,14 @@ desugarize fields = do
                         Just elemIdx -> return $ S.TableInit tableIdx elemIdx
                         Nothing -> Left "unknown elem"
                 Nothing -> Left "unknown table"
+        synInstrToStruct FunCtx { ctxMod } (PlainInstr (TableSet tableIdx)) =
+            case getTableIndex ctxMod tableIdx of
+                Just tableIdx -> return $ S.TableSet tableIdx
+                Nothing -> Left "unknown table"
+        synInstrToStruct FunCtx { ctxMod } (PlainInstr (TableGet tableIdx)) =
+            case getTableIndex ctxMod tableIdx of
+                Just tableIdx -> return $ S.TableGet tableIdx
+                Nothing -> Left "unknown table"
         synInstrToStruct _ (PlainInstr (I32Const val)) = return $ S.I32Const $ integerToWord32 val
         synInstrToStruct _ (PlainInstr (I64Const val)) = return $ S.I64Const $ integerToWord64 val
         synInstrToStruct _ (PlainInstr (F32Const val)) = return $ S.F32Const val
diff --git a/src/Language/Wasm/Script.hs b/src/Language/Wasm/Script.hs
index a4ce926..fb895a5 100644
--- a/src/Language/Wasm/Script.hs
+++ b/src/Language/Wasm/Script.hs
@@ -124,7 +124,8 @@ runScript onAssertFail script = do
         asArg [Struct.F64Const v] = Interpreter.VF64 v
         asArg [Struct.RefNull Struct.FuncRef] = Interpreter.RF Nothing
         asArg [Struct.RefNull Struct.ExternRef] = Interpreter.RE Nothing
-        asArg _                   = error "Only const instructions supported as arguments for actions"
+        asArg [Struct.RefExtern v] = Interpreter.RE (Just v)
+        asArg expr = error $ "Only const instructions supported as arguments for actions: " ++ show expr
 
         runAction :: ScriptState -> Action -> IO (Maybe [Interpreter.Value])
         runAction st (Invoke ident name args) = do
@@ -176,7 +177,6 @@ runScript onAssertFail script = do
         getFailureString (Validate.RefTypeMismatch _ _) = ["type mismatch"]
         getFailureString Validate.ResultTypeDoesntMatch = ["type mismatch"]
         getFailureString Validate.MoreThanOneMemory = ["multiple memories"]
-        getFailureString Validate.MoreThanOneTable = ["multiple tables"]
         getFailureString (Validate.LocalIndexOutOfRange idx) = ["unknown local", "unknown local " <> TL.pack (show idx)]
         getFailureString (Validate.MemoryIndexOutOfRange idx) = ["unknown memory", "unknown memory " <> TL.pack (show idx)]
         getFailureString (Validate.TableIndexOutOfRange idx) = ["unknown table", "unknown table " <> TL.pack (show idx)]
diff --git a/src/Language/Wasm/Structure.hs b/src/Language/Wasm/Structure.hs
index 4a7e7d9..a49cf9e 100644
--- a/src/Language/Wasm/Structure.hs
+++ b/src/Language/Wasm/Structure.hs
@@ -142,6 +142,7 @@ data Instruction index =
     | RefNull ElemType
     | RefIsNull
     | RefFunc index
+    | RefExtern Natural
     -- Parametric instructions
     | Drop
     | Select
diff --git a/src/Language/Wasm/Validate.hs b/src/Language/Wasm/Validate.hs
index 6ef2824..f8e60cd 100644
--- a/src/Language/Wasm/Validate.hs
+++ b/src/Language/Wasm/Validate.hs
@@ -32,7 +32,6 @@ data ValidationError =
     | MemoryLimitExceeded
     | AlignmentOverflow
     | MoreThanOneMemory
-    | MoreThanOneTable
     | FunctionIndexOutOfRange
     | TableIndexOutOfRange Natural
     | MemoryIndexOutOfRange Natural
@@ -200,6 +199,10 @@ getResultType (TypeIndex typeIdx) = do
     Ctx { types } <- ask
     maybeToEither TypeIndexOutOfRange $ results <$> types !? typeIdx
 
+elemTypeToRefType :: ElemType -> ValueType 
+elemTypeToRefType FuncRef = Func
+elemTypeToRefType ExternRef = Extern
+
 getInstrType :: Instruction Natural -> Checker Arrow
 getInstrType Unreachable = return $ Any ==> Any
 getInstrType Nop = return $ empty ==> empty
@@ -265,7 +268,8 @@ getInstrType (RefNull elType) = do
     let t = case elType of { FuncRef -> Func; ExternRef -> Extern }
     return $ empty ==> Val t
 getInstrType RefIsNull = do
-    return $ empty ==> Val I32
+    var <- freshVar
+    return $ var ==> Val I32
 getInstrType (RefFunc funIdx) = do
     Ctx { funcs } <- ask
     if fromIntegral funIdx < length funcs
@@ -375,6 +379,16 @@ getInstrType (TableInit tableIdx elemIdx) = do
     let elemType = elems !! fromIntegral elemIdx
     when (elemType /= tableType) $ throwError (RefTypeMismatch tableType elemType)
     return $ [I32, I32, I32] ==> empty
+getInstrType (TableGet tableIdx) = do
+    Ctx { tables } <- ask
+    when (length tables <= fromIntegral tableIdx) $ throwError (TableIndexOutOfRange tableIdx)
+    let TableType _ tableType = tables !! fromIntegral tableIdx
+    return $ I32 ==> (elemTypeToRefType tableType)
+getInstrType (TableSet tableIdx) = do
+    Ctx { tables } <- ask
+    when (length tables <= fromIntegral tableIdx) $ throwError (TableIndexOutOfRange tableIdx)
+    let TableType _ tableType = tables !! fromIntegral tableIdx
+    return $ [I32, elemTypeToRefType tableType] ==> empty
 getInstrType (I32Const _) = return $ empty ==> I32
 getInstrType (I64Const _) = return $ empty ==> I64
 getInstrType (F32Const _) = return $ empty ==> F32
@@ -533,10 +547,7 @@ tablesShouldBeValid :: Validator
 tablesShouldBeValid Module { imports, tables } =
     let tableImports = filter isTableImport imports in
     let res = foldMap (\Import { desc = ImportTable t } -> isValidTableType t) tableImports in
-    let res' = foldl' (\r (Table t) -> r <> isValidTableType t) res tables in
-    if length tableImports + length tables <= 1
-        then res'
-        else Left MoreThanOneTable
+    foldl' (\r (Table t) -> r <> isValidTableType t) res tables
     where
         isValidTableType :: TableType -> ValidationResult
         isValidTableType (TableType (Limit min max) _) =
diff --git a/tests/Test.hs b/tests/Test.hs
index c4411b2..a8727a9 100644
--- a/tests/Test.hs
+++ b/tests/Test.hs
@@ -17,8 +17,7 @@ import qualified Data.List as List
 main :: IO ()
 main = do
   files <- filter (List.isSuffixOf ".wast") <$> Directory.listDirectory "tests/spec"
-  -- let files = ["ref_null.wast", "ref_is_null.wast"]
-  let files = ["elem.wast"]
+  let files = ["ref_is_null.wast"]
   scriptTestCases <- (`mapM` files) $ \file -> do
     test <- LBS.readFile ("tests/spec/" ++ file)
     return $ testCase file $ do

From 82defff0768225317d3d5f4ca91da05625ea5637 Mon Sep 17 00:00:00 2001
From: Ilya Rezvov <rezvov.ilya@gmail.com>
Date: Sat, 4 Jun 2022 21:58:34 -0600
Subject: [PATCH 13/28] add elem.drop and extend call_indirect to accept table
 index

---
 src/Language/Wasm/Binary.hs      |  6 ++---
 src/Language/Wasm/Builder.hs     |  2 +-
 src/Language/Wasm/Interpreter.hs | 23 ++++++++++++-----
 src/Language/Wasm/Parser.y       | 44 +++++++++++++++++++++++---------
 src/Language/Wasm/Structure.hs   |  3 ++-
 src/Language/Wasm/Validate.hs    | 19 +++++++++++---
 tests/Test.hs                    |  6 +++--
 7 files changed, 74 insertions(+), 29 deletions(-)

diff --git a/src/Language/Wasm/Binary.hs b/src/Language/Wasm/Binary.hs
index d711c02..96d774d 100644
--- a/src/Language/Wasm/Binary.hs
+++ b/src/Language/Wasm/Binary.hs
@@ -365,7 +365,7 @@ instance Serialize (Instruction Natural) where
     put (BrTable labels label) = putWord8 0x0E >> putVec (map Index labels) >> putULEB128 label
     put Return = putWord8 0x0F
     put (Call funcIdx) = putWord8 0x10 >> putULEB128 funcIdx
-    put (CallIndirect typeIdx) = putWord8 0x11 >> putULEB128 typeIdx >> putWord8 0x00
+    put (CallIndirect tableIdx typeIdx) = putWord8 0x11 >> putULEB128 typeIdx >> putULEB128 tableIdx
     -- Parametric instructions
     put Drop = putWord8 0x1A
     put Select = putWord8 0x1B
@@ -565,8 +565,8 @@ instance Serialize (Instruction Natural) where
             0x10 -> Call <$> getULEB128 32
             0x11 -> do
                 typeIdx <- getULEB128 32
-                byteGuard 0x00
-                return $ CallIndirect typeIdx
+                tableIdx <- getULEB128 32
+                return $ CallIndirect tableIdx typeIdx
             -- Parametric instructions
             0x1A -> return $ Drop
             0x1B -> return $ Select
diff --git a/src/Language/Wasm/Builder.hs b/src/Language/Wasm/Builder.hs
index caa158a..053f6e9 100644
--- a/src/Language/Wasm/Builder.hs
+++ b/src/Language/Wasm/Builder.hs
@@ -655,7 +655,7 @@ callIndirect :: (Producer index, OutType index ~ Proxy I32, Returnable res) => T
 callIndirect (TypeDef idx) index args = do
     sequence_ args
     produce index
-    appendExpr [CallIndirect idx]
+    appendExpr [CallIndirect 0 idx]
     return returnableValue
 
 br :: Label t -> GenFun ()
diff --git a/src/Language/Wasm/Interpreter.hs b/src/Language/Wasm/Interpreter.hs
index 7bd6705..87055a4 100644
--- a/src/Language/Wasm/Interpreter.hs
+++ b/src/Language/Wasm/Interpreter.hs
@@ -510,10 +510,14 @@ allocElems :: ModuleInstance -> Store -> [ElemSegment] -> IO (Vector ElemInstanc
 allocElems inst st = fmap Vector.fromList . mapM allocElem
     where
         allocElem :: ElemSegment -> IO ElemInstance
-        allocElem (ElemSegment t mode refs) =
-            ElemInstance mode t
-                <$> (Vector.fromList <$> mapM (evalConstExpr inst st) refs)
-                <*> newIORef False -- is dropped
+        allocElem (ElemSegment t mode refs) = do
+            indexes <- flip mapM refs $ \refExpr -> do
+                ref <- evalConstExpr inst st refExpr
+                return $ case ref of
+                    RF v -> RF $ fromIntegral . (funcaddrs inst !) . fromIntegral <$> v
+                    _ -> ref
+            ElemInstance mode t (Vector.fromList indexes)
+                <$> newIORef False -- is dropped
 
 allocDatas :: ModuleInstance -> Store -> [DataSegment] -> Vector DataInstance
 allocDatas _inst _st = Vector.fromList . map (const DataInstance)
@@ -765,14 +769,14 @@ eval budget store FunctionInstance { funcType, moduleInstance, code = Function {
                         Just res -> return $ Done ctx { stack = reverse res ++ (drop (length args) $ stack ctx) }
                         Nothing -> return Trap
                 Nothing -> return Trap
-        step ctx@EvalCtx{ stack = (VI32 v): rest } (CallIndirect typeIdx) = do
+        step ctx@EvalCtx{ stack = (VI32 v): rest } (CallIndirect tableIdx typeIdx) = do
             let funcType = funcTypes moduleInstance ! fromIntegral typeIdx
-            let TableInstance { items } = tableInstances store ! (tableaddrs moduleInstance ! 0)
+            let TableInstance { items } = tableInstances store ! (tableaddrs moduleInstance ! fromIntegral tableIdx)
             let pos = fromIntegral v
             if pos >= MVector.length items
             then return Trap
             else do
-                maybeAddr <- liftIO $ MVector.read items pos
+                maybeAddr <- MVector.unsafeRead items pos
                 let checks = do
                         addr <- maybeAddr
                         let funcInst = funcInstances store ! addr
@@ -947,6 +951,11 @@ eval budget store FunctionInstance { funcType, moduleInstance, code = Function {
                 v <- MVector.unsafeRead items dst
                 let val = (case et of {FuncRef -> RF; ExternRef -> RE}) (fromIntegral <$> v)
                 return $ Done ctx { stack = val : rest }
+        step ctx (ElemDrop elemIdx) = do
+            let elemAddr = elemaddrs moduleInstance ! fromIntegral elemIdx
+            let ElemInstance {isDropped} = elemInstances store ! elemAddr
+            writeIORef isDropped True
+            return $ Done ctx
         step ctx (I32Const v) = return $ Done ctx { stack = VI32 v : stack ctx }
         step ctx (I64Const v) = return $ Done ctx { stack = VI64 v : stack ctx }
         step ctx (F32Const v) = return $ Done ctx { stack = VF32 v : stack ctx }
diff --git a/src/Language/Wasm/Parser.y b/src/Language/Wasm/Parser.y
index 076d5d9..4c345ee 100644
--- a/src/Language/Wasm/Parser.y
+++ b/src/Language/Wasm/Parser.y
@@ -173,6 +173,7 @@ import Language.Wasm.Lexer (
 'table.grow'          { Lexeme _ (TKeyword "table.grow") }
 'table.get'           { Lexeme _ (TKeyword "table.get") }
 'table.set'           { Lexeme _ (TKeyword "table.set") }
+'elem.drop'           { Lexeme _ (TKeyword "elem.drop") }
 'i32.const'           { Lexeme _ (TKeyword "i32.const") }
 'i64.const'           { Lexeme _ (TKeyword "i64.const") }
 'f32.const'           { Lexeme _ (TKeyword "f32.const") }
@@ -480,6 +481,8 @@ plaininstr :: { PlainInstr }
     }
     | 'table.get' index              { TableGet $2 }
     | 'table.set' index              { TableSet $2 }
+    | 'table.copy' index index       { TableCopy $2 $3 }
+    | 'elem.drop' index              { ElemDrop $2 }
     -- numeric instructions
     | 'i32.const' int32              { I32Const $2 }
     | 'i64.const' int64              { I64Const $2 }
@@ -690,9 +693,10 @@ memarg8 :: { MemArg }
 instruction_list(terminator)
     : terminator { ($1, []) }
     | plaininstr mixed_instruction_list(terminator) { ([PlainInstr $1] ++) `fmap` $2 }
-    | 'call_indirect' typeuse(terminator) {%
-        let (tu, instr, end) = $2 in
-        onlyAnonimParams tu >> (return (end, [PlainInstr $ CallIndirect tu] ++ instr))
+    | 'call_indirect' opt(index) typeuse(terminator) {%
+        let tableIdx = fromMaybe (Index 0) $2 in
+        let (tu, instr, end) = $3 in
+        onlyAnonimParams tu >> (return (end, [PlainInstr $ CallIndirect tableIdx tu] ++ instr))
     }
     | 'block' opt(ident) typeuse('end') opt(ident) mixed_instruction_list(terminator) {% do
         let (tu, instr, _) = $3 
@@ -730,9 +734,10 @@ folded_instr :: { [Instruction] }
 
 folded_instr1 :: { [Instruction] }
     : plaininstr mixed_instruction_list(')') { snd $2 ++ [PlainInstr $1] }
-    | 'call_indirect' typeuse(')') {%
-        let (tu, instr, _) = $2 in
-        onlyAnonimParams tu >> (return $ instr ++ [PlainInstr $ CallIndirect tu])
+    | 'call_indirect' opt(index) typeuse(')') {%
+        let tableIdx = fromMaybe (Index 0) $2 in
+        let (tu, instr, _) = $3 in
+        onlyAnonimParams tu >> (return $ instr ++ [PlainInstr $ CallIndirect tableIdx tu])
     }
     | 'block' opt(ident) typeuse(')') {%
         let (typeUse, instr, _) = $3 in
@@ -1183,7 +1188,7 @@ data PlainInstr =
     | BrTable [LabelIndex] LabelIndex
     | Return
     | Call FuncIndex
-    | CallIndirect TypeUse
+    | CallIndirect TableIndex TypeUse
     -- Reference instructions
     | RefNull ElemType
     | RefIsNull
@@ -1232,6 +1237,7 @@ data PlainInstr =
     | TableGet TableIndex
     | TableSet TableIndex
     | TableCopy TableIndex TableIndex
+    | ElemDrop ElemIndex
     -- Numeric instructions
     | I32Const Integer
     | I64Const Integer
@@ -1564,7 +1570,7 @@ desugarize fields = do
         extractTypeDefFromInstructions = foldl' extractTypeDefFromInstruction
 
         extractTypeDefFromInstruction :: [TypeDef] -> Instruction -> [TypeDef]
-        extractTypeDefFromInstruction defs (PlainInstr (CallIndirect typeUse)) =
+        extractTypeDefFromInstruction defs (PlainInstr (CallIndirect _ typeUse)) =
             matchTypeUse defs typeUse
         extractTypeDefFromInstruction defs (BlockInstr { body, blockType }) =
             extractTypeDefFromInstructions (matchTypeUse defs blockType) body
@@ -1647,10 +1653,13 @@ desugarize fields = do
             case getFuncIndex ctxMod funIdx of
                 Just idx -> return $ S.Call idx
                 Nothing -> Left "unknown function"
-        synInstrToStruct FunCtx { ctxMod = Module { types } } (PlainInstr (CallIndirect typeUse)) =
-            case getTypeIndex types typeUse of
-                Just idx -> return $ S.CallIndirect idx
-                Nothing -> Left "unknown type"
+        synInstrToStruct FunCtx { ctxMod } (PlainInstr (CallIndirect tableIdx typeUse)) =
+            case getTableIndex ctxMod tableIdx of
+                Just tableIdx ->
+                    case getTypeIndex (types ctxMod) typeUse of
+                        Just idx -> return $ S.CallIndirect tableIdx idx
+                        Nothing -> Left "unknown type"
+                Nothing -> Left "unknown table"
         synInstrToStruct _ (PlainInstr Drop) = return $ S.Drop
         synInstrToStruct _ (PlainInstr Select) = return $ S.Select
         synInstrToStruct _ (PlainInstr (RefNull elType)) = return $ S.RefNull elType
@@ -1713,6 +1722,13 @@ desugarize fields = do
                         Just elemIdx -> return $ S.TableInit tableIdx elemIdx
                         Nothing -> Left "unknown elem"
                 Nothing -> Left "unknown table"
+        synInstrToStruct FunCtx { ctxMod } (PlainInstr (TableCopy fromIdx toIdx)) =
+            case getTableIndex ctxMod fromIdx of
+                Just fromIdx ->
+                    case getTableIndex ctxMod toIdx of
+                        Just toIdx -> return $ S.TableCopy fromIdx toIdx
+                        Nothing -> Left "unknown table"
+                Nothing -> Left "unknown table"
         synInstrToStruct FunCtx { ctxMod } (PlainInstr (TableSet tableIdx)) =
             case getTableIndex ctxMod tableIdx of
                 Just tableIdx -> return $ S.TableSet tableIdx
@@ -1721,6 +1737,10 @@ desugarize fields = do
             case getTableIndex ctxMod tableIdx of
                 Just tableIdx -> return $ S.TableGet tableIdx
                 Nothing -> Left "unknown table"
+        synInstrToStruct FunCtx { ctxMod } (PlainInstr (ElemDrop elemIdx)) =
+            case getElemIndex ctxMod elemIdx of
+                Just elemIdx -> return $ S.ElemDrop elemIdx
+                Nothing -> Left "unknown elem"
         synInstrToStruct _ (PlainInstr (I32Const val)) = return $ S.I32Const $ integerToWord32 val
         synInstrToStruct _ (PlainInstr (I64Const val)) = return $ S.I64Const $ integerToWord64 val
         synInstrToStruct _ (PlainInstr (F32Const val)) = return $ S.F32Const val
diff --git a/src/Language/Wasm/Structure.hs b/src/Language/Wasm/Structure.hs
index a49cf9e..3cbef07 100644
--- a/src/Language/Wasm/Structure.hs
+++ b/src/Language/Wasm/Structure.hs
@@ -137,7 +137,7 @@ data Instruction index =
     | BrTable [index] index
     | Return
     | Call index
-    | CallIndirect index
+    | CallIndirect index index
     -- Reference instructions
     | RefNull ElemType
     | RefIsNull
@@ -186,6 +186,7 @@ data Instruction index =
     | TableGet TableIndex
     | TableSet TableIndex
     | TableCopy TableIndex TableIndex
+    | ElemDrop ElemIndex
     -- Numeric instructions
     | I32Const Word32
     | I64Const Word64
diff --git a/src/Language/Wasm/Validate.hs b/src/Language/Wasm/Validate.hs
index f8e60cd..0591b2b 100644
--- a/src/Language/Wasm/Validate.hs
+++ b/src/Language/Wasm/Validate.hs
@@ -251,10 +251,10 @@ getInstrType Return = do
 getInstrType (Call fun) = do
     Ctx { funcs } <- ask
     maybeToEither FunctionIndexOutOfRange $ asArrow <$> funcs !? fun
-getInstrType (CallIndirect sign) = do
+getInstrType (CallIndirect tableIdx sign) = do
     Ctx { types, tables } <- ask
-    if length tables < 1
-    then throwError (TableIndexOutOfRange 0)
+    if length tables <= fromIntegral tableIdx
+    then throwError (TableIndexOutOfRange tableIdx)
     else do
         Arrow from to <- maybeToEither TypeIndexOutOfRange $ asArrow <$> types !? sign
         return $ (from ++ [Val I32]) ==> to
@@ -379,6 +379,15 @@ getInstrType (TableInit tableIdx elemIdx) = do
     let elemType = elems !! fromIntegral elemIdx
     when (elemType /= tableType) $ throwError (RefTypeMismatch tableType elemType)
     return $ [I32, I32, I32] ==> empty
+getInstrType (TableCopy fromIdx toIdx) = do
+    Ctx { tables } <- ask
+    let (from, to) = (fromIntegral fromIdx, fromIntegral toIdx)
+    when (length tables <= from) $ throwError (TableIndexOutOfRange fromIdx)
+    when (length tables <= to) $ throwError (TableIndexOutOfRange toIdx)
+    let TableType _ fromType = tables !! from
+    let TableType _ toType = tables !! to
+    when (fromType /= toType) $ throwError (RefTypeMismatch fromType toType)
+    return $ [I32, I32, I32] ==> empty
 getInstrType (TableGet tableIdx) = do
     Ctx { tables } <- ask
     when (length tables <= fromIntegral tableIdx) $ throwError (TableIndexOutOfRange tableIdx)
@@ -389,6 +398,10 @@ getInstrType (TableSet tableIdx) = do
     when (length tables <= fromIntegral tableIdx) $ throwError (TableIndexOutOfRange tableIdx)
     let TableType _ tableType = tables !! fromIntegral tableIdx
     return $ [I32, elemTypeToRefType tableType] ==> empty
+getInstrType (ElemDrop elemIdx) = do
+    Ctx { elems } <- ask
+    when (length elems <= fromIntegral elemIdx) $ throwError (ElemIndexOutOfRange elemIdx)
+    return $ empty ==> empty
 getInstrType (I32Const _) = return $ empty ==> I32
 getInstrType (I64Const _) = return $ empty ==> I64
 getInstrType (F32Const _) = return $ empty ==> F32
diff --git a/tests/Test.hs b/tests/Test.hs
index a8727a9..b38edad 100644
--- a/tests/Test.hs
+++ b/tests/Test.hs
@@ -16,8 +16,10 @@ import qualified Data.List as List
 
 main :: IO ()
 main = do
-  files <- filter (List.isSuffixOf ".wast") <$> Directory.listDirectory "tests/spec"
-  let files = ["ref_is_null.wast"]
+  files <-
+    filter (not . List.isPrefixOf "simd") . filter (List.isSuffixOf ".wast")
+      <$> Directory.listDirectory "tests/spec"
+  let files = ["table_init.wast"]
   scriptTestCases <- (`mapM` files) $ \file -> do
     test <- LBS.readFile ("tests/spec/" ++ file)
     return $ testCase file $ do

From b1da37ac03747987a205da6d637ee59abbae3f81 Mon Sep 17 00:00:00 2001
From: Ilya Rezvov <rezvov.ilya@gmail.com>
Date: Sun, 5 Jun 2022 21:45:58 -0600
Subject: [PATCH 14/28] implement table.copy

---
 src/Language/Wasm/Interpreter.hs | 18 +++++++++++++++++-
 src/Language/Wasm/Parser.y       |  4 ++--
 src/Language/Wasm/Validate.hs    |  2 +-
 3 files changed, 20 insertions(+), 4 deletions(-)

diff --git a/src/Language/Wasm/Interpreter.hs b/src/Language/Wasm/Interpreter.hs
index 87055a4..75cd49d 100644
--- a/src/Language/Wasm/Interpreter.hs
+++ b/src/Language/Wasm/Interpreter.hs
@@ -925,9 +925,25 @@ eval budget store FunctionInstance { funcType, moduleInstance, code = Function {
                 || isDeclarative mode
             then return Trap
             else do
-                Vector.iforM_ (Vector.slice src len refs) $ \idx (RF fn) ->
+                Vector.iforM_ (Vector.slice src len refs) $ \idx (RF fn) -> do
                     MVector.unsafeWrite items (dst + idx) (fromIntegral <$> fn)
                 return $ Done ctx { stack = rest }
+        step ctx@EvalCtx{ stack = (VI32 n:VI32 s:VI32 d:rest) } (TableCopy toIdx fromIdx) = do
+            let fromAddr = tableaddrs moduleInstance ! fromIntegral fromIdx
+            let TableInstance { items = fromItems } = tableInstances store ! fromAddr
+            let toAddr = tableaddrs moduleInstance ! fromIntegral toIdx
+            let TableInstance { items = toItems } = tableInstances store ! toAddr
+            let src = fromIntegral s
+            let dst = fromIntegral d
+            let len = fromIntegral n
+            if src + len > MVector.length fromItems || dst + len > MVector.length toItems
+            then return Trap
+            else do
+                let range = if dst <= src then [0..len - 1] else reverse [0..len - 1]
+                flip mapM_ range $ \off -> do
+                    el <- MVector.unsafeRead fromItems (src + off)
+                    MVector.unsafeWrite toItems (dst + off) el
+                return $ Done ctx { stack = rest }
         step ctx@EvalCtx{ stack = (ref:VI32 offset:rest) } (TableSet tableIdx) = do
             let tableAddr = tableaddrs moduleInstance ! fromIntegral tableIdx
             let TableInstance { items } = tableInstances store ! tableAddr
diff --git a/src/Language/Wasm/Parser.y b/src/Language/Wasm/Parser.y
index 4c345ee..a06baf2 100644
--- a/src/Language/Wasm/Parser.y
+++ b/src/Language/Wasm/Parser.y
@@ -1722,11 +1722,11 @@ desugarize fields = do
                         Just elemIdx -> return $ S.TableInit tableIdx elemIdx
                         Nothing -> Left "unknown elem"
                 Nothing -> Left "unknown table"
-        synInstrToStruct FunCtx { ctxMod } (PlainInstr (TableCopy fromIdx toIdx)) =
+        synInstrToStruct FunCtx { ctxMod } (PlainInstr (TableCopy toIdx fromIdx)) =
             case getTableIndex ctxMod fromIdx of
                 Just fromIdx ->
                     case getTableIndex ctxMod toIdx of
-                        Just toIdx -> return $ S.TableCopy fromIdx toIdx
+                        Just toIdx -> return $ S.TableCopy toIdx fromIdx
                         Nothing -> Left "unknown table"
                 Nothing -> Left "unknown table"
         synInstrToStruct FunCtx { ctxMod } (PlainInstr (TableSet tableIdx)) =
diff --git a/src/Language/Wasm/Validate.hs b/src/Language/Wasm/Validate.hs
index 0591b2b..6eb9091 100644
--- a/src/Language/Wasm/Validate.hs
+++ b/src/Language/Wasm/Validate.hs
@@ -379,7 +379,7 @@ getInstrType (TableInit tableIdx elemIdx) = do
     let elemType = elems !! fromIntegral elemIdx
     when (elemType /= tableType) $ throwError (RefTypeMismatch tableType elemType)
     return $ [I32, I32, I32] ==> empty
-getInstrType (TableCopy fromIdx toIdx) = do
+getInstrType (TableCopy toIdx fromIdx) = do
     Ctx { tables } <- ask
     let (from, to) = (fromIntegral fromIdx, fromIntegral toIdx)
     when (length tables <= from) $ throwError (TableIndexOutOfRange fromIdx)

From df15d3c4d1b7d3b71f4fe499f083799dc5f9a6d5 Mon Sep 17 00:00:00 2001
From: Ilya Rezvov <rezvov.ilya@gmail.com>
Date: Mon, 6 Jun 2022 18:27:26 -0600
Subject: [PATCH 15/28] change table storage format to allow growing and
 implement table.grow and table.size

---
 src/Language/Wasm/Interpreter.hs | 61 ++++++++++++++++++++++++--------
 src/Language/Wasm/Parser.y       | 10 ++++++
 src/Language/Wasm/Script.hs      |  3 +-
 src/Language/Wasm/Validate.hs    |  9 +++++
 tests/Test.hs                    |  2 +-
 5 files changed, 68 insertions(+), 17 deletions(-)

diff --git a/src/Language/Wasm/Interpreter.hs b/src/Language/Wasm/Interpreter.hs
index 75cd49d..7021735 100644
--- a/src/Language/Wasm/Interpreter.hs
+++ b/src/Language/Wasm/Interpreter.hs
@@ -168,7 +168,7 @@ data Label = Label ResultType deriving (Show, Eq)
 
 type Address = Int
 
-type TableStore = IOVector (Maybe Address)
+type TableStore = IORef (IOVector (Maybe Address))
 
 data TableInstance = TableInstance {
     t :: TableType,
@@ -484,7 +484,7 @@ allocTables = fmap Vector.fromList . mapM allocTable
         allocTable :: Table -> IO TableInstance
         allocTable (Table t@(TableType lim@(Limit from to) _)) =
             let elements = MVector.replicate (fromIntegral from) Nothing in
-            TableInstance t <$> elements
+            TableInstance t <$> (elements >>= newIORef)
 
 defaultBudget :: Natural
 defaultBudget = 300
@@ -558,14 +558,14 @@ initialize inst Module {elems, datas, start} = do
             let idx = tableaddrs inst ! fromIntegral tableIndex
             let last = from + length funcs
             let TableInstance lim elems = tableInstances st ! idx
-            let len = MVector.length elems
+            len <- MVector.length <$> (liftIO $ readIORef elems)
             Monad.when (last > len) $ throwError "out of bounds table access"
             return (idx, elemaddrs inst ! elemN, from, funcs)
 
         initElem :: (Address, Address, Int, [Maybe Address]) -> Initialize ()
         initElem (tableIdx, elemIdx, from, funcs) = do
             Store {tableInstances, elemInstances} <- State.get
-            let elems = items $ tableInstances ! tableIdx
+            elems <- liftIO $ readIORef $ items $ tableInstances ! tableIdx
             let ElemInstance {isDropped} = elemInstances ! elemIdx
             liftIO $ writeIORef isDropped True
             Monad.forM_ (zip [from..] funcs) $ uncurry $ MVector.unsafeWrite elems
@@ -773,10 +773,11 @@ eval budget store FunctionInstance { funcType, moduleInstance, code = Function {
             let funcType = funcTypes moduleInstance ! fromIntegral typeIdx
             let TableInstance { items } = tableInstances store ! (tableaddrs moduleInstance ! fromIntegral tableIdx)
             let pos = fromIntegral v
-            if pos >= MVector.length items
+            funcs <- readIORef items
+            if pos >= MVector.length funcs
             then return Trap
             else do
-                maybeAddr <- MVector.unsafeRead items pos
+                maybeAddr <- MVector.unsafeRead funcs pos
                 let checks = do
                         addr <- maybeAddr
                         let funcInst = funcInstances store ! addr
@@ -918,15 +919,16 @@ eval budget store FunctionInstance { funcType, moduleInstance, code = Function {
             let src = fromIntegral s
             let dst = fromIntegral d
             let len = fromIntegral n
+            els <- readIORef items
             isDropped <- readIORef dropFlag
             if src + len > Vector.length refs
-                || dst + len > MVector.length items
+                || dst + len > MVector.length els
                 || isDropped
                 || isDeclarative mode
             then return Trap
             else do
                 Vector.iforM_ (Vector.slice src len refs) $ \idx (RF fn) -> do
-                    MVector.unsafeWrite items (dst + idx) (fromIntegral <$> fn)
+                    MVector.unsafeWrite els (dst + idx) (fromIntegral <$> fn)
                 return $ Done ctx { stack = rest }
         step ctx@EvalCtx{ stack = (VI32 n:VI32 s:VI32 d:rest) } (TableCopy toIdx fromIdx) = do
             let fromAddr = tableaddrs moduleInstance ! fromIntegral fromIdx
@@ -936,14 +938,41 @@ eval budget store FunctionInstance { funcType, moduleInstance, code = Function {
             let src = fromIntegral s
             let dst = fromIntegral d
             let len = fromIntegral n
-            if src + len > MVector.length fromItems || dst + len > MVector.length toItems
+            fromEls <- readIORef fromItems
+            toEls <- readIORef toItems
+            if src + len > MVector.length fromEls || dst + len > MVector.length toEls
             then return Trap
             else do
                 let range = if dst <= src then [0..len - 1] else reverse [0..len - 1]
                 flip mapM_ range $ \off -> do
-                    el <- MVector.unsafeRead fromItems (src + off)
-                    MVector.unsafeWrite toItems (dst + off) el
+                    el <- MVector.unsafeRead fromEls (src + off)
+                    MVector.unsafeWrite toEls (dst + off) el
                 return $ Done ctx { stack = rest }
+        step ctx@EvalCtx{ stack } (TableSize tableIdx) = do
+            let tableAddr = tableaddrs moduleInstance ! fromIntegral tableIdx
+            let TableInstance { items } = tableInstances store ! tableAddr
+            len <- MVector.length <$> readIORef items
+            return $ Done ctx { stack = VI32 (fromIntegral len) : stack }
+        step ctx@EvalCtx{ stack = (VI32 growBy:ref:rest) } (TableGrow tableIdx) = do
+            let tableAddr = tableaddrs moduleInstance ! fromIntegral tableIdx
+            let TableInstance { items, t } = tableInstances store ! tableAddr
+            let TableType (Limit _ max) _ = t
+            let inc = fromIntegral growBy
+            let val = case ref of
+                    RE extRef -> extRef
+                    RF fnRef -> fnRef
+                    v -> error "Impossible due to validation"
+            els <- readIORef items
+            let currLen = MVector.length els
+            let newLen = currLen + inc
+            if maybe False ((newLen >) . fromIntegral) max || newLen > 0xFFFFFFFF
+            then return $ Done ctx { stack = VI32 (asWord32 $ -1):rest }
+            else do
+                newEls <- MVector.grow els inc
+                writeIORef items newEls
+                Monad.forM_ [0..inc - 1] $ \off ->
+                    MVector.unsafeWrite newEls (currLen + off) (fromIntegral <$> val)
+                return $ Done ctx { stack = VI32 (fromIntegral currLen):rest }
         step ctx@EvalCtx{ stack = (ref:VI32 offset:rest) } (TableSet tableIdx) = do
             let tableAddr = tableaddrs moduleInstance ! fromIntegral tableIdx
             let TableInstance { items } = tableInstances store ! tableAddr
@@ -952,19 +981,21 @@ eval budget store FunctionInstance { funcType, moduleInstance, code = Function {
                     RE extRef -> extRef
                     RF fnRef -> fnRef
                     v -> error "Impossible due to validation"
-            if dst > MVector.length items
+            els <- readIORef items
+            if dst > MVector.length els
             then return Trap
             else do
-                MVector.unsafeWrite items dst (fromIntegral <$> val)
+                MVector.unsafeWrite els dst (fromIntegral <$> val)
                 return $ Done ctx { stack = rest }
         step ctx@EvalCtx{ stack = (VI32 offset:rest) } (TableGet tableIdx) = do
             let tableAddr = tableaddrs moduleInstance ! fromIntegral tableIdx
             let TableInstance { t = TableType _ et, items } = tableInstances store ! tableAddr
             let dst = fromIntegral offset
-            if dst > MVector.length items
+            els <- readIORef items
+            if dst > MVector.length els
             then return Trap
             else do
-                v <- MVector.unsafeRead items dst
+                v <- MVector.unsafeRead els dst
                 let val = (case et of {FuncRef -> RF; ExternRef -> RE}) (fromIntegral <$> v)
                 return $ Done ctx { stack = val : rest }
         step ctx (ElemDrop elemIdx) = do
diff --git a/src/Language/Wasm/Parser.y b/src/Language/Wasm/Parser.y
index a06baf2..0003310 100644
--- a/src/Language/Wasm/Parser.y
+++ b/src/Language/Wasm/Parser.y
@@ -482,6 +482,8 @@ plaininstr :: { PlainInstr }
     | 'table.get' index              { TableGet $2 }
     | 'table.set' index              { TableSet $2 }
     | 'table.copy' index index       { TableCopy $2 $3 }
+    | 'table.size' index             { TableSize $2 }
+    | 'table.grow' index             { TableGrow $2 }
     | 'elem.drop' index              { ElemDrop $2 }
     -- numeric instructions
     | 'i32.const' int32              { I32Const $2 }
@@ -1729,6 +1731,14 @@ desugarize fields = do
                         Just toIdx -> return $ S.TableCopy toIdx fromIdx
                         Nothing -> Left "unknown table"
                 Nothing -> Left "unknown table"
+        synInstrToStruct FunCtx { ctxMod } (PlainInstr (TableSize tableIdx)) =
+            case getTableIndex ctxMod tableIdx of
+                Just tableIdx -> return $ S.TableSize tableIdx
+                Nothing -> Left "unknown table"
+        synInstrToStruct FunCtx { ctxMod } (PlainInstr (TableGrow tableIdx)) =
+            case getTableIndex ctxMod tableIdx of
+                Just tableIdx -> return $ S.TableGrow tableIdx
+                Nothing -> Left "unknown table"
         synInstrToStruct FunCtx { ctxMod } (PlainInstr (TableSet tableIdx)) =
             case getTableIndex ctxMod tableIdx of
                 Just tableIdx -> return $ S.TableSet tableIdx
diff --git a/src/Language/Wasm/Script.hs b/src/Language/Wasm/Script.hs
index fb895a5..7872005 100644
--- a/src/Language/Wasm/Script.hs
+++ b/src/Language/Wasm/Script.hs
@@ -193,7 +193,8 @@ runScript onAssertFail script = do
         getFailureString Validate.GlobalIsImmutable = ["global is immutable"]
         getFailureString Validate.InvalidStartFunctionType = ["start function"]
         getFailureString Validate.InvalidTableType = ["size minimum must not be greater than maximum"]
-        getFailureString r = [TL.concat ["not implemented ", (TL.pack $ show r)]]
+        getFailureString (Validate.ElemIndexOutOfRange idx) = ["unknown elem segment " <> TL.pack (show idx)]
+        getFailureString r = [TL.concat ["not implemented ", TL.pack $ show r]]
 
         printFailedAssert :: String -> Assertion -> AssertM ()
         printFailedAssert msg assert = do
diff --git a/src/Language/Wasm/Validate.hs b/src/Language/Wasm/Validate.hs
index 6eb9091..c8f068b 100644
--- a/src/Language/Wasm/Validate.hs
+++ b/src/Language/Wasm/Validate.hs
@@ -388,6 +388,15 @@ getInstrType (TableCopy toIdx fromIdx) = do
     let TableType _ toType = tables !! to
     when (fromType /= toType) $ throwError (RefTypeMismatch fromType toType)
     return $ [I32, I32, I32] ==> empty
+getInstrType (TableSize tableIdx) = do
+    Ctx { tables } <- ask
+    when (length tables <= fromIntegral tableIdx) $ throwError (TableIndexOutOfRange tableIdx)
+    return $ empty ==> I32
+getInstrType (TableGrow tableIdx) = do
+    Ctx { tables } <- ask
+    when (length tables <= fromIntegral tableIdx) $ throwError (TableIndexOutOfRange tableIdx)
+    let TableType _ tableType = tables !! fromIntegral tableIdx
+    return $ [elemTypeToRefType tableType, I32] ==> I32
 getInstrType (TableGet tableIdx) = do
     Ctx { tables } <- ask
     when (length tables <= fromIntegral tableIdx) $ throwError (TableIndexOutOfRange tableIdx)
diff --git a/tests/Test.hs b/tests/Test.hs
index b38edad..afdd538 100644
--- a/tests/Test.hs
+++ b/tests/Test.hs
@@ -19,7 +19,7 @@ main = do
   files <-
     filter (not . List.isPrefixOf "simd") . filter (List.isSuffixOf ".wast")
       <$> Directory.listDirectory "tests/spec"
-  let files = ["table_init.wast"]
+  let files = ["table_copy.wast"]
   scriptTestCases <- (`mapM` files) $ \file -> do
     test <- LBS.readFile ("tests/spec/" ++ file)
     return $ testCase file $ do

From 4e9105717ba27abbada1a20549ffc7ec9fc46917 Mon Sep 17 00:00:00 2001
From: Ilya Rezvov <rezvov.ilya@gmail.com>
Date: Mon, 6 Jun 2022 18:41:22 -0600
Subject: [PATCH 16/28] parse externref elems, but fail on validation

---
 src/Language/Wasm/Parser.y    | 11 ++++++-----
 src/Language/Wasm/Validate.hs |  2 ++
 tests/Test.hs                 |  2 +-
 3 files changed, 9 insertions(+), 6 deletions(-)

diff --git a/src/Language/Wasm/Parser.y b/src/Language/Wasm/Parser.y
index 0003310..9160142 100644
--- a/src/Language/Wasm/Parser.y
+++ b/src/Language/Wasm/Parser.y
@@ -479,11 +479,11 @@ plaininstr :: { PlainInstr }
             Nothing -> TableInit (Index 0) $2
             Just elemIdx -> TableInit $2 elemIdx
     }
-    | 'table.get' index              { TableGet $2 }
-    | 'table.set' index              { TableSet $2 }
-    | 'table.copy' index index       { TableCopy $2 $3 }
-    | 'table.size' index             { TableSize $2 }
-    | 'table.grow' index             { TableGrow $2 }
+    | 'table.get' opt(index)         { TableGet (fromMaybe (Index 0) $2) }
+    | 'table.set' opt(index)         { TableSet (fromMaybe (Index 0) $2) }
+    | 'table.copy' opt(index) opt(index) { TableCopy (fromMaybe (Index 0) $2) (fromMaybe (Index 0) $3) }
+    | 'table.size' opt(index)        { TableSize (fromMaybe (Index 0) $2) }
+    | 'table.grow' opt(index)        { TableGrow (fromMaybe (Index 0) $2) }
     | 'elem.drop' index              { ElemDrop $2 }
     -- numeric instructions
     | 'i32.const' int32              { I32Const $2 }
@@ -977,6 +977,7 @@ elem1_active_offset :: { ([Instruction], ElemType, [[Instruction]]) }
 elemlist :: { (ElemType, [[Instruction]]) }
     : 'func' list(index) { (FuncRef, funcIndexToExpr $2) }
     | 'funcref' list(elemexpr) { (FuncRef, $2) }
+    | 'externref' { (ExternRef, []) }
     | list(index) { (FuncRef, funcIndexToExpr $1) }
 
 elemexpr :: { [Instruction] }
diff --git a/src/Language/Wasm/Validate.hs b/src/Language/Wasm/Validate.hs
index c8f068b..315e6bd 100644
--- a/src/Language/Wasm/Validate.hs
+++ b/src/Language/Wasm/Validate.hs
@@ -615,6 +615,8 @@ elemsShouldBeValid m@Module { elems, functions, tables, imports } =
     where
         isElemValid :: Ctx -> ElemSegment -> ValidationResult
         isElemValid ctx (ElemSegment elemType mode elements) = do
+            unless (elemType == FuncRef)
+                $ throwError $ RefTypeMismatch FuncRef elemType
             forM_ elements $ \elem -> runChecker ctx $ do
                 arr <- getExpressionType elem
                 isConstExpression elem
diff --git a/tests/Test.hs b/tests/Test.hs
index afdd538..eb17f3c 100644
--- a/tests/Test.hs
+++ b/tests/Test.hs
@@ -19,7 +19,7 @@ main = do
   files <-
     filter (not . List.isPrefixOf "simd") . filter (List.isSuffixOf ".wast")
       <$> Directory.listDirectory "tests/spec"
-  let files = ["table_copy.wast"]
+  let files = ["table_get.wast"]
   scriptTestCases <- (`mapM` files) $ \file -> do
     test <- LBS.readFile ("tests/spec/" ++ file)
     return $ testCase file $ do

From 71d332e3dc949b1830ce045d91eabc4f700a00d9 Mon Sep 17 00:00:00 2001
From: Ilya Rezvov <rezvov.ilya@gmail.com>
Date: Mon, 6 Jun 2022 18:44:42 -0600
Subject: [PATCH 17/28] better bounds check for table.get and table.set

---
 src/Language/Wasm/Interpreter.hs | 4 ++--
 tests/Test.hs                    | 2 +-
 2 files changed, 3 insertions(+), 3 deletions(-)

diff --git a/src/Language/Wasm/Interpreter.hs b/src/Language/Wasm/Interpreter.hs
index 7021735..0ffbe24 100644
--- a/src/Language/Wasm/Interpreter.hs
+++ b/src/Language/Wasm/Interpreter.hs
@@ -982,7 +982,7 @@ eval budget store FunctionInstance { funcType, moduleInstance, code = Function {
                     RF fnRef -> fnRef
                     v -> error "Impossible due to validation"
             els <- readIORef items
-            if dst > MVector.length els
+            if dst >= MVector.length els
             then return Trap
             else do
                 MVector.unsafeWrite els dst (fromIntegral <$> val)
@@ -992,7 +992,7 @@ eval budget store FunctionInstance { funcType, moduleInstance, code = Function {
             let TableInstance { t = TableType _ et, items } = tableInstances store ! tableAddr
             let dst = fromIntegral offset
             els <- readIORef items
-            if dst > MVector.length els
+            if dst >= MVector.length els
             then return Trap
             else do
                 v <- MVector.unsafeRead els dst
diff --git a/tests/Test.hs b/tests/Test.hs
index eb17f3c..0c0b193 100644
--- a/tests/Test.hs
+++ b/tests/Test.hs
@@ -19,7 +19,7 @@ main = do
   files <-
     filter (not . List.isPrefixOf "simd") . filter (List.isSuffixOf ".wast")
       <$> Directory.listDirectory "tests/spec"
-  let files = ["table_get.wast"]
+  -- let files = ["table_get.wast"]
   scriptTestCases <- (`mapM` files) $ \file -> do
     test <- LBS.readFile ("tests/spec/" ++ file)
     return $ testCase file $ do

From 43cbfe653f1f2e7972fa47a9c1606459ec45c899 Mon Sep 17 00:00:00 2001
From: Ilya Rezvov <rezvov.ilya@gmail.com>
Date: Mon, 6 Jun 2022 20:34:59 -0600
Subject: [PATCH 18/28] keep track of defined references and store global
 function address for table.set instructions

---
 src/Language/Wasm/Interpreter.hs |  6 ++---
 src/Language/Wasm/Script.hs      |  3 ++-
 src/Language/Wasm/Validate.hs    | 41 ++++++++++++++++++++++++--------
 tests/Test.hs                    |  2 +-
 4 files changed, 37 insertions(+), 15 deletions(-)

diff --git a/src/Language/Wasm/Interpreter.hs b/src/Language/Wasm/Interpreter.hs
index 0ffbe24..497fe01 100644
--- a/src/Language/Wasm/Interpreter.hs
+++ b/src/Language/Wasm/Interpreter.hs
@@ -978,14 +978,14 @@ eval budget store FunctionInstance { funcType, moduleInstance, code = Function {
             let TableInstance { items } = tableInstances store ! tableAddr
             let dst = fromIntegral offset
             let val = case ref of
-                    RE extRef -> extRef
-                    RF fnRef -> fnRef
+                    RE extRef -> fromIntegral <$> extRef
+                    RF fnRef -> (funcaddrs moduleInstance !) . fromIntegral <$> fnRef
                     v -> error "Impossible due to validation"
             els <- readIORef items
             if dst >= MVector.length els
             then return Trap
             else do
-                MVector.unsafeWrite els dst (fromIntegral <$> val)
+                MVector.unsafeWrite els dst val
                 return $ Done ctx { stack = rest }
         step ctx@EvalCtx{ stack = (VI32 offset:rest) } (TableGet tableIdx) = do
             let tableAddr = tableaddrs moduleInstance ! fromIntegral tableIdx
diff --git a/src/Language/Wasm/Script.hs b/src/Language/Wasm/Script.hs
index 7872005..44cc990 100644
--- a/src/Language/Wasm/Script.hs
+++ b/src/Language/Wasm/Script.hs
@@ -180,7 +180,7 @@ runScript onAssertFail script = do
         getFailureString (Validate.LocalIndexOutOfRange idx) = ["unknown local", "unknown local " <> TL.pack (show idx)]
         getFailureString (Validate.MemoryIndexOutOfRange idx) = ["unknown memory", "unknown memory " <> TL.pack (show idx)]
         getFailureString (Validate.TableIndexOutOfRange idx) = ["unknown table", "unknown table " <> TL.pack (show idx)]
-        getFailureString Validate.FunctionIndexOutOfRange = ["unknown function", "unknown function 0"]
+        getFailureString (Validate.FunctionIndexOutOfRange idx) = ["unknown function", "unknown function " <> TL.pack (show idx)]
         getFailureString (Validate.GlobalIndexOutOfRange idx) = ["unknown global", "unknown global " <> TL.pack (show idx)]
         getFailureString Validate.LabelIndexOutOfRange = ["unknown label"]
         getFailureString Validate.TypeIndexOutOfRange = ["unknown type"]
@@ -194,6 +194,7 @@ runScript onAssertFail script = do
         getFailureString Validate.InvalidStartFunctionType = ["start function"]
         getFailureString Validate.InvalidTableType = ["size minimum must not be greater than maximum"]
         getFailureString (Validate.ElemIndexOutOfRange idx) = ["unknown elem segment " <> TL.pack (show idx)]
+        getFailureString (Validate.UndeclaredFunctionRef _) = ["undeclared function reference"]
         getFailureString r = [TL.concat ["not implemented ", TL.pack $ show r]]
 
         printFailedAssert :: String -> Assertion -> AssertM ()
diff --git a/src/Language/Wasm/Validate.hs b/src/Language/Wasm/Validate.hs
index 315e6bd..df54e5d 100644
--- a/src/Language/Wasm/Validate.hs
+++ b/src/Language/Wasm/Validate.hs
@@ -32,7 +32,7 @@ data ValidationError =
     | MemoryLimitExceeded
     | AlignmentOverflow
     | MoreThanOneMemory
-    | FunctionIndexOutOfRange
+    | FunctionIndexOutOfRange Natural
     | TableIndexOutOfRange Natural
     | MemoryIndexOutOfRange Natural
     | LocalIndexOutOfRange Natural
@@ -47,6 +47,7 @@ data ValidationError =
     | InvalidConstantExpr
     | InvalidStartFunctionType
     | GlobalIsImmutable
+    | UndeclaredFunctionRef Natural
     deriving (Show, Eq)
 
 type ValidationResult = Either ValidationError ()
@@ -134,7 +135,8 @@ data Ctx = Ctx {
     locals :: [ValueType],
     labels :: [[ValueType]],
     returns :: [ValueType],
-    importedGlobals :: Natural
+    importedGlobals :: Natural,
+    refs :: Set.Set Natural
 } deriving (Show, Eq)
 
 type Checker = ReaderT Ctx (Except ValidationError)
@@ -250,7 +252,7 @@ getInstrType Return = do
     return $ (Any : (map Val returns)) ==> Any
 getInstrType (Call fun) = do
     Ctx { funcs } <- ask
-    maybeToEither FunctionIndexOutOfRange $ asArrow <$> funcs !? fun
+    maybeToEither (FunctionIndexOutOfRange fun) $ asArrow <$> funcs !? fun
 getInstrType (CallIndirect tableIdx sign) = do
     Ctx { types, tables } <- ask
     if length tables <= fromIntegral tableIdx
@@ -271,10 +273,13 @@ getInstrType RefIsNull = do
     var <- freshVar
     return $ var ==> Val I32
 getInstrType (RefFunc funIdx) = do
-    Ctx { funcs } <- ask
+    Ctx { funcs, refs } <- ask
     if fromIntegral funIdx < length funcs
-    then return $ empty ==> Val Func
-    else throwError FunctionIndexOutOfRange
+    then do
+        unless (Set.member funIdx refs) $
+            throwError $ UndeclaredFunctionRef $ fromIntegral funIdx
+        return $ empty ==> Val Func
+    else throwError $ FunctionIndexOutOfRange $ fromIntegral funIdx
 getInstrType (GetLocal local) = do
     Ctx { locals }  <- ask
     t <- maybeToEither (LocalIndexOutOfRange local) $ locals !? local
@@ -523,7 +528,7 @@ getFuncTypes Module {types, functions, imports} =
         getFuncType _ = Nothing
 
 ctxFromModule :: [ValueType] -> [[ValueType]] -> [ValueType] -> Module -> Ctx
-ctxFromModule locals labels returns m@Module {types, tables, mems, globals, imports, elems} =
+ctxFromModule locals labels returns m@Module {types, tables, mems, globals, imports, elems, exports} =
     let tableImports = catMaybes $ map getTableType imports in
     let memsImports = catMaybes $ map getMemType imports in
     let globalImports = catMaybes $ map getGlobalType imports in
@@ -537,7 +542,10 @@ ctxFromModule locals labels returns m@Module {types, tables, mems, globals, impo
         locals,
         labels,
         returns,
-        importedGlobals = fromIntegral $ length globalImports
+        importedGlobals = fromIntegral $ length globalImports,
+        refs = Set.unions $ map getElemRefs elems
+            ++ map getGlobalRefs globals
+            ++ map getExportRefs exports
     }
     where
         getTableType (Import _ _ (ImportTable tableType)) = Just tableType
@@ -549,6 +557,19 @@ ctxFromModule locals labels returns m@Module {types, tables, mems, globals, impo
         getGlobalType (Import _ _ (ImportGlobal gl)) = Just gl
         getGlobalType _ = Nothing
 
+        getElemRefs ElemSegment{ elemType = FuncRef, elements} =
+            foldl extractRef Set.empty elements
+            where
+                extractRef refs [RefFunc idx] = Set.insert idx refs
+                extractRef refs _ = refs
+        getElemRefs _ = Set.empty
+
+        getGlobalRefs Global {initializer = [RefFunc idx]} = Set.singleton idx
+        getGlobalRefs _ = Set.empty
+
+        getExportRefs Export {desc = ExportFunc idx} = Set.singleton idx
+        getExportRefs _ = Set.empty
+
 isFunctionValid :: Function -> Validator
 isFunctionValid Function {funcType, localTypes = locals, body} mod@Module {types} =
     if fromIntegral funcType < length types
@@ -664,7 +685,7 @@ startShouldBeValid m@Module { start = Just (StartFunction idx) } =
     let i = fromIntegral idx in
     if length types > i
     then if FuncType [] [] == types !! i then return () else Left InvalidStartFunctionType
-    else Left FunctionIndexOutOfRange
+    else Left $ FunctionIndexOutOfRange $ fromIntegral i
 
 exportsShouldBeValid :: Validator
 exportsShouldBeValid Module { exports, imports, functions, mems, tables, globals } =
@@ -677,7 +698,7 @@ exportsShouldBeValid Module { exports, imports, functions, mems, tables, globals
 
         isExportValid :: Export -> ValidationResult
         isExportValid (Export _ (ExportFunc funIdx)) =
-            if fromIntegral funIdx < length funcImports + length functions then return () else Left FunctionIndexOutOfRange
+            if fromIntegral funIdx < length funcImports + length functions then return () else Left (FunctionIndexOutOfRange funIdx)
         isExportValid (Export _ (ExportTable tableIdx)) =
             if fromIntegral tableIdx < length tableImports + length tables then return () else Left (TableIndexOutOfRange tableIdx)
         isExportValid (Export _ (ExportMemory memIdx)) =
diff --git a/tests/Test.hs b/tests/Test.hs
index 0c0b193..45f8ec1 100644
--- a/tests/Test.hs
+++ b/tests/Test.hs
@@ -19,7 +19,7 @@ main = do
   files <-
     filter (not . List.isPrefixOf "simd") . filter (List.isSuffixOf ".wast")
       <$> Directory.listDirectory "tests/spec"
-  -- let files = ["table_get.wast"]
+  -- let files = ["ref_func.wast"]
   scriptTestCases <- (`mapM` files) $ \file -> do
     test <- LBS.readFile ("tests/spec/" ++ file)
     return $ testCase file $ do

From 83fea36c02cfdd8fb7e6f37448fd799c02874e88 Mon Sep 17 00:00:00 2001
From: Ilya Rezvov <rezvov.ilya@gmail.com>
Date: Tue, 7 Jun 2022 19:41:03 -0600
Subject: [PATCH 19/28] implement table.fill

---
 src/Language/Wasm/Interpreter.hs | 17 +++++++++++++++++
 src/Language/Wasm/Parser.y       |  5 +++++
 src/Language/Wasm/Validate.hs    |  5 +++++
 tests/Test.hs                    |  2 +-
 4 files changed, 28 insertions(+), 1 deletion(-)

diff --git a/src/Language/Wasm/Interpreter.hs b/src/Language/Wasm/Interpreter.hs
index 497fe01..c40fee9 100644
--- a/src/Language/Wasm/Interpreter.hs
+++ b/src/Language/Wasm/Interpreter.hs
@@ -948,6 +948,23 @@ eval budget store FunctionInstance { funcType, moduleInstance, code = Function {
                     el <- MVector.unsafeRead fromEls (src + off)
                     MVector.unsafeWrite toEls (dst + off) el
                 return $ Done ctx { stack = rest }
+        step ctx@EvalCtx{ stack = (VI32 n:ref:VI32 i:rest) } (TableFill tableIdx) = do
+            let tableAddr = tableaddrs moduleInstance ! fromIntegral tableIdx
+            let TableInstance { items, t } = tableInstances store ! tableAddr
+            let TableType (Limit _ max) _ = t
+            let inc = fromIntegral n
+            let from = fromIntegral i
+            let val = case ref of
+                    RE extRef -> fromIntegral <$> extRef
+                    RF fnRef -> (funcaddrs moduleInstance !) . fromIntegral <$> fnRef
+                    v -> error "Impossible due to validation"
+            els <- readIORef items
+            if from + inc > MVector.length els
+            then return Trap
+            else do
+                Monad.forM_ [0..inc - 1] $ \off ->
+                    MVector.unsafeWrite els (from + off) val
+                return $ Done ctx { stack = rest }
         step ctx@EvalCtx{ stack } (TableSize tableIdx) = do
             let tableAddr = tableaddrs moduleInstance ! fromIntegral tableIdx
             let TableInstance { items } = tableInstances store ! tableAddr
diff --git a/src/Language/Wasm/Parser.y b/src/Language/Wasm/Parser.y
index 9160142..5112ea0 100644
--- a/src/Language/Wasm/Parser.y
+++ b/src/Language/Wasm/Parser.y
@@ -482,6 +482,7 @@ plaininstr :: { PlainInstr }
     | 'table.get' opt(index)         { TableGet (fromMaybe (Index 0) $2) }
     | 'table.set' opt(index)         { TableSet (fromMaybe (Index 0) $2) }
     | 'table.copy' opt(index) opt(index) { TableCopy (fromMaybe (Index 0) $2) (fromMaybe (Index 0) $3) }
+    | 'table.fill' opt(index)        { TableFill (fromMaybe (Index 0) $2) }
     | 'table.size' opt(index)        { TableSize (fromMaybe (Index 0) $2) }
     | 'table.grow' opt(index)        { TableGrow (fromMaybe (Index 0) $2) }
     | 'elem.drop' index              { ElemDrop $2 }
@@ -1736,6 +1737,10 @@ desugarize fields = do
             case getTableIndex ctxMod tableIdx of
                 Just tableIdx -> return $ S.TableSize tableIdx
                 Nothing -> Left "unknown table"
+        synInstrToStruct FunCtx { ctxMod } (PlainInstr (TableFill tableIdx)) =
+            case getTableIndex ctxMod tableIdx of
+                Just tableIdx -> return $ S.TableFill tableIdx
+                Nothing -> Left "unknown table"
         synInstrToStruct FunCtx { ctxMod } (PlainInstr (TableGrow tableIdx)) =
             case getTableIndex ctxMod tableIdx of
                 Just tableIdx -> return $ S.TableGrow tableIdx
diff --git a/src/Language/Wasm/Validate.hs b/src/Language/Wasm/Validate.hs
index df54e5d..9d031ee 100644
--- a/src/Language/Wasm/Validate.hs
+++ b/src/Language/Wasm/Validate.hs
@@ -393,6 +393,11 @@ getInstrType (TableCopy toIdx fromIdx) = do
     let TableType _ toType = tables !! to
     when (fromType /= toType) $ throwError (RefTypeMismatch fromType toType)
     return $ [I32, I32, I32] ==> empty
+getInstrType (TableFill tableIdx) = do
+    Ctx { tables } <- ask
+    when (length tables <= fromIntegral tableIdx) $ throwError (TableIndexOutOfRange tableIdx)
+    let TableType _ tableType = tables !! fromIntegral tableIdx
+    return $ [I32, elemTypeToRefType tableType, I32] ==> empty
 getInstrType (TableSize tableIdx) = do
     Ctx { tables } <- ask
     when (length tables <= fromIntegral tableIdx) $ throwError (TableIndexOutOfRange tableIdx)
diff --git a/tests/Test.hs b/tests/Test.hs
index 45f8ec1..7d9ba9e 100644
--- a/tests/Test.hs
+++ b/tests/Test.hs
@@ -19,7 +19,7 @@ main = do
   files <-
     filter (not . List.isPrefixOf "simd") . filter (List.isSuffixOf ".wast")
       <$> Directory.listDirectory "tests/spec"
-  -- let files = ["ref_func.wast"]
+  -- let files = ["table_fill.wast"]
   scriptTestCases <- (`mapM` files) $ \file -> do
     test <- LBS.readFile ("tests/spec/" ++ file)
     return $ testCase file $ do

From 32357d68fe58afb4bbf7e73a9c30c1be7a1936d5 Mon Sep 17 00:00:00 2001
From: Ilya Rezvov <rezvov.ilya@gmail.com>
Date: Tue, 7 Jun 2022 20:28:02 -0600
Subject: [PATCH 20/28] forbid special nan values for non-script contexts

---
 src/Language/Wasm/Lexer.x  |  4 ++
 src/Language/Wasm/Parser.y | 98 ++++++++++++++++++++++----------------
 2 files changed, 60 insertions(+), 42 deletions(-)

diff --git a/src/Language/Wasm/Lexer.x b/src/Language/Wasm/Lexer.x
index 3df148b..c3f03d0 100644
--- a/src/Language/Wasm/Lexer.x
+++ b/src/Language/Wasm/Lexer.x
@@ -5,6 +5,8 @@ module Language.Wasm.Lexer (
     Lexeme(..),
     Token(..),
     AlexPosn(..),
+    FloatRep(..),
+    NaN(..),
     scanner,
     asFloat,
     asDouble,
@@ -22,6 +24,8 @@ import Data.List (isPrefixOf)
 import Text.Read (readEither)
 import Data.Bits
 import Numeric (showHex)
+import Control.DeepSeq (NFData)
+import GHC.Generics (Generic)
 
 }
 
diff --git a/src/Language/Wasm/Parser.y b/src/Language/Wasm/Parser.y
index 5112ea0..4c56b96 100644
--- a/src/Language/Wasm/Parser.y
+++ b/src/Language/Wasm/Parser.y
@@ -93,6 +93,8 @@ import Language.Wasm.Lexer (
         ),
         Lexeme(..),
         AlexPosn(..),
+        FloatRep(..),
+        NaN(..),
         asFloat,
         asDouble,
         doubleFromInteger
@@ -407,23 +409,23 @@ int64 :: { Integer }
         else Left ("Int literal value is out of signed int64 boundaries: " ++ show $1)
     }
 
-float32 :: { Float }
+float32 :: { FloatRep }
     : int {%
         let maxInt = 340282356779733623858607532500980858880 in
         if $1 <= maxInt && $1 >= -maxInt
-        then return $ fromIntegral $1
+        then return $ BinRep $ fromIntegral $1
         else Left "constant out of range"
     }
-    | f64 {% asFloat $1 }
+    | f64 { $1 }
 
-float64 :: { Double }
+float64 :: { FloatRep }
     : int {%
         let maxInt = round (maxFinite :: Double) in
         if $1 <= maxInt && $1 >= -maxInt
-        then doubleFromInteger $1
+        then fmap BinRep $ doubleFromInteger $1
         else Left "constant out of range"
     }
-    | f64 {% asDouble $1 }
+    | f64 { $1 }
 
 plaininstr :: { PlainInstr }
     -- control instructions
@@ -1040,11 +1042,15 @@ module1 :: { ModuleDef }
     | 'module' opt(ident) list(modulefield) ')' {% RawModDef $2 `fmap` (desugarize $ concat $3) }
 
 action1 :: { Action }
-    : 'invoke' opt(ident) string list(folded_instr) ')' { Invoke $2 $3 (map (map constInstructionToValue) $4) }
+    : 'invoke' opt(ident) string list(folded_instr) ')' {%
+        fmap (Invoke $2 $3) $ (mapM (mapM constInstructionToValue) $4)
+    }
     | 'get' opt(ident) string ')' { Get $2 $3 }
 
 assertion1 :: { (Maybe AlexPosn, Assertion) }
-    : 'assert_return' '(' action1 list(folded_instr) ')' { ($1, AssertReturn $3 (map (map constInstructionToValue) $4)) }
+    : 'assert_return' '(' action1 list(folded_instr) ')' {%
+        fmap ((\a -> ($1, a)) . AssertReturn $3) $ (mapM (mapM constInstructionToValue) $4)
+    }
     | 'assert_return_canonical_nan' '(' action1 ')' { ($1, AssertReturnCanonicalNaN $3) }
     | 'assert_return_arithmetic_nan' '(' action1 ')' { ($1, AssertReturnArithmeticNaN $3) }
     | 'assert_trap' '(' assertion_trap string ')' { ($1, AssertTrap $3 $4) }
@@ -1160,7 +1166,7 @@ integerToWord64 i
     | i < 0 && i >= -(2 ^ 63) = 0xFFFFFFFFFFFFFFFF - (fromIntegral (abs i)) + 1
     | otherwise = error "I64 is out of bounds."
 
-data FuncType = FuncType { params :: [ParamType], results :: [ValueType] } deriving (Show, Eq, Generic, NFData)
+data FuncType = FuncType { params :: [ParamType], results :: [ValueType] } deriving (Show, Eq)
 
 emptyFuncType :: FuncType
 emptyFuncType = FuncType [] []
@@ -1168,11 +1174,11 @@ emptyFuncType = FuncType [] []
 data ParamType = ParamType {
         ident :: Maybe Ident,
         paramType :: ValueType
-    } deriving (Show, Eq, Generic, NFData)
+    } deriving (Show, Eq)
 
-newtype Ident = Ident TL.Text deriving (Show, Eq, Generic, NFData)
+newtype Ident = Ident TL.Text deriving (Show, Eq)
 
-data Index = Named Ident | Index Natural deriving (Show, Eq, Generic, NFData)
+data Index = Named Ident | Index Natural deriving (Show, Eq)
 
 type LabelIndex = Index
 type FuncIndex = Index
@@ -1245,8 +1251,8 @@ data PlainInstr =
     -- Numeric instructions
     | I32Const Integer
     | I64Const Integer
-    | F32Const Float
-    | F64Const Double
+    | F32Const FloatRep
+    | F64Const FloatRep
     | IUnOp BitSize IUnOp
     | IBinOp BitSize IBinOp
     | I32Eqz
@@ -1268,14 +1274,14 @@ data PlainInstr =
     | F64PromoteF32
     | IReinterpretF BitSize
     | FReinterpretI BitSize
-    deriving (Show, Eq, Generic, NFData)
+    deriving (Show, Eq)
 
-data TypeDef = TypeDef (Maybe Ident) FuncType deriving (Show, Eq, Generic, NFData)
+data TypeDef = TypeDef (Maybe Ident) FuncType deriving (Show, Eq)
 
 data TypeUse =
     IndexedTypeUse TypeIndex (Maybe FuncType)
     | AnonimousTypeUse FuncType
-    deriving (Show, Eq, Generic, NFData)
+    deriving (Show, Eq)
 
 emptyTypeUse = AnonimousTypeUse emptyFuncType
 
@@ -1297,26 +1303,26 @@ data Instruction =
         trueBranch :: [Instruction],
         falseBranch :: [Instruction]
     }
-    deriving (Show, Eq, Generic, NFData)
+    deriving (Show, Eq)
 
 data Import = Import {
         reExportAs :: [TL.Text],
         sourceModule :: TL.Text,
         name :: TL.Text,
         desc :: ImportDesc
-    } deriving (Show, Eq, Generic, NFData)
+    } deriving (Show, Eq)
 
 data ImportDesc =
     ImportFunc (Maybe Ident) TypeUse
     | ImportTable (Maybe Ident) TableType
     | ImportMemory (Maybe Ident) Limit
     | ImportGlobal (Maybe Ident) GlobalType
-    deriving (Show, Eq, Generic, NFData)
+    deriving (Show, Eq)
 
 data LocalType = LocalType {
         ident :: Maybe Ident,
         localType :: ValueType
-    } deriving (Show, Eq, Generic, NFData)
+    } deriving (Show, Eq)
 
 data Function = Function {
         exportFuncAs :: [TL.Text],
@@ -1325,7 +1331,7 @@ data Function = Function {
         locals :: [LocalType],
         body :: [Instruction]
     }
-    deriving (Show, Eq, Generic, NFData)
+    deriving (Show, Eq)
 
 emptyFunction :: Function
 emptyFunction =
@@ -1343,32 +1349,32 @@ data Global = Global {
         globalType :: GlobalType,
         initializer :: [Instruction]
     }
-    deriving (Show, Eq, Generic, NFData)
+    deriving (Show, Eq)
 
-data Memory = Memory [TL.Text] (Maybe Ident) Limit deriving (Show, Eq, Generic, NFData)
+data Memory = Memory [TL.Text] (Maybe Ident) Limit deriving (Show, Eq)
 
-data Table = Table [TL.Text] (Maybe Ident) TableType deriving (Show, Eq, Generic, NFData)
+data Table = Table [TL.Text] (Maybe Ident) TableType deriving (Show, Eq)
 
 data ExportDesc =
     ExportFunc FuncIndex
     | ExportTable TableIndex
     | ExportMemory MemoryIndex
     | ExportGlobal GlobalIndex
-    deriving (Show, Eq, Generic, NFData)
+    deriving (Show, Eq)
 
 data Export = Export {
         name :: TL.Text,
         desc :: ExportDesc
     }
-    deriving (Show, Eq, Generic, NFData)
+    deriving (Show, Eq)
 
-data StartFunction = StartFunction FuncIndex deriving (Show, Eq, Generic, NFData)
+data StartFunction = StartFunction FuncIndex deriving (Show, Eq)
 
 data ElemMode
     = Passive
     | Active TableIndex [Instruction]
     | Declarative
-    deriving (Show, Eq, Generic, NFData)
+    deriving (Show, Eq)
 
 data ElemSegment = ElemSegment {
         ident :: Maybe Ident,
@@ -1376,14 +1382,14 @@ data ElemSegment = ElemSegment {
         mode :: ElemMode,
         elements :: [[Instruction]]
     }
-    deriving (Show, Eq, Generic, NFData)
+    deriving (Show, Eq)
 
 data DataSegment = DataSegment {
         memIndex :: MemoryIndex,
         offset :: [Instruction],
         datastring :: LBS.ByteString
     }
-    deriving (Show, Eq, Generic, NFData)
+    deriving (Show, Eq)
 
 data ModuleField =
     MFType TypeDef
@@ -1396,7 +1402,7 @@ data ModuleField =
     | MFStart StartFunction
     | MFElem ElemSegment
     | MFData DataSegment
-    deriving(Show, Eq, Generic, NFData)
+    deriving(Show, Eq)
 
 happyError (Lexeme _ EOF : []) = Left $ "Error occuried during parsing phase at the end of file"
 happyError (Lexeme Nothing tok : tokens) = Left $ "Error occuried during parsing phase at the end of file"
@@ -1469,14 +1475,14 @@ data FunCtx = FunCtx {
     ctxParams :: [ParamType]
 } deriving (Eq, Show)
 
-constInstructionToValue :: Instruction -> S.Instruction Natural
-constInstructionToValue (PlainInstr (I32Const v)) = S.I32Const $ integerToWord32 v
-constInstructionToValue (PlainInstr (F32Const v)) = S.F32Const v
-constInstructionToValue (PlainInstr (I64Const v)) = S.I64Const $ integerToWord64 v
-constInstructionToValue (PlainInstr (F64Const v)) = S.F64Const v
-constInstructionToValue (PlainInstr (RefNull et)) = S.RefNull et
-constInstructionToValue (PlainInstr (RefExtern n)) = S.RefExtern n
-constInstructionToValue _ = error "Only const instructions supported as arguments for actions"
+constInstructionToValue :: Instruction -> Either String (S.Instruction Natural)
+constInstructionToValue (PlainInstr (I32Const v)) = return $ S.I32Const $ integerToWord32 v
+constInstructionToValue (PlainInstr (F32Const v)) = S.F32Const <$> asFloat v
+constInstructionToValue (PlainInstr (I64Const v)) = return $ S.I64Const $ integerToWord64 v
+constInstructionToValue (PlainInstr (F64Const v)) = S.F64Const <$> asDouble v
+constInstructionToValue (PlainInstr (RefNull et)) = return $ S.RefNull et
+constInstructionToValue (PlainInstr (RefExtern n)) = return $ S.RefExtern n
+constInstructionToValue _ = Left "Only const instructions supported as arguments for actions"
 
 funcIndexToExpr :: [FuncIndex] -> [[Instruction]]
 funcIndexToExpr = map $ (:[]) . PlainInstr . RefFunc
@@ -1759,8 +1765,16 @@ desugarize fields = do
                 Nothing -> Left "unknown elem"
         synInstrToStruct _ (PlainInstr (I32Const val)) = return $ S.I32Const $ integerToWord32 val
         synInstrToStruct _ (PlainInstr (I64Const val)) = return $ S.I64Const $ integerToWord64 val
-        synInstrToStruct _ (PlainInstr (F32Const val)) = return $ S.F32Const val
-        synInstrToStruct _ (PlainInstr (F64Const val)) = return $ S.F64Const val
+        synInstrToStruct _ (PlainInstr (F32Const (NanRep Arithmetic))) =
+            Left "arithmetic nan constant allowed only in script"
+        synInstrToStruct _ (PlainInstr (F32Const (NanRep Canonical))) =
+            Left "canonical nan constant allowed only in script"
+        synInstrToStruct _ (PlainInstr (F32Const rep)) = S.F32Const <$> asFloat rep
+        synInstrToStruct _ (PlainInstr (F64Const (NanRep Arithmetic))) =
+            Left "arithmetic nan constant allowed only in script"
+        synInstrToStruct _ (PlainInstr (F64Const (NanRep Canonical))) =
+            Left "canonical nan constant allowed only in script"
+        synInstrToStruct _ (PlainInstr (F64Const rep)) = S.F64Const <$> asDouble rep
         synInstrToStruct _ (PlainInstr (IUnOp sz op)) = return $ S.IUnOp sz op
         synInstrToStruct _ (PlainInstr (IBinOp sz op)) = return $ S.IBinOp sz op
         synInstrToStruct _ (PlainInstr I32Eqz) = return $ S.I32Eqz

From c743e11ffd621c871ab98068fee4d08f21f42d14 Mon Sep 17 00:00:00 2001
From: Ilya Rezvov <rezvov.ilya@gmail.com>
Date: Wed, 8 Jun 2022 21:12:00 -0600
Subject: [PATCH 21/28] add return type for select

---
 src/Language/Wasm/Binary.hs      |  4 ++--
 src/Language/Wasm/Builder.hs     |  2 +-
 src/Language/Wasm/Interpreter.hs |  2 +-
 src/Language/Wasm/Parser.y       | 25 ++++++++++++++++++++---
 src/Language/Wasm/Structure.hs   |  2 +-
 src/Language/Wasm/Validate.hs    | 34 ++++++++++++++++++++++++++++++--
 tests/Test.hs                    |  2 +-
 7 files changed, 60 insertions(+), 11 deletions(-)

diff --git a/src/Language/Wasm/Binary.hs b/src/Language/Wasm/Binary.hs
index 96d774d..83a6854 100644
--- a/src/Language/Wasm/Binary.hs
+++ b/src/Language/Wasm/Binary.hs
@@ -368,7 +368,7 @@ instance Serialize (Instruction Natural) where
     put (CallIndirect tableIdx typeIdx) = putWord8 0x11 >> putULEB128 typeIdx >> putULEB128 tableIdx
     -- Parametric instructions
     put Drop = putWord8 0x1A
-    put Select = putWord8 0x1B
+    put (Select _) = putWord8 0x1B
     -- Variable instructions
     put (GetLocal idx) = putWord8 0x20 >> putULEB128 idx
     put (SetLocal idx) = putWord8 0x21 >> putULEB128 idx
@@ -569,7 +569,7 @@ instance Serialize (Instruction Natural) where
                 return $ CallIndirect tableIdx typeIdx
             -- Parametric instructions
             0x1A -> return $ Drop
-            0x1B -> return $ Select
+            0x1B -> return $ Select Nothing
             -- Variable instructions
             0x20 -> GetLocal <$> getULEB128 32
             0x21 -> SetLocal <$> getULEB128 32
diff --git a/src/Language/Wasm/Builder.hs b/src/Language/Wasm/Builder.hs
index 053f6e9..31d959b 100644
--- a/src/Language/Wasm/Builder.hs
+++ b/src/Language/Wasm/Builder.hs
@@ -197,7 +197,7 @@ select pred a b = select' (produce pred) (produce a) (produce b)
             a
             res <- b
             pred
-            appendExpr [Select]
+            appendExpr [Select Nothing]
             return res
 
 iBinOp :: (Producer a, Producer b, OutType a ~ OutType b, IsInt (OutType a) ~ True) => IBinOp -> a -> b -> GenFun (OutType a)
diff --git a/src/Language/Wasm/Interpreter.hs b/src/Language/Wasm/Interpreter.hs
index c40fee9..9ce065b 100644
--- a/src/Language/Wasm/Interpreter.hs
+++ b/src/Language/Wasm/Interpreter.hs
@@ -804,7 +804,7 @@ eval budget store FunctionInstance { funcType, moduleInstance, code = Function {
         step ctx@EvalCtx{ stack = st } (RefFunc index) =
             return $ Done ctx { stack = RF (Just index) : st }
         step ctx@EvalCtx{ stack = (_:rest) } Drop = return $ Done ctx { stack = rest }
-        step ctx@EvalCtx{ stack = (VI32 test:val2:val1:rest) } Select =
+        step ctx@EvalCtx{ stack = (VI32 test:val2:val1:rest) } (Select _) =
             if test == 0
             then return $ Done ctx { stack = val2 : rest }
             else return $ Done ctx { stack = val1 : rest }
diff --git a/src/Language/Wasm/Parser.y b/src/Language/Wasm/Parser.y
index 4c56b96..a24e2f3 100644
--- a/src/Language/Wasm/Parser.y
+++ b/src/Language/Wasm/Parser.y
@@ -437,7 +437,6 @@ plaininstr :: { PlainInstr }
     | 'return'                       { Return }
     | 'call' index                   { Call $2 }
     | 'drop'                         { Drop }
-    | 'select'                       { Select }
     -- reference instructions
     | 'ref.null' heaptype            { RefNull $2 }
     | 'ref.is_null'                  { RefIsNull }
@@ -695,6 +694,20 @@ memarg4 :: { MemArg }
 memarg8 :: { MemArg }
     : opt(offset) opt(align) {% parseMemArg 8 $1 $2 }
 
+select_type_or_instructions(terminator)
+    : terminator { ($1, Nothing, []) }
+    | '(' select_type_or_instructions1(terminator) { $2 }
+
+select_type_or_instructions1(terminator) 
+    : 'result' list(valtype) ')' mixed_instruction_list(terminator) {
+        let (end, instr) = $4 in
+        (end, Just $2, instr)
+    }
+    | folded_instr_list(terminator) {
+        let (end, instr) = $1 in
+        (end, Nothing, instr)
+    }
+
 instruction_list(terminator)
     : terminator { ($1, []) }
     | plaininstr mixed_instruction_list(terminator) { ([PlainInstr $1] ++) `fmap` $2 }
@@ -703,6 +716,9 @@ instruction_list(terminator)
         let (tu, instr, end) = $3 in
         onlyAnonimParams tu >> (return (end, [PlainInstr $ CallIndirect tableIdx tu] ++ instr))
     }
+    | 'select' select_type_or_instructions(terminator) {
+        let (end, t, instr) = $2 in (end, [PlainInstr $ Select t] ++ instr)
+    }
     | 'block' opt(ident) typeuse('end') opt(ident) mixed_instruction_list(terminator) {% do
         let (tu, instr, _) = $3 
         matchIdents $2 $4
@@ -744,6 +760,9 @@ folded_instr1 :: { [Instruction] }
         let (tu, instr, _) = $3 in
         onlyAnonimParams tu >> (return $ instr ++ [PlainInstr $ CallIndirect tableIdx tu])
     }
+    | 'select' select_type_or_instructions(')') {
+        let (_, t, instr) = $2 in instr ++ [PlainInstr $ Select t]
+    }
     | 'block' opt(ident) typeuse(')') {%
         let (typeUse, instr, _) = $3 in
         onlyAnonimParams typeUse >> (return [BlockInstr $2 typeUse instr])
@@ -1206,7 +1225,7 @@ data PlainInstr =
     | RefExtern Natural
     -- Parametric instructions
     | Drop
-    | Select
+    | Select (Maybe [ValueType])
     -- Variable instructions
     | GetLocal LocalIndex
     | SetLocal LocalIndex
@@ -1671,7 +1690,7 @@ desugarize fields = do
                         Nothing -> Left "unknown type"
                 Nothing -> Left "unknown table"
         synInstrToStruct _ (PlainInstr Drop) = return $ S.Drop
-        synInstrToStruct _ (PlainInstr Select) = return $ S.Select
+        synInstrToStruct _ (PlainInstr (Select vt)) = return $ S.Select vt
         synInstrToStruct _ (PlainInstr (RefNull elType)) = return $ S.RefNull elType
         synInstrToStruct _ (PlainInstr RefIsNull) = return $ S.RefIsNull
         synInstrToStruct FunCtx { ctxMod } (PlainInstr (RefFunc funIdx)) =
diff --git a/src/Language/Wasm/Structure.hs b/src/Language/Wasm/Structure.hs
index 3cbef07..e1c812e 100644
--- a/src/Language/Wasm/Structure.hs
+++ b/src/Language/Wasm/Structure.hs
@@ -145,7 +145,7 @@ data Instruction index =
     | RefExtern Natural
     -- Parametric instructions
     | Drop
-    | Select
+    | Select (Maybe [ValueType])
     -- Variable instructions
     | GetLocal index
     | SetLocal index
diff --git a/src/Language/Wasm/Validate.hs b/src/Language/Wasm/Validate.hs
index 9d031ee..0dec6d3 100644
--- a/src/Language/Wasm/Validate.hs
+++ b/src/Language/Wasm/Validate.hs
@@ -71,6 +71,7 @@ type Validator = Module -> ValidationResult
 data VType =
     Val ValueType
     | Var
+    | NonRefVar
     | Any
     deriving (Show, Eq)
 
@@ -105,6 +106,11 @@ asArrow (FuncType params results) = Arrow (map Val params) (map Val $ reverse re
 isArrowMatch :: Arrow -> Arrow -> Bool
 isArrowMatch (f `Arrow` t) ( f' `Arrow` t') = isEndMatch f f' && isEndMatch t t'
     where
+        isRef :: VType -> Bool
+        isRef (Val Func) = True
+        isRef (Val Extern) = True
+        isRef _            = False
+
         isEndMatch :: End -> End -> Bool
         isEndMatch (Any:l) (Any:r) =
             let (leftTail, rightTail) = unzip $ zip (takeWhile (/= Any) $ reverse l) (takeWhile (/= Any) $ reverse r) in
@@ -121,6 +127,12 @@ isArrowMatch (f `Arrow` t) ( f' `Arrow` t') = isEndMatch f f' && isEndMatch t t'
         isEndMatch (x:l) (Var:r) =
             let subst = replace Var x in
             isEndMatch (subst l) (subst r)
+        isEndMatch (NonRefVar:l) (x:r) =
+            let subst = replace NonRefVar x in
+            isEndMatch (subst l) (subst r)
+        isEndMatch (x:l) (NonRefVar:r) =
+            let subst = replace NonRefVar x in
+            isEndMatch (subst l) (subst r)
         isEndMatch (Val v:l) (Val v':r) = v == v' && isEndMatch l r
         isEndMatch [] [] = True
         isEndMatch _ _ = False
@@ -263,9 +275,13 @@ getInstrType (CallIndirect tableIdx sign) = do
 getInstrType Drop = do
     var <- freshVar
     return $ var ==> empty
-getInstrType Select = do
-    var <- freshVar
+getInstrType (Select Nothing) = do
+    var <- return NonRefVar
     return $ [var, var, Val I32] ==> var
+getInstrType (Select (Just vt)) =
+    case vt of
+        [t] -> return $ [t, t, I32] ==> t
+        _ -> throwError InvalidResultArity
 getInstrType (RefNull elType) = do
     let t = case elType of { FuncRef -> Func; ExternRef -> Extern }
     return $ empty ==> Val t
@@ -486,6 +502,10 @@ getExpressionTypeWithInput inp = fmap (inp `Arrow`) . foldM go inp
             (f `Arrow` t) <- getInstrType instr
             matchStack stack (reverse f) t
         
+        isRef (Func)   = True
+        isRef (Extern) = True
+        isRef _        = False
+        
         matchStack :: [VType] -> [VType] -> [VType] -> Checker [VType]
         matchStack stack@(Any:_) _arg res = return $ res ++ stack
         matchStack (Val v:stack) (Val v':args) res =
@@ -499,6 +519,16 @@ getExpressionTypeWithInput inp = fmap (inp `Arrow`) . foldM go inp
         matchStack (Var:stack) (Val v:args) res =
             let subst = replace Var (Val v) in
             matchStack stack (subst args) (subst res)
+        matchStack (Val v:stack) (NonRefVar:args) res =
+            let subst = replace NonRefVar (Val v) in
+            if isRef v
+            then throwError $ TypeMismatch (empty ==> empty) (empty ==> empty)
+            else matchStack stack (subst args) (subst res)
+        matchStack (NonRefVar:stack) (Val v:args) res =
+            let subst = replace NonRefVar (Val v) in
+            if isRef v
+            then throwError $ TypeMismatch (empty ==> empty) (empty ==> empty)
+            else matchStack stack (subst args) (subst res)
         matchStack stack [] res = return $ res ++ stack
         matchStack [] args res = throwError $ TypeMismatch ((reverse args) `Arrow` res) ([] `Arrow` [])
         matchStack _ _ _ = error "inconsistent checker state"
diff --git a/tests/Test.hs b/tests/Test.hs
index 7d9ba9e..7392cab 100644
--- a/tests/Test.hs
+++ b/tests/Test.hs
@@ -19,7 +19,7 @@ main = do
   files <-
     filter (not . List.isPrefixOf "simd") . filter (List.isSuffixOf ".wast")
       <$> Directory.listDirectory "tests/spec"
-  -- let files = ["table_fill.wast"]
+  -- let files = ["select.wast"]
   scriptTestCases <- (`mapM` files) $ \file -> do
     test <- LBS.readFile ("tests/spec/" ++ file)
     return $ testCase file $ do

From 32392dcc29ef3fef3a0e363d3c04d44f3082c881 Mon Sep 17 00:00:00 2001
From: Ilya Rezvov <rezvov.ilya@gmail.com>
Date: Thu, 9 Jun 2022 20:21:57 -0600
Subject: [PATCH 22/28] add syntax support for extended data segments

---
 src/Language/Wasm/Binary.hs      |  4 +--
 src/Language/Wasm/Builder.hs     |  2 +-
 src/Language/Wasm/Interpreter.hs |  4 ++-
 src/Language/Wasm/Parser.y       | 51 ++++++++++++++++++++++----------
 src/Language/Wasm/Structure.hs   | 10 +++++--
 src/Language/Wasm/Validate.hs    |  2 +-
 tests/Test.hs                    |  2 +-
 7 files changed, 52 insertions(+), 23 deletions(-)

diff --git a/src/Language/Wasm/Binary.hs b/src/Language/Wasm/Binary.hs
index 83a6854..86a07a3 100644
--- a/src/Language/Wasm/Binary.hs
+++ b/src/Language/Wasm/Binary.hs
@@ -881,7 +881,7 @@ instance Serialize Function where
         return $ Function 0 locals body
 
 instance Serialize DataSegment where
-    put (DataSegment memIdx offset init) = do
+    put (DataSegment (ActiveData memIdx offset) init) = do
         putULEB128 memIdx
         putExpression offset
         putULEB128 $ LBS.length init
@@ -891,7 +891,7 @@ instance Serialize DataSegment where
         offset <- getExpression
         len <- getULEB128 32
         init <- getLazyByteString len
-        return $ DataSegment memIdx offset init
+        return $ DataSegment (ActiveData memIdx offset) init
 
 instance Serialize Module where
     put mod = do
diff --git a/src/Language/Wasm/Builder.hs b/src/Language/Wasm/Builder.hs
index 31d959b..476e768 100644
--- a/src/Language/Wasm/Builder.hs
+++ b/src/Language/Wasm/Builder.hs
@@ -975,7 +975,7 @@ table min max = do
 dataSegment :: (Producer offset, OutType offset ~ Proxy I32) => offset -> LBS.ByteString -> GenMod ()
 dataSegment offset bytes =
     modify $ \(st@GenModState { target = m }) -> st {
-        target = m { datas = datas m ++ [DataSegment 0 (genExpr 0 (produce offset)) bytes] }
+        target = m { datas = datas m ++ [DataSegment (ActiveData 0 (genExpr 0 (produce offset))) bytes] }
     }
 
 asWord32 :: Int32 -> Word32
diff --git a/src/Language/Wasm/Interpreter.hs b/src/Language/Wasm/Interpreter.hs
index 9ce065b..a4b81fa 100644
--- a/src/Language/Wasm/Interpreter.hs
+++ b/src/Language/Wasm/Interpreter.hs
@@ -571,7 +571,7 @@ initialize inst Module {elems, datas, start} = do
             Monad.forM_ (zip [from..] funcs) $ uncurry $ MVector.unsafeWrite elems
 
         checkData :: DataSegment -> Initialize (Int, MemoryStore, LBS.ByteString)
-        checkData DataSegment {memIndex, offset, chunk} = do
+        checkData DataSegment {dataMode = ActiveData memIndex offset, chunk} = do
             st <- State.get
             VI32 val <- liftIO $ evalConstExpr inst st offset
             let from = fromIntegral val
@@ -582,6 +582,8 @@ initialize inst Module {elems, datas, start} = do
             len <- ByteArray.getSizeofMutableByteArray mem
             Monad.when (last > len) $ throwError "data segment does not fit"
             return (from, mem, chunk)
+        checkData DataSegment {dataMode = ActiveData memIndex offset, chunk} =
+            error "passive data segments are not implemented yet"
         
         initData :: (Int, MemoryStore, LBS.ByteString) -> Initialize ()
         initData (from, mem, chunk) =
diff --git a/src/Language/Wasm/Parser.y b/src/Language/Wasm/Parser.y
index a24e2f3..7452361 100644
--- a/src/Language/Wasm/Parser.y
+++ b/src/Language/Wasm/Parser.y
@@ -898,9 +898,11 @@ memory_limits_export_import1 :: { Maybe Ident -> [ModuleField] }
     | 'data' datastring ')' ')' {
         \ident ->
             let m = fromIntegral $ LBS.length $2 in
+            -- TODO: unhardcode memory index
+            let memIdx = fromMaybe (Index 0) $ Named `fmap` ident in
             [
                 MFMem $ Memory [] ident $ Limit m $ Just m,
-                MFData $ DataSegment (fromMaybe (Index 0) $ Named `fmap` ident) [PlainInstr $ I32Const 0] $2
+                MFData $ DataSegment Nothing (ActiveData memIdx [PlainInstr $ I32Const 0]) $2
             ]
     }
 
@@ -933,6 +935,7 @@ limits_elemtype_elem :: { Maybe Ident -> [ModuleField] }
         \ident ->
             let funcsLen = fromIntegral $ length $4 in [
                 MFTable $ Table [] ident $ TableType (Limit funcsLen (Just funcsLen)) $1,
+                -- TODO: unhardcode table index
                 let tableIndex = (fromMaybe (Index 0) $ Named `fmap` ident) in
                 let offset = [PlainInstr $ I32Const 0] in
                 let elements = $4 in
@@ -972,10 +975,6 @@ export :: { Export }
 start :: { StartFunction }
     : 'start' index ')' { StartFunction $2 }
 
-offsetexpr :: { [Instruction] }
-    : 'offset' mixed_instruction_list(')') { snd $2 }
-    | folded_instr1 { $1 }
-
 elem :: { ElemSegment }
     : 'elem' opt(ident) elem1 { $3{ ident = $2 } }
 
@@ -1007,8 +1006,20 @@ elemexpr :: { [Instruction] }
     | '(' 'item' mixed_instruction_list(')') { snd $3 }
     | '(' folded_instr1 { $2 }
 
+offsetexpr1 :: { [Instruction] }
+    : 'offset' mixed_instruction_list(')') { snd $2 }
+    | folded_instr1 { $1 }
+
+memory_offsetexpr1 :: { (MemoryIndex, [Instruction]) }
+    : offsetexpr1 { (Index 0, $1)}
+    | 'memory' index ')' '(' offsetexpr1 { ($2, $5) }
+
+memory_mode :: { DataMode }
+    : '(' memory_offsetexpr1 { uncurry ActiveData $2 }
+    | {- empty -} { PassiveData }
+
 datasegment :: { DataSegment }
-    : 'data' opt(index) '(' offsetexpr datastring ')' { DataSegment (fromMaybe (Index 0) $2) $4 $5 }
+    : 'data' opt(ident) memory_mode datastring ')' { DataSegment $2 $3 $4 }
 
 modulefield1_single :: { ModuleField }
     : typedef { MFType $1 }
@@ -1207,6 +1218,7 @@ type GlobalIndex = Index
 type TableIndex = Index
 type MemoryIndex = Index
 type ElemIndex = Index
+type DataIndex = Index
 
 data PlainInstr =
     -- Control instructions
@@ -1403,9 +1415,14 @@ data ElemSegment = ElemSegment {
     }
     deriving (Show, Eq)
 
+data DataMode =
+    PassiveData
+    | ActiveData MemoryIndex [Instruction]
+    deriving (Show, Eq)
+
 data DataSegment = DataSegment {
-        memIndex :: MemoryIndex,
-        offset :: [Instruction],
+        ident :: Maybe Ident,
+        dataMode :: DataMode,
         datastring :: LBS.ByteString
     }
     deriving (Show, Eq)
@@ -1591,8 +1608,6 @@ desugarize fields = do
             extractTypeDefFromInstructions (matchTypeUse defs funcType) body
         extractTypeDef defs (MFGlobal Global { initializer }) =
             extractTypeDefFromInstructions defs initializer
-        extractTypeDef defs (MFData DataSegment { offset }) =
-            extractTypeDefFromInstructions defs offset
         extractTypeDef defs _ = defs
 
         extractTypeDefFromInstructions :: [TypeDef] -> [Instruction] -> [TypeDef]
@@ -2089,11 +2104,17 @@ desugarize fields = do
 
         -- data segment
         synDataToStruct :: Module -> DataSegment -> Either String S.DataSegment
-        synDataToStruct mod DataSegment { memIndex, offset, datastring } =
-            let ctx = FunCtx mod [] [] [] in
-            let offsetInstrs = mapM (synInstrToStruct ctx) offset in
-            let idx = fromJust $ getMemIndex mod memIndex in
-            S.DataSegment idx <$> offsetInstrs <*> return datastring
+        synDataToStruct mod DataSegment { dataMode, datastring } = do
+            m <- case dataMode of
+                PassiveData -> return S.PassiveData
+                ActiveData memIndex offset -> do
+                    let ctx = FunCtx mod [] [] []
+                    offsetInstrs <- mapM (synInstrToStruct ctx) offset
+                    idx <- case getMemIndex mod memIndex of
+                        Just idx -> return idx
+                        Nothing -> throwError "unknown memory"
+                    return $ S.ActiveData idx offsetInstrs
+            return $ S.DataSegment m datastring
 
         extractDataSegment :: [DataSegment] -> ModuleField -> [DataSegment]
         extractDataSegment datas (MFData dataSegment) = dataSegment : datas
diff --git a/src/Language/Wasm/Structure.hs b/src/Language/Wasm/Structure.hs
index e1c812e..3468a37 100644
--- a/src/Language/Wasm/Structure.hs
+++ b/src/Language/Wasm/Structure.hs
@@ -4,6 +4,7 @@
 
 module Language.Wasm.Structure (
     Module(..),
+    DataMode(..),
     DataSegment(..),
     ElemSegment(..),
     ElemMode(..),
@@ -103,6 +104,7 @@ type LocalIndex = Natural
 type GlobalIndex = Natural
 type MemoryIndex = Natural
 type TableIndex = Natural
+type DataIndex = Natural
 type ElemIndex = Natural
 
 data ValueType =
@@ -252,9 +254,13 @@ data ElemSegment = ElemSegment {
     elements :: [Expression]
 } deriving (Show, Eq, Generic, NFData)
 
+data DataMode =
+    PassiveData
+    | ActiveData MemoryIndex Expression
+    deriving (Show, Eq, Generic, NFData)
+
 data DataSegment = DataSegment {
-    memIndex :: MemoryIndex,
-    offset :: Expression,
+    dataMode :: DataMode,
     chunk :: LBS.ByteString
 } deriving (Show, Eq, Generic, NFData)
 
diff --git a/src/Language/Wasm/Validate.hs b/src/Language/Wasm/Validate.hs
index 0dec6d3..0e7b215 100644
--- a/src/Language/Wasm/Validate.hs
+++ b/src/Language/Wasm/Validate.hs
@@ -700,7 +700,7 @@ datasShouldBeValid m@Module { datas, mems, imports } =
     foldMap (isDataValid ctx) datas
     where
         isDataValid :: Ctx -> DataSegment -> ValidationResult
-        isDataValid ctx (DataSegment memIdx offset _) =
+        isDataValid ctx (DataSegment (ActiveData memIdx offset) _) =
             let check = runChecker ctx $ do
                     isConstExpression offset
                     t <- getExpressionType offset
diff --git a/tests/Test.hs b/tests/Test.hs
index 7392cab..1879bc9 100644
--- a/tests/Test.hs
+++ b/tests/Test.hs
@@ -19,7 +19,7 @@ main = do
   files <-
     filter (not . List.isPrefixOf "simd") . filter (List.isSuffixOf ".wast")
       <$> Directory.listDirectory "tests/spec"
-  -- let files = ["select.wast"]
+  let files = ["data.wast"]
   scriptTestCases <- (`mapM` files) $ \file -> do
     test <- LBS.readFile ("tests/spec/" ++ file)
     return $ testCase file $ do

From 2bf6e8807299441739ceec89269938d0a0ca5ebb Mon Sep 17 00:00:00 2001
From: Ilya Rezvov <rezvov.ilya@gmail.com>
Date: Fri, 10 Jun 2022 22:29:31 -0600
Subject: [PATCH 23/28] parse memory instructions

---
 src/Language/Wasm/Binary.hs      |  8 +++---
 src/Language/Wasm/Builder.hs     |  4 +--
 src/Language/Wasm/Interpreter.hs | 33 ++++++++++++++----------
 src/Language/Wasm/Parser.y       | 43 +++++++++++++++++++++++++++-----
 src/Language/Wasm/Structure.hs   |  8 ++++--
 src/Language/Wasm/Validate.hs    |  5 ++--
 tests/Test.hs                    |  2 +-
 7 files changed, 73 insertions(+), 30 deletions(-)

diff --git a/src/Language/Wasm/Binary.hs b/src/Language/Wasm/Binary.hs
index 86a07a3..da90919 100644
--- a/src/Language/Wasm/Binary.hs
+++ b/src/Language/Wasm/Binary.hs
@@ -399,8 +399,8 @@ instance Serialize (Instruction Natural) where
     put (I64Store8 memArg) = putWord8 0x3C >> put memArg
     put (I64Store16 memArg) = putWord8 0x3D >> put memArg
     put (I64Store32 memArg) = putWord8 0x3E >> put memArg
-    put CurrentMemory = putWord8 0x3F >> putWord8 0x00
-    put GrowMemory = putWord8 0x40 >> putWord8 0x00
+    put MemorySize = putWord8 0x3F >> putWord8 0x00
+    put MemoryGrow = putWord8 0x40 >> putWord8 0x00
     -- Numeric instructions
     put (I32Const val) = putWord8 0x41 >> putSLEB128 (asInt32 val)
     put (I64Const val) = putWord8 0x42 >> putSLEB128 (asInt64 val)
@@ -600,8 +600,8 @@ instance Serialize (Instruction Natural) where
             0x3C -> I64Store8 <$> get
             0x3D -> I64Store16 <$> get
             0x3E -> I64Store32 <$> get
-            0x3F -> byteGuard 0x00 >> (return $ CurrentMemory)
-            0x40 -> byteGuard 0x00 >> (return $ GrowMemory)
+            0x3F -> byteGuard 0x00 >> (return $ MemorySize)
+            0x40 -> byteGuard 0x00 >> (return $ MemoryGrow)
             -- Numeric instructions
             0x41 -> I32Const <$> getSLEB128 32
             0x42 -> I64Const <$> getSLEB128 64
diff --git a/src/Language/Wasm/Builder.hs b/src/Language/Wasm/Builder.hs
index 476e768..96a8dac 100644
--- a/src/Language/Wasm/Builder.hs
+++ b/src/Language/Wasm/Builder.hs
@@ -643,10 +643,10 @@ store32 addr val offset align = do
     appendExpr [I64Store32 $ MemArg (fromIntegral offset) (fromIntegral align)]
 
 memorySize :: GenFun (Proxy I32)
-memorySize = appendExpr [CurrentMemory] >> return Proxy
+memorySize = appendExpr [MemorySize] >> return Proxy
 
 growMemory :: (Producer size, OutType size ~ Proxy I32) => size -> GenFun ()
-growMemory size = produce size >> appendExpr [GrowMemory]
+growMemory size = produce size >> appendExpr [MemoryGrow]
 
 call :: (Returnable res) => Fn res -> [GenFun a] -> GenFun res
 call (Fn idx) args = sequence_ args >> appendExpr [Call idx] >> return returnableValue
diff --git a/src/Language/Wasm/Interpreter.hs b/src/Language/Wasm/Interpreter.hs
index a4b81fa..2f8654e 100644
--- a/src/Language/Wasm/Interpreter.hs
+++ b/src/Language/Wasm/Interpreter.hs
@@ -229,7 +229,11 @@ isDeclarative :: ElemMode -> Bool
 isDeclarative Declarative = True
 isDeclarative _           = False
 
-data DataInstance = DataInstance
+data DataInstance = DataInstance {
+        dMode :: DataMode,
+        isDropped :: IORef Bool,
+        bytes :: LBS.ByteString
+    }
 
 data Store = Store {
     funcInstances :: Vector FunctionInstance,
@@ -519,8 +523,10 @@ allocElems inst st = fmap Vector.fromList . mapM allocElem
             ElemInstance mode t (Vector.fromList indexes)
                 <$> newIORef False -- is dropped
 
-allocDatas :: ModuleInstance -> Store -> [DataSegment] -> Vector DataInstance
-allocDatas _inst _st = Vector.fromList . map (const DataInstance)
+allocDatas :: [DataSegment] -> IO (Vector DataInstance)
+allocDatas datas = Vector.fromList <$> Monad.forM datas (\DataSegment {dataMode, chunk} -> do
+    isDropped <- newIORef False
+    return $ DataInstance dataMode isDropped chunk)
 
 type Initialize = ExceptT String (State.StateT Store IO)
 
@@ -570,7 +576,7 @@ initialize inst Module {elems, datas, start} = do
             liftIO $ writeIORef isDropped True
             Monad.forM_ (zip [from..] funcs) $ uncurry $ MVector.unsafeWrite elems
 
-        checkData :: DataSegment -> Initialize (Int, MemoryStore, LBS.ByteString)
+        checkData :: DataSegment -> Initialize (Maybe (Int, MemoryStore, LBS.ByteString))
         checkData DataSegment {dataMode = ActiveData memIndex offset, chunk} = do
             st <- State.get
             VI32 val <- liftIO $ evalConstExpr inst st offset
@@ -580,13 +586,14 @@ initialize inst Module {elems, datas, start} = do
             let MemoryInstance _ memory = memInstances st ! idx
             mem <- liftIO $ readIORef memory
             len <- ByteArray.getSizeofMutableByteArray mem
-            Monad.when (last > len) $ throwError "data segment does not fit"
-            return (from, mem, chunk)
-        checkData DataSegment {dataMode = ActiveData memIndex offset, chunk} =
-            error "passive data segments are not implemented yet"
+            Monad.when (last > len) $ throwError "out of bounds memory access"
+            return $ Just (from, mem, chunk)
+        checkData DataSegment {dataMode = PassiveData, chunk} =
+            return Nothing
         
-        initData :: (Int, MemoryStore, LBS.ByteString) -> Initialize ()
-        initData (from, mem, chunk) =
+        initData :: Maybe (Int, MemoryStore, LBS.ByteString) -> Initialize ()
+        initData Nothing = return ()
+        initData (Just (from, mem, chunk)) =
             mapM_ (\(i,b) -> ByteArray.writeByteArray mem i b) $ zip [from..] $ LBS.unpack chunk
 
 instantiate :: Store -> Imports -> Valid.ValidModule -> IO (Either String ModuleInstance, Store)
@@ -598,7 +605,7 @@ instantiate st imps mod = flip State.runStateT st $ runExceptT $ do
     tables <- (tableInstances st <>) <$> liftIO (allocTables (Struct.tables m))
     mems <- liftIO $ (memInstances st <>) <$> allocMems (Struct.mems m)
     elems <- liftIO $ (elemInstances st <>) <$> allocElems inst st (Struct.elems m)
-    let datas = dataInstances st <> allocDatas inst st (Struct.datas m)
+    datas <- liftIO $ (dataInstances st <>) <$> allocDatas (Struct.datas m)
     State.put $ st {
         funcInstances = functions,
         tableInstances = tables,
@@ -886,12 +893,12 @@ eval budget store FunctionInstance { funcType, moduleInstance, code = Function {
             makeStoreInstr @Word16 ctx { stack = rest } offset 2 $ fromIntegral v
         step ctx@EvalCtx{ stack = (VI64 v:rest) } (I64Store32 MemArg { offset }) =
             makeStoreInstr @Word32 ctx { stack = rest } offset 4 $ fromIntegral v
-        step ctx@EvalCtx{ stack = st } CurrentMemory = do
+        step ctx@EvalCtx{ stack = st } MemorySize = do
             let MemoryInstance { memory = memoryRef } = memInstances store ! (memaddrs moduleInstance ! 0)
             memory <- readIORef memoryRef
             size <- ((`quot` pageSize) . fromIntegral) <$> ByteArray.getSizeofMutableByteArray memory
             return $ Done ctx { stack = VI32 (fromIntegral size) : st }
-        step ctx@EvalCtx{ stack = (VI32 n:rest) } GrowMemory = do
+        step ctx@EvalCtx{ stack = (VI32 n:rest) } MemoryGrow = do
             let MemoryInstance { lim = limit@(Limit _ maxLen), memory = memoryRef } = memInstances store ! (memaddrs moduleInstance ! 0)
             memory <- readIORef memoryRef
             size <- (`quot` pageSize) <$> ByteArray.getSizeofMutableByteArray memory
diff --git a/src/Language/Wasm/Parser.y b/src/Language/Wasm/Parser.y
index 7452361..ff31ac5 100644
--- a/src/Language/Wasm/Parser.y
+++ b/src/Language/Wasm/Parser.y
@@ -168,6 +168,10 @@ import Language.Wasm.Lexer (
 'i64.store32'         { Lexeme _ (TKeyword "i64.store32") }
 'memory.size'         { Lexeme _ (TKeyword "memory.size") }
 'memory.grow'         { Lexeme _ (TKeyword "memory.grow") }
+'memory.fill'         { Lexeme _ (TKeyword "memory.fill") }
+'memory.copy'         { Lexeme _ (TKeyword "memory.copy") }
+'memory.init'         { Lexeme _ (TKeyword "memory.init") }
+'data.drop'           { Lexeme _ (TKeyword "data.drop") }
 'table.init'          { Lexeme _ (TKeyword "table.init") }
 'table.copy'          { Lexeme _ (TKeyword "table.copy") }
 'table.fill'          { Lexeme _ (TKeyword "table.fill") }
@@ -472,8 +476,12 @@ plaininstr :: { PlainInstr }
     | 'i64.store8' memarg1           { I64Store8 $2 }
     | 'i64.store16' memarg2          { I64Store16 $2 }
     | 'i64.store32' memarg4          { I64Store32 $2 }
-    | 'memory.size'                  { CurrentMemory }
-    | 'memory.grow'                  { GrowMemory }
+    | 'memory.size'                  { MemorySize }
+    | 'memory.grow'                  { MemoryGrow }
+    | 'memory.fill'                  { MemoryFill }
+    | 'memory.copy'                  { MemoryCopy }
+    | 'memory.init' index            { MemoryInit $2 }
+    | 'data.drop' index              { DataDrop $2 }
     -- table instructions
     | 'table.init' index opt(index) {
         case $3 of
@@ -1268,8 +1276,12 @@ data PlainInstr =
     | I64Store8 MemArg
     | I64Store16 MemArg
     | I64Store32 MemArg
-    | CurrentMemory
-    | GrowMemory
+    | MemorySize
+    | MemoryGrow
+    | MemoryFill
+    | MemoryCopy
+    | MemoryInit DataIndex
+    | DataDrop DataIndex
     -- Table instructions
     | TableInit TableIndex ElemIndex
     | TableGrow TableIndex
@@ -1757,8 +1769,18 @@ desugarize fields = do
         synInstrToStruct _ (PlainInstr (I64Store8 memArg)) = return $ S.I64Store8 memArg
         synInstrToStruct _ (PlainInstr (I64Store16 memArg)) = return $ S.I64Store16 memArg
         synInstrToStruct _ (PlainInstr (I64Store32 memArg)) = return $ S.I64Store32 memArg
-        synInstrToStruct _ (PlainInstr CurrentMemory) = return $ S.CurrentMemory
-        synInstrToStruct _ (PlainInstr GrowMemory) = return $ S.GrowMemory
+        synInstrToStruct _ (PlainInstr MemorySize) = return $ S.MemorySize
+        synInstrToStruct _ (PlainInstr MemoryGrow) = return $ S.MemoryGrow
+        synInstrToStruct _ (PlainInstr MemoryFill) = return $ S.MemoryFill
+        synInstrToStruct _ (PlainInstr MemoryCopy) = return $ S.MemoryCopy
+        synInstrToStruct FunCtx { ctxMod } (PlainInstr (MemoryInit dataIdx)) =
+            case getDataIndex ctxMod dataIdx of
+                Just dataIdx -> return $ S.MemoryInit dataIdx
+                Nothing -> Left "unknown data"
+        synInstrToStruct FunCtx { ctxMod } (PlainInstr (DataDrop dataIdx)) =
+            case getDataIndex ctxMod dataIdx of
+                Just dataIdx -> return $ S.DataDrop dataIdx
+                Nothing -> Left "unknown data"
         synInstrToStruct FunCtx { ctxMod } (PlainInstr (TableInit tableIdx elemIdx)) =
             case getTableIndex ctxMod tableIdx of
                 Just tableIdx ->
@@ -2120,6 +2142,15 @@ desugarize fields = do
         extractDataSegment datas (MFData dataSegment) = dataSegment : datas
         extractDataSegment datas _ = datas
 
+        getDataIndex :: Module -> GlobalIndex -> Maybe Natural
+        getDataIndex mod@Module { datas } (Named id) =
+            let isIdent (_, DataSegment { ident }) = ident == Just id in
+            let dataIndexes = map fst $ filter isIdent $ zip [0..] datas in
+            case dataIndexes of
+                [idx] -> return idx
+                _ -> Nothing
+        getDataIndex _ (Index idx) = Just idx
+
         -- start
         synStartToStruct :: Module -> StartFunction -> S.StartFunction
         synStartToStruct mod (StartFunction funIdx) =
diff --git a/src/Language/Wasm/Structure.hs b/src/Language/Wasm/Structure.hs
index 3468a37..001d558 100644
--- a/src/Language/Wasm/Structure.hs
+++ b/src/Language/Wasm/Structure.hs
@@ -178,8 +178,12 @@ data Instruction index =
     | I64Store8 MemArg
     | I64Store16 MemArg
     | I64Store32 MemArg
-    | CurrentMemory
-    | GrowMemory
+    | MemorySize
+    | MemoryGrow
+    | MemoryFill
+    | MemoryCopy
+    | MemoryInit DataIndex
+    | DataDrop DataIndex
     -- Table instructions
     | TableInit TableIndex ElemIndex
     | TableGrow TableIndex
diff --git a/src/Language/Wasm/Validate.hs b/src/Language/Wasm/Validate.hs
index 0e7b215..e9ff636 100644
--- a/src/Language/Wasm/Validate.hs
+++ b/src/Language/Wasm/Validate.hs
@@ -386,10 +386,10 @@ getInstrType (I64Store16 memarg) = do
 getInstrType (I64Store32 memarg) = do
     checkMemoryInstr 4 memarg
     return $ [I32, I64] ==> empty
-getInstrType CurrentMemory = do
+getInstrType MemorySize = do
     Ctx { mems } <- ask 
     if length mems < 1 then throwError (MemoryIndexOutOfRange 0) else return $ empty ==> I32
-getInstrType GrowMemory = do
+getInstrType MemoryGrow = do
     Ctx { mems } <- ask
     if length mems < 1 then throwError (MemoryIndexOutOfRange 0) else return $ I32 ==> I32
 getInstrType (TableInit tableIdx elemIdx) = do
@@ -712,6 +712,7 @@ datasShouldBeValid m@Module { datas, mems, imports } =
             if memIdx < (fromIntegral $ length memImports + length mems)
             then check
             else Left (MemoryIndexOutOfRange memIdx)
+        isDataValid ctx (DataSegment PassiveData _) = return ()
 
 startShouldBeValid :: Validator
 startShouldBeValid Module { start = Nothing } = return ()
diff --git a/tests/Test.hs b/tests/Test.hs
index 1879bc9..9b5e61c 100644
--- a/tests/Test.hs
+++ b/tests/Test.hs
@@ -19,7 +19,7 @@ main = do
   files <-
     filter (not . List.isPrefixOf "simd") . filter (List.isSuffixOf ".wast")
       <$> Directory.listDirectory "tests/spec"
-  let files = ["data.wast"]
+  let files = ["memory_init.wast"]
   scriptTestCases <- (`mapM` files) $ \file -> do
     test <- LBS.readFile ("tests/spec/" ++ file)
     return $ testCase file $ do

From 5256d5063fa15561013a7d0202d391044d78c8a2 Mon Sep 17 00:00:00 2001
From: Ilya Rezvov <rezvov.ilya@gmail.com>
Date: Sun, 12 Jun 2022 21:12:19 -0600
Subject: [PATCH 24/28] validate and interprete bulk memory instructions

---
 src/Language/Wasm/Interpreter.hs | 42 ++++++++++++++++++++++++++++++++
 src/Language/Wasm/Parser.y       |  3 ++-
 src/Language/Wasm/Script.hs      |  1 +
 src/Language/Wasm/Validate.hs    | 29 +++++++++++++++++++---
 tests/Test.hs                    |  2 +-
 5 files changed, 72 insertions(+), 5 deletions(-)

diff --git a/src/Language/Wasm/Interpreter.hs b/src/Language/Wasm/Interpreter.hs
index 2f8654e..e9e9e64 100644
--- a/src/Language/Wasm/Interpreter.hs
+++ b/src/Language/Wasm/Interpreter.hs
@@ -916,6 +916,48 @@ eval budget store FunctionInstance { funcType, moduleInstance, code = Function {
                     else return $ -1
                 )
             return $ Done ctx { stack = VI32 (asWord32 $ fromIntegral result) : rest }
+        step ctx@EvalCtx{ stack = (VI32 n:VI32 v:VI32 d:rest) } MemoryFill = do
+            let MemoryInstance { memory = memoryRef } = memInstances store ! (memaddrs moduleInstance ! 0)
+            memory <- readIORef memoryRef
+            size <- ByteArray.getSizeofMutableByteArray memory
+            let dest = fromIntegral d
+            let len = fromIntegral n
+            if dest + len > size
+            then return Trap
+            else do
+                ByteArray.setByteArray @Word8 memory dest len $ fromIntegral v
+                return $ Done ctx { stack = rest }
+        step ctx@EvalCtx{ stack = (VI32 n:VI32 s:VI32 d:rest) } MemoryCopy = do
+            let MemoryInstance { memory = memoryRef } = memInstances store ! (memaddrs moduleInstance ! 0)
+            memory <- readIORef memoryRef
+            size <- ByteArray.getSizeofMutableByteArray memory
+            let src = fromIntegral s
+            let dest = fromIntegral d
+            let len = fromIntegral n
+            if dest + len > size || src + len > size
+            then return Trap
+            else do
+                ByteArray.copyMutableByteArray memory dest memory src len
+                return $ Done ctx { stack = rest }
+        step ctx@EvalCtx{ stack = (VI32 n:VI32 s:VI32 d:rest) } (MemoryInit dataIdx) = do
+            let DataInstance {bytes, isDropped} = dataInstances store ! (dataaddrs moduleInstance ! fromIntegral dataIdx)
+            let MemoryInstance { memory = memoryRef } = memInstances store ! (memaddrs moduleInstance ! 0)
+            memory <- readIORef memoryRef
+            size <- fromIntegral <$> ByteArray.getSizeofMutableByteArray memory
+            let src = fromIntegral s
+            let dest = fromIntegral d
+            let len = fromIntegral n
+            dropped <- readIORef isDropped
+            if dropped || src + len > LBS.length bytes || dest + len > size
+            then return Trap
+            else do
+                mapM_ (uncurry $ ByteArray.writeByteArray memory) $ zip [fromIntegral d..] $
+                    LBS.unpack $ LBS.take len $ LBS.drop src bytes
+                return $ Done ctx { stack = rest }
+        step ctx (DataDrop dataIdx) = do
+            let DataInstance {isDropped} = dataInstances store ! (dataaddrs moduleInstance ! fromIntegral dataIdx)
+            writeIORef isDropped True
+            return $ Done ctx
         step ctx@EvalCtx{ stack = (VI32 n:VI32 s:VI32 d:rest) } (TableInit tableIdx elemIdx) = do
             let tableAddr = tableaddrs moduleInstance ! fromIntegral tableIdx
             let TableInstance { items } = tableInstances store ! tableAddr
diff --git a/src/Language/Wasm/Parser.y b/src/Language/Wasm/Parser.y
index ff31ac5..79a00ab 100644
--- a/src/Language/Wasm/Parser.y
+++ b/src/Language/Wasm/Parser.y
@@ -906,10 +906,11 @@ memory_limits_export_import1 :: { Maybe Ident -> [ModuleField] }
     | 'data' datastring ')' ')' {
         \ident ->
             let m = fromIntegral $ LBS.length $2 in
+            let lim = if m `mod` 0x10000 == 0 then m `div` 0x10000 else m `div` 0x10000 + 1 in
             -- TODO: unhardcode memory index
             let memIdx = fromMaybe (Index 0) $ Named `fmap` ident in
             [
-                MFMem $ Memory [] ident $ Limit m $ Just m,
+                MFMem $ Memory [] ident $ Limit lim $ Just lim,
                 MFData $ DataSegment Nothing (ActiveData memIdx [PlainInstr $ I32Const 0]) $2
             ]
     }
diff --git a/src/Language/Wasm/Script.hs b/src/Language/Wasm/Script.hs
index 44cc990..078b4e6 100644
--- a/src/Language/Wasm/Script.hs
+++ b/src/Language/Wasm/Script.hs
@@ -194,6 +194,7 @@ runScript onAssertFail script = do
         getFailureString Validate.InvalidStartFunctionType = ["start function"]
         getFailureString Validate.InvalidTableType = ["size minimum must not be greater than maximum"]
         getFailureString (Validate.ElemIndexOutOfRange idx) = ["unknown elem segment " <> TL.pack (show idx)]
+        getFailureString (Validate.DataIndexOutOfRange idx) = ["unknown data segment", "unknown data segment " <> TL.pack (show idx)]
         getFailureString (Validate.UndeclaredFunctionRef _) = ["undeclared function reference"]
         getFailureString r = [TL.concat ["not implemented ", TL.pack $ show r]]
 
diff --git a/src/Language/Wasm/Validate.hs b/src/Language/Wasm/Validate.hs
index e9ff636..dbd34f4 100644
--- a/src/Language/Wasm/Validate.hs
+++ b/src/Language/Wasm/Validate.hs
@@ -38,6 +38,7 @@ data ValidationError =
     | LocalIndexOutOfRange Natural
     | GlobalIndexOutOfRange Natural
     | ElemIndexOutOfRange Natural
+    | DataIndexOutOfRange Natural
     | LabelIndexOutOfRange
     | TypeIndexOutOfRange
     | ResultTypeDoesntMatch
@@ -142,6 +143,7 @@ data Ctx = Ctx {
     funcs :: [FuncType],
     tables :: [TableType],
     elems :: [ElemType],
+    datas :: [DataMode],
     mems :: [Limit],
     globals :: [GlobalType],
     locals :: [ValueType],
@@ -388,10 +390,29 @@ getInstrType (I64Store32 memarg) = do
     return $ [I32, I64] ==> empty
 getInstrType MemorySize = do
     Ctx { mems } <- ask 
-    if length mems < 1 then throwError (MemoryIndexOutOfRange 0) else return $ empty ==> I32
+    when (length mems < 1) $ throwError (MemoryIndexOutOfRange 0)
+    return $ empty ==> I32
 getInstrType MemoryGrow = do
     Ctx { mems } <- ask
-    if length mems < 1 then throwError (MemoryIndexOutOfRange 0) else return $ I32 ==> I32
+    when (length mems < 1) $ throwError (MemoryIndexOutOfRange 0)
+    return $ I32 ==> I32
+getInstrType MemoryFill = do
+    Ctx { mems } <- ask
+    when (length mems < 1) $ throwError (MemoryIndexOutOfRange 0)
+    return $ [I32, I32, I32] ==> empty
+getInstrType MemoryCopy = do
+    Ctx { mems } <- ask
+    when (length mems < 1) $ throwError (MemoryIndexOutOfRange 0)
+    return $ [I32, I32, I32] ==> empty
+getInstrType (MemoryInit dataIdx) = do
+    Ctx { mems, datas } <- ask
+    when (length mems < 1) $ throwError (MemoryIndexOutOfRange 0)
+    when (length datas <= fromIntegral dataIdx) $ throwError (DataIndexOutOfRange dataIdx)
+    return $ [I32, I32, I32] ==> empty
+getInstrType (DataDrop dataIdx) = do
+    Ctx { datas } <- ask
+    when (length datas <= fromIntegral dataIdx) $ throwError (DataIndexOutOfRange dataIdx)
+    return $ empty ==> empty
 getInstrType (TableInit tableIdx elemIdx) = do
     Ctx { tables, elems } <- ask
     when (length tables <= fromIntegral tableIdx) $ throwError (TableIndexOutOfRange tableIdx)
@@ -563,7 +584,8 @@ getFuncTypes Module {types, functions, imports} =
         getFuncType _ = Nothing
 
 ctxFromModule :: [ValueType] -> [[ValueType]] -> [ValueType] -> Module -> Ctx
-ctxFromModule locals labels returns m@Module {types, tables, mems, globals, imports, elems, exports} =
+ctxFromModule locals labels returns m =
+    let Module {types, tables, mems, globals, imports, elems, exports, datas} = m in
     let tableImports = catMaybes $ map getTableType imports in
     let memsImports = catMaybes $ map getMemType imports in
     let globalImports = catMaybes $ map getGlobalType imports in
@@ -572,6 +594,7 @@ ctxFromModule locals labels returns m@Module {types, tables, mems, globals, impo
         funcs = getFuncTypes m,
         tables = tableImports ++ map (\(Table t) -> t) tables,
         elems = map elemType elems,
+        datas = map dataMode datas,
         mems = memsImports ++ map (\(Memory l) -> l) mems,
         globals = globalImports ++ map (\(Global g _) -> g) globals,
         locals,
diff --git a/tests/Test.hs b/tests/Test.hs
index 9b5e61c..6baa8df 100644
--- a/tests/Test.hs
+++ b/tests/Test.hs
@@ -19,7 +19,7 @@ main = do
   files <-
     filter (not . List.isPrefixOf "simd") . filter (List.isSuffixOf ".wast")
       <$> Directory.listDirectory "tests/spec"
-  let files = ["memory_init.wast"]
+  let files = ["bulk.wast"]
   scriptTestCases <- (`mapM` files) $ \file -> do
     test <- LBS.readFile ("tests/spec/" ++ file)
     return $ testCase file $ do

From 0e0b1abbba70db6852ebf0ef0cc4449e017c4a58 Mon Sep 17 00:00:00 2001
From: Ilya Rezvov <rezvov.ilya@gmail.com>
Date: Sun, 20 Aug 2023 21:00:46 -0600
Subject: [PATCH 25/28] fix more tests

---
 src/Language/Wasm/Binary.hs      | 90 +++++++++++++++++++++++++++++---
 src/Language/Wasm/Interpreter.hs | 27 +++++-----
 src/Language/Wasm/Script.hs      |  6 ++-
 stack.yaml                       |  2 +-
 tests/Test.hs                    |  2 +-
 wasm.cabal                       |  2 +-
 6 files changed, 102 insertions(+), 27 deletions(-)

diff --git a/src/Language/Wasm/Binary.hs b/src/Language/Wasm/Binary.hs
index da90919..64ccc62 100644
--- a/src/Language/Wasm/Binary.hs
+++ b/src/Language/Wasm/Binary.hs
@@ -366,15 +366,49 @@ instance Serialize (Instruction Natural) where
     put Return = putWord8 0x0F
     put (Call funcIdx) = putWord8 0x10 >> putULEB128 funcIdx
     put (CallIndirect tableIdx typeIdx) = putWord8 0x11 >> putULEB128 typeIdx >> putULEB128 tableIdx
+    -- Reference instructions
+    put (RefNull refType) = putWord8 0xD0 >> put refType
+    put RefIsNull = putWord8 0xD1
+    put (RefFunc index) = putWord8 0xD2 >> putULEB128 index
     -- Parametric instructions
     put Drop = putWord8 0x1A
-    put (Select _) = putWord8 0x1B
+    put (Select Nothing) = putWord8 0x1B
+    put (Select (Just types)) = putWord8 0x1C >> putVec types
     -- Variable instructions
     put (GetLocal idx) = putWord8 0x20 >> putULEB128 idx
     put (SetLocal idx) = putWord8 0x21 >> putULEB128 idx
     put (TeeLocal idx) = putWord8 0x22 >> putULEB128 idx
     put (GetGlobal idx) = putWord8 0x23 >> putULEB128 idx
     put (SetGlobal idx) = putWord8 0x24 >> putULEB128 idx
+    -- Table instructions
+    put (TableGet idx) = putWord8 0x25 >> putULEB128 idx
+    put (TableSet idx) = putWord8 0x26 >> putULEB128 idx
+    put (TableInit tableIdx elemIdx) = do
+        putWord8 0xFC
+        putULEB128 (0x0C :: Word32)
+        putULEB128 tableIdx
+        putULEB128 elemIdx
+    put (ElemDrop elemIdx) = do
+        putWord8 0xFC
+        putULEB128 (0x0D :: Word32)
+        putULEB128 elemIdx
+    put (TableCopy fromIdx toIdx) = do
+        putWord8 0xFC
+        putULEB128 (0x0E :: Word32)
+        putULEB128 fromIdx
+        putULEB128 toIdx
+    put (TableGrow tableIdx) = do
+        putWord8 0xFC
+        putULEB128 (0x0F :: Word32)
+        putULEB128 tableIdx
+    put (TableSize tableIdx) = do
+        putWord8 0xFC
+        putULEB128 (0x10 :: Word32)
+        putULEB128 tableIdx
+    put (TableFill tableIdx) = do
+        putWord8 0xFC
+        putULEB128 (0x11 :: Word32)
+        putULEB128 tableIdx
     -- Memory instructions
     put (I32Load memArg) = putWord8 0x28 >> put memArg
     put (I64Load memArg) = putWord8 0x29 >> put memArg
@@ -401,6 +435,24 @@ instance Serialize (Instruction Natural) where
     put (I64Store32 memArg) = putWord8 0x3E >> put memArg
     put MemorySize = putWord8 0x3F >> putWord8 0x00
     put MemoryGrow = putWord8 0x40 >> putWord8 0x00
+    put (MemoryInit dataIdx) = do
+        putWord8 0xFC
+        putULEB128 (0x08 :: Word32)
+        putULEB128 dataIdx
+        putWord8 0
+    put (DataDrop dataIdx) = do
+        putWord8 0xFC
+        putULEB128 (0x09 :: Word32)
+        putULEB128 dataIdx
+    put MemoryCopy = do
+        putWord8 0xFC
+        putULEB128 (0x0A :: Word32)
+        putWord8 0
+        putWord8 0
+    put MemoryFill = do
+        putWord8 0xFC
+        putULEB128 (0x0B :: Word32)
+        putWord8 0
     -- Numeric instructions
     put (I32Const val) = putWord8 0x41 >> putSLEB128 (asInt32 val)
     put (I64Const val) = putWord8 0x42 >> putSLEB128 (asInt64 val)
@@ -567,6 +619,10 @@ instance Serialize (Instruction Natural) where
                 typeIdx <- getULEB128 32
                 tableIdx <- getULEB128 32
                 return $ CallIndirect tableIdx typeIdx
+            -- Reference instructions
+            0xD0 -> RefNull <$> get
+            0xD1 -> return RefIsNull
+            0xD2 -> RefFunc <$> getULEB128 32
             -- Parametric instructions
             0x1A -> return $ Drop
             0x1B -> return $ Select Nothing
@@ -747,7 +803,7 @@ instance Serialize (Instruction Natural) where
                     0x06 -> return $ ITruncSatFS BS64 BS64
                     0x07 -> return $ ITruncSatFU BS64 BS64
                     _ -> fail "Unknown byte value after misc instruction byte"
-            _ -> fail "Unknown byte value in place of instruction opcode"
+            byte -> fail $ "Unknown byte value in place of instruction opcode: " ++ (show byte)
 
 putExpression :: Expression -> Put
 putExpression expr = do
@@ -844,7 +900,7 @@ instance Serialize ElemSegment where
                 ElemSegment FuncRef (Active 0 offset) <$> funcIndexes
             0x05 -> do
                 elemType <- get
-                ElemSegment elemType Passive <$> getVec
+                ElemSegment elemType Passive . map unExpr <$> getVec
             0x06 -> do
                 tableIndex <- getULEB128 32
                 offset <- getExpression
@@ -882,16 +938,34 @@ instance Serialize Function where
 
 instance Serialize DataSegment where
     put (DataSegment (ActiveData memIdx offset) init) = do
+        putWord8 0x02
         putULEB128 memIdx
         putExpression offset
         putULEB128 $ LBS.length init
         putLazyByteString init
+    put (DataSegment PassiveData init) = do
+        putWord8 0x01
+        putULEB128 $ LBS.length init
+        putLazyByteString init
     get = do
-        memIdx <- getULEB128 32
-        offset <- getExpression
-        len <- getULEB128 32
-        init <- getLazyByteString len
-        return $ DataSegment (ActiveData memIdx offset) init
+        op <- getULEB128 32
+        case (op :: Word8) of
+            0x00 -> do
+                offset <- getExpression
+                len <- getULEB128 32
+                init <- getLazyByteString len
+                return $ DataSegment (ActiveData 0 offset) init
+            0x01 -> do
+                len <- getULEB128 32
+                init <- getLazyByteString len
+                return $ DataSegment PassiveData init 
+            0x02 -> do
+                memIdx <- getULEB128 32
+                offset <- getExpression
+                len <- getULEB128 32
+                init <- getLazyByteString len
+                return $ DataSegment (ActiveData memIdx offset) init
+            byte -> fail $ "unknown data segment type: " ++ show byte 
 
 instance Serialize Module where
     put mod = do
diff --git a/src/Language/Wasm/Interpreter.hs b/src/Language/Wasm/Interpreter.hs
index e9e9e64..949af82 100644
--- a/src/Language/Wasm/Interpreter.hs
+++ b/src/Language/Wasm/Interpreter.hs
@@ -423,13 +423,13 @@ calcInstance (Store fs ts ms gs es ds) imps mod = do
             if limitMatch lim limit
             then return idx
             else throwError "incompatible import type"
-        checkImportType imp@(Import _ _ (ImportTable (TableType limit _))) = do
+        checkImportType imp@(Import _ _ (ImportTable (TableType limit et))) = do
             idx <- getImpIdx imp
             tableAddr <- case idx of
                 ExternTable tableAddr -> return tableAddr
                 _ -> throwError "incompatible import type"
-            let TableInstance { t = TableType lim _ } = ts ! tableAddr
-            if limitMatch lim limit
+            let TableInstance { t = TableType lim et' } = ts ! tableAddr
+            if limitMatch lim limit && et == et'
             then return idx
             else throwError "incompatible import type"
     
@@ -562,19 +562,18 @@ initialize inst Module {elems, datas, start} = do
             refs <- liftIO $ mapM (evalConstExpr inst st) elements
             let funcs = map (\(RF ref) -> (funcaddrs inst !) . fromIntegral <$> ref) refs
             let idx = tableaddrs inst ! fromIntegral tableIndex
-            let last = from + length funcs
-            let TableInstance lim elems = tableInstances st ! idx
-            len <- MVector.length <$> (liftIO $ readIORef elems)
-            Monad.when (last > len) $ throwError "out of bounds table access"
             return (idx, elemaddrs inst ! elemN, from, funcs)
 
         initElem :: (Address, Address, Int, [Maybe Address]) -> Initialize ()
         initElem (tableIdx, elemIdx, from, funcs) = do
             Store {tableInstances, elemInstances} <- State.get
             elems <- liftIO $ readIORef $ items $ tableInstances ! tableIdx
-            let ElemInstance {isDropped} = elemInstances ! elemIdx
-            liftIO $ writeIORef isDropped True
-            Monad.forM_ (zip [from..] funcs) $ uncurry $ MVector.unsafeWrite elems
+            if from + length funcs > MVector.length elems
+            then throwError "out of bounds table access"
+            else do
+                let ElemInstance {isDropped} = elemInstances ! elemIdx
+                liftIO $ writeIORef isDropped True
+                Monad.forM_ (zip [from..] funcs) $ uncurry $ MVector.unsafeWrite elems
 
         checkData :: DataSegment -> Initialize (Maybe (Int, MemoryStore, LBS.ByteString))
         checkData DataSegment {dataMode = ActiveData memIndex offset, chunk} = do
@@ -582,18 +581,18 @@ initialize inst Module {elems, datas, start} = do
             VI32 val <- liftIO $ evalConstExpr inst st offset
             let from = fromIntegral val
             let idx = memaddrs inst ! fromIntegral memIndex
-            let last = from + (fromIntegral $ LBS.length chunk)
             let MemoryInstance _ memory = memInstances st ! idx
             mem <- liftIO $ readIORef memory
-            len <- ByteArray.getSizeofMutableByteArray mem
-            Monad.when (last > len) $ throwError "out of bounds memory access"
             return $ Just (from, mem, chunk)
         checkData DataSegment {dataMode = PassiveData, chunk} =
             return Nothing
         
         initData :: Maybe (Int, MemoryStore, LBS.ByteString) -> Initialize ()
         initData Nothing = return ()
-        initData (Just (from, mem, chunk)) =
+        initData (Just (from, mem, chunk)) = do
+            let last = from + (fromIntegral $ LBS.length chunk)
+            len <- ByteArray.getSizeofMutableByteArray mem
+            Monad.when (last > len) $ throwError "out of bounds memory access"
             mapM_ (\(i,b) -> ByteArray.writeByteArray mem i b) $ zip [from..] $ LBS.unpack chunk
 
 instantiate :: Store -> Imports -> Valid.ValidModule -> IO (Either String ModuleInstance, Store)
diff --git a/src/Language/Wasm/Script.hs b/src/Language/Wasm/Script.hs
index 078b4e6..a5e827a 100644
--- a/src/Language/Wasm/Script.hs
+++ b/src/Language/Wasm/Script.hs
@@ -13,6 +13,7 @@ import Control.Monad.IO.Class (liftIO)
 import Numeric.IEEE (identicalIEEE)
 import qualified Control.DeepSeq as DeepSeq
 import Data.Maybe (fromJust, isNothing)
+import Debug.Trace (trace)
 
 import Language.Wasm.Parser (
         Ident(..),
@@ -166,7 +167,7 @@ runScript onAssertFail script = do
             let Right m = Lexer.scanner (TLEncoding.encodeUtf8 textRep) >>= Parser.parseModule in
             (ident, m)
         buildModule (BinaryModDef ident binaryRep) =
-            let Right m = Binary.decodeModuleLazy binaryRep in
+            let Right m = Binary.decodeModuleLazy binaryRep  in
             (ident, m)
 
         checkModuleInvalid :: Struct.Module -> IO ()
@@ -261,8 +262,9 @@ runScript onAssertFail script = do
             let (_, m) = buildModule moduleDef in
             case Validate.validate m of
                 Right m -> do
-                    st <- fst <$> State.get
+                    (st, pos) <- State.get
                     (res, store') <- liftIO $ Interpreter.instantiate (store st) (buildImports st) m
+                    State.put (st { store = store' }, pos)
                     case res of
                         Left err | err == TL.unpack failureString -> return ()
                         Left "Start function terminated with trap" ->
diff --git a/stack.yaml b/stack.yaml
index 9d0d27a..9e05aeb 100644
--- a/stack.yaml
+++ b/stack.yaml
@@ -3,4 +3,4 @@ packages:
 - '.'
 extra-deps: []
 flags: {}
-extra-package-dbs: []
+extra-package-dbs: []
\ No newline at end of file
diff --git a/tests/Test.hs b/tests/Test.hs
index 6baa8df..e9b9a7b 100644
--- a/tests/Test.hs
+++ b/tests/Test.hs
@@ -19,7 +19,7 @@ main = do
   files <-
     filter (not . List.isPrefixOf "simd") . filter (List.isSuffixOf ".wast")
       <$> Directory.listDirectory "tests/spec"
-  let files = ["bulk.wast"]
+  -- let files = ["linking.wast"]
   scriptTestCases <- (`mapM` files) $ \file -> do
     test <- LBS.readFile ("tests/spec/" ++ file)
     return $ testCase file $ do
diff --git a/wasm.cabal b/wasm.cabal
index 0e6b479..5245e29 100644
--- a/wasm.cabal
+++ b/wasm.cabal
@@ -67,7 +67,7 @@ library
     , text >=1.1 && < 1.3
     , transformers >=0.4 && < 0.6
     , utf8-string >=1.0 && < 1.1
-    , vector >=0.12 && < 0.13
+    , vector >=0.12.2 && < 0.13
   default-language: Haskell2010
 
 test-suite test

From 724973b15e8f6f596a34e27e16791bf08c61c395 Mon Sep 17 00:00:00 2001
From: Ilya Rezvov <rezvov.ilya@gmail.com>
Date: Mon, 21 Aug 2023 08:23:58 -0600
Subject: [PATCH 26/28] fix reexports

---
 src/Language/Wasm/Interpreter.hs |  5 +++--
 src/Language/Wasm/Parser.y       | 20 ++++++++++++++------
 src/Language/Wasm/Validate.hs    |  2 +-
 tests/Test.hs                    |  2 +-
 4 files changed, 19 insertions(+), 10 deletions(-)

diff --git a/src/Language/Wasm/Interpreter.hs b/src/Language/Wasm/Interpreter.hs
index 949af82..b369ad3 100644
--- a/src/Language/Wasm/Interpreter.hs
+++ b/src/Language/Wasm/Interpreter.hs
@@ -419,8 +419,9 @@ calcInstance (Store fs ts ms gs es ds) imps mod = do
             memAddr <- case idx of
                 ExternMemory memAddr -> return memAddr
                 _ -> throwError "incompatible import type"
-            let MemoryInstance { lim } = ms ! memAddr
-            if limitMatch lim limit
+            let MemoryInstance { lim = Limit _ limMax, memory = mem } = ms ! memAddr
+            size <- liftIO $ (`quot` pageSize) <$> (readIORef mem >>= ByteArray.getSizeofMutableByteArray)
+            if limitMatch (Limit (fromIntegral size) limMax) limit
             then return idx
             else throwError "incompatible import type"
         checkImportType imp@(Import _ _ (ImportTable (TableType limit et))) = do
diff --git a/src/Language/Wasm/Parser.y b/src/Language/Wasm/Parser.y
index 79a00ab..e49dda1 100644
--- a/src/Language/Wasm/Parser.y
+++ b/src/Language/Wasm/Parser.y
@@ -2167,14 +2167,22 @@ desugarize fields = do
         -- exports
         extractExports :: Module -> [ModuleField] -> [ModuleField]
         extractExports mod mf =
-            let initial = (funcImportLength, globImportLength, memImportLength, tableImportLength, []) in
-            let (_, _, _, _, result) = foldl' extractExport initial mf in
+            let fromImports = foldl' reexport (0, 0, 0, 0, []) $ imports mod in
+            let (_, _, _, _, result) = foldl' extractExport fromImports mf in
             reverse result
             where
-                funcImportLength = fromIntegral $ length $ filter isFuncImport $ imports mod
-                globImportLength = fromIntegral $ length $ filter isGlobalImport $ imports mod
-                memImportLength = fromIntegral $ length $ filter isMemImport $ imports mod
-                tableImportLength = fromIntegral $ length $ filter isTableImport $ imports mod
+                reexport (fidx, gidx, midx, tidx, mf) (Import {reExportAs, desc = ImportFunc _ _}) =
+                    let exports = map (\name -> MFExport $ Export name $ ExportFunc $ Index fidx) reExportAs in
+                    (fidx + 1, gidx, midx, tidx, exports ++ mf)
+                reexport (fidx, gidx, midx, tidx, mf) (Import {reExportAs, desc = ImportGlobal _ _}) =
+                    let exports = map (\name -> MFExport $ Export name $ ExportGlobal $ Index gidx) reExportAs in
+                    (fidx, gidx + 1, midx, tidx, exports ++ mf)
+                reexport (fidx, gidx, midx, tidx, mf) (Import {reExportAs, desc = ImportMemory _ _}) =
+                    let exports = map (\name -> MFExport $ Export name $ ExportMemory $ Index midx) reExportAs in
+                    (fidx, gidx, midx + 1, tidx, exports ++ mf)
+                reexport (fidx, gidx, midx, tidx, mf) (Import {reExportAs, desc = ImportTable _ _}) =
+                    let exports = map (\name -> MFExport $ Export name $ ExportTable $ Index tidx) reExportAs in
+                    (fidx, gidx, midx, tidx + 1, exports ++ mf)
 
                 extractExport (fidx, gidx, midx, tidx, mf) (MFFunc fun@Function{ exportFuncAs }) =
                     let exports = map (\name -> MFExport $ Export name $ ExportFunc $ Index fidx) exportFuncAs in
diff --git a/src/Language/Wasm/Validate.hs b/src/Language/Wasm/Validate.hs
index dbd34f4..f871b5f 100644
--- a/src/Language/Wasm/Validate.hs
+++ b/src/Language/Wasm/Validate.hs
@@ -65,7 +65,7 @@ instance Monoid ValidationResult where
 
 isValid :: ValidationResult -> Bool
 isValid (Right ()) = True
-isValid (Left reason) = Debug.trace ("Module mismatched with reason " ++ show reason) $ False
+isValid (Left reason) = False
 
 type Validator = Module -> ValidationResult
 
diff --git a/tests/Test.hs b/tests/Test.hs
index e9b9a7b..a074f67 100644
--- a/tests/Test.hs
+++ b/tests/Test.hs
@@ -19,7 +19,7 @@ main = do
   files <-
     filter (not . List.isPrefixOf "simd") . filter (List.isSuffixOf ".wast")
       <$> Directory.listDirectory "tests/spec"
-  -- let files = ["linking.wast"]
+  -- let files = ["imports.wast"]
   scriptTestCases <- (`mapM` files) $ \file -> do
     test <- LBS.readFile ("tests/spec/" ++ file)
     return $ testCase file $ do

From a5ffe38a1c8d86554c9134afd3a137ced45e76e0 Mon Sep 17 00:00:00 2001
From: Ilya Rezvov <rezvov.ilya@gmail.com>
Date: Mon, 21 Aug 2023 19:28:54 -0600
Subject: [PATCH 27/28] more green test

---
 src/Language/Wasm/Interpreter.hs | 4 ++--
 src/Language/Wasm/Validate.hs    | 8 +++++++-
 tests/Test.hs                    | 2 +-
 3 files changed, 10 insertions(+), 4 deletions(-)

diff --git a/src/Language/Wasm/Interpreter.hs b/src/Language/Wasm/Interpreter.hs
index b369ad3..b9e7a16 100644
--- a/src/Language/Wasm/Interpreter.hs
+++ b/src/Language/Wasm/Interpreter.hs
@@ -948,7 +948,7 @@ eval budget store FunctionInstance { funcType, moduleInstance, code = Function {
             let dest = fromIntegral d
             let len = fromIntegral n
             dropped <- readIORef isDropped
-            if dropped || src + len > LBS.length bytes || dest + len > size
+            if (dropped && len > 0) || src + len > LBS.length bytes || dest + len > size
             then return Trap
             else do
                 mapM_ (uncurry $ ByteArray.writeByteArray memory) $ zip [fromIntegral d..] $
@@ -974,7 +974,7 @@ eval budget store FunctionInstance { funcType, moduleInstance, code = Function {
             isDropped <- readIORef dropFlag
             if src + len > Vector.length refs
                 || dst + len > MVector.length els
-                || isDropped
+                || (isDropped && len > 0)
                 || isDeclarative mode
             then return Trap
             else do
diff --git a/src/Language/Wasm/Validate.hs b/src/Language/Wasm/Validate.hs
index f871b5f..207f1a1 100644
--- a/src/Language/Wasm/Validate.hs
+++ b/src/Language/Wasm/Validate.hs
@@ -550,9 +550,15 @@ getExpressionTypeWithInput inp = fmap (inp `Arrow`) . foldM go inp
             if isRef v
             then throwError $ TypeMismatch (empty ==> empty) (empty ==> empty)
             else matchStack stack (subst args) (subst res)
+        matchStack (Var:stack) (NonRefVar:args) res =
+            let subst = replace NonRefVar NonRefVar in
+            matchStack stack (subst args) (subst res)
+        matchStack (NonRefVar:stack) (Var:args) res =
+            let subst = replace Var NonRefVar in
+            matchStack stack (subst args) (subst res)
         matchStack stack [] res = return $ res ++ stack
         matchStack [] args res = throwError $ TypeMismatch ((reverse args) `Arrow` res) ([] `Arrow` [])
-        matchStack _ _ _ = error "inconsistent checker state"
+        matchStack st args res = error $ "inconsistent checker state: " ++ show (st, args, res)
 
 getExpressionType :: Expression -> Checker Arrow
 getExpressionType = getExpressionTypeWithInput []
diff --git a/tests/Test.hs b/tests/Test.hs
index a074f67..14cf2cc 100644
--- a/tests/Test.hs
+++ b/tests/Test.hs
@@ -19,7 +19,7 @@ main = do
   files <-
     filter (not . List.isPrefixOf "simd") . filter (List.isSuffixOf ".wast")
       <$> Directory.listDirectory "tests/spec"
-  -- let files = ["imports.wast"]
+  -- let files = ["unreached-valid.wast"]
   scriptTestCases <- (`mapM` files) $ \file -> do
     test <- LBS.readFile ("tests/spec/" ++ file)
     return $ testCase file $ do

From f2f5fcc56ff7bb3d0a8ce47db14ce85f633a0150 Mon Sep 17 00:00:00 2001
From: Ilya Rezvov <rezvov.ilya@gmail.com>
Date: Mon, 21 Aug 2023 21:11:14 -0600
Subject: [PATCH 28/28] all tests are green

---
 src/Language/Wasm/Validate.hs | 308 +++++++++++++++++-----------------
 tests/Test.hs                 |   2 +-
 2 files changed, 158 insertions(+), 152 deletions(-)

diff --git a/src/Language/Wasm/Validate.hs b/src/Language/Wasm/Validate.hs
index 207f1a1..872ab6f 100644
--- a/src/Language/Wasm/Validate.hs
+++ b/src/Language/Wasm/Validate.hs
@@ -219,24 +219,24 @@ elemTypeToRefType :: ElemType -> ValueType
 elemTypeToRefType FuncRef = Func
 elemTypeToRefType ExternRef = Extern
 
-getInstrType :: Instruction Natural -> Checker Arrow
-getInstrType Unreachable = return $ Any ==> Any
-getInstrType Nop = return $ empty ==> empty
-getInstrType Block { blockType, body } = do
+getInstrType :: [VType] -> Instruction Natural -> Checker Arrow
+getInstrType _ Unreachable = return $ Any ==> Any
+getInstrType _ Nop = return $ empty ==> empty
+getInstrType _ Block { blockType, body } = do
     bt@(Arrow from _) <- getBlockType blockType
     resultType <- getResultType blockType
     t <- withLabel resultType $ getExpressionTypeWithInput from body
     if isArrowMatch t bt
     then return bt
     else throwError $ TypeMismatch t bt
-getInstrType Loop { blockType, body } = do
+getInstrType _ Loop { blockType, body } = do
     bt@(Arrow from _) <- getBlockType blockType
     resultType <- getResultType blockType
     t <- withLabel (map (\(Val v) -> v) from) $ getExpressionTypeWithInput from body
     if isArrowMatch t bt
     then return bt
     else throwError $ TypeMismatch t bt
-getInstrType If { blockType, true, false } = do
+getInstrType _ If { blockType, true, false } = do
     bt@(Arrow from _) <- getBlockType blockType
     resultType <- getResultType blockType
     l <- withLabel resultType $ getExpressionTypeWithInput from true
@@ -249,48 +249,53 @@ getInstrType If { blockType, true, false } = do
             else (throwError $ TypeMismatch r bt)
         )
     else throwError $ TypeMismatch l bt
-getInstrType (Br lbl) = do
+getInstrType _ (Br lbl) = do
     r <- map Val <$> getLabel lbl
     return $ (Any : r) ==> Any
-getInstrType (BrIf lbl) = do
+getInstrType _ (BrIf lbl) = do
     r <- map Val <$> getLabel lbl
     return $ (r ++ [Val I32]) ==> r
-getInstrType (BrTable lbls lbl) = do
+getInstrType stack (BrTable lbls lbl) = do
     r <- getLabel lbl
-    rs <- mapM getLabel lbls
-    if all (== r) rs
+    let returns lbl = do
+            args <- map Val <$> getLabel lbl
+            res <- matchStack stack (Val I32 : reverse args) []
+            return (args, res)
+    alternatives <- mapM returns lbls
+    (_, def) <- returns lbl
+    if all (\(args, res) -> res == def && length args == length r) alternatives
     then return $ ([Any] ++ (map Val r) ++ [Val I32]) ==> Any
     else throwError ResultTypeDoesntMatch
-getInstrType Return = do
+getInstrType _ Return = do
     Ctx { returns } <- ask
     return $ (Any : (map Val returns)) ==> Any
-getInstrType (Call fun) = do
+getInstrType _ (Call fun) = do
     Ctx { funcs } <- ask
     maybeToEither (FunctionIndexOutOfRange fun) $ asArrow <$> funcs !? fun
-getInstrType (CallIndirect tableIdx sign) = do
+getInstrType _ (CallIndirect tableIdx sign) = do
     Ctx { types, tables } <- ask
     if length tables <= fromIntegral tableIdx
     then throwError (TableIndexOutOfRange tableIdx)
     else do
         Arrow from to <- maybeToEither TypeIndexOutOfRange $ asArrow <$> types !? sign
         return $ (from ++ [Val I32]) ==> to
-getInstrType Drop = do
+getInstrType _ Drop = do
     var <- freshVar
     return $ var ==> empty
-getInstrType (Select Nothing) = do
+getInstrType _ (Select Nothing) = do
     var <- return NonRefVar
     return $ [var, var, Val I32] ==> var
-getInstrType (Select (Just vt)) =
+getInstrType _ (Select (Just vt)) =
     case vt of
         [t] -> return $ [t, t, I32] ==> t
         _ -> throwError InvalidResultArity
-getInstrType (RefNull elType) = do
+getInstrType _ (RefNull elType) = do
     let t = case elType of { FuncRef -> Func; ExternRef -> Extern }
     return $ empty ==> Val t
-getInstrType RefIsNull = do
+getInstrType _ RefIsNull = do
     var <- freshVar
     return $ var ==> Val I32
-getInstrType (RefFunc funIdx) = do
+getInstrType _ (RefFunc funIdx) = do
     Ctx { funcs, refs } <- ask
     if fromIntegral funIdx < length funcs
     then do
@@ -298,122 +303,122 @@ getInstrType (RefFunc funIdx) = do
             throwError $ UndeclaredFunctionRef $ fromIntegral funIdx
         return $ empty ==> Val Func
     else throwError $ FunctionIndexOutOfRange $ fromIntegral funIdx
-getInstrType (GetLocal local) = do
+getInstrType _ (GetLocal local) = do
     Ctx { locals }  <- ask
     t <- maybeToEither (LocalIndexOutOfRange local) $ locals !? local
     return $ empty ==> Val t
-getInstrType (SetLocal local) = do
+getInstrType _ (SetLocal local) = do
     Ctx { locals } <- ask
     t <- maybeToEither (LocalIndexOutOfRange local) $ locals !? local
     return $ Val t ==> empty
-getInstrType (TeeLocal local) = do
+getInstrType _ (TeeLocal local) = do
     Ctx { locals } <- ask
     t <- maybeToEither (LocalIndexOutOfRange local) $ locals !? local
     return $ Val t ==> Val t
-getInstrType (GetGlobal global) = do
+getInstrType _ (GetGlobal global) = do
     Ctx { globals } <- ask
     t <- maybeToEither (GlobalIndexOutOfRange global) $ asType <$> globals !? global
     return $ empty ==> t
-getInstrType (SetGlobal global) = do
+getInstrType _ (SetGlobal global) = do
     Ctx { globals } <- ask
     t <- maybeToEither (GlobalIndexOutOfRange global) $ asType <$> globals !? global
     shouldBeMut $ globals !! fromIntegral global
     return $ t ==> empty
-getInstrType (I32Load memarg) = do
+getInstrType _ (I32Load memarg) = do
     checkMemoryInstr 4 memarg
     return $ I32 ==> I32
-getInstrType (I64Load memarg) = do
+getInstrType _ (I64Load memarg) = do
     checkMemoryInstr 8 memarg
     return $ I32 ==> I64
-getInstrType (F32Load memarg) = do
+getInstrType _ (F32Load memarg) = do
     checkMemoryInstr 4 memarg
     return $ I32 ==> F32
-getInstrType (F64Load memarg) = do
+getInstrType _ (F64Load memarg) = do
     checkMemoryInstr 8 memarg
     return $ I32 ==> F64
-getInstrType (I32Load8S memarg) = do
+getInstrType _ (I32Load8S memarg) = do
     checkMemoryInstr 1 memarg
     return $ I32 ==> I32
-getInstrType (I32Load8U memarg) = do
+getInstrType _ (I32Load8U memarg) = do
     checkMemoryInstr 1 memarg
     return $ I32 ==> I32
-getInstrType (I32Load16S memarg) = do
+getInstrType _ (I32Load16S memarg) = do
     checkMemoryInstr 2 memarg
     return $ I32 ==> I32
-getInstrType (I32Load16U memarg) = do
+getInstrType _ (I32Load16U memarg) = do
     checkMemoryInstr 2 memarg
     return $ I32 ==> I32
-getInstrType (I64Load8S memarg) = do
+getInstrType _ (I64Load8S memarg) = do
     checkMemoryInstr 1 memarg
     return $ I32 ==> I64
-getInstrType (I64Load8U memarg) = do
+getInstrType _ (I64Load8U memarg) = do
     checkMemoryInstr 1 memarg
     return $ I32 ==> I64
-getInstrType (I64Load16S memarg) = do
+getInstrType _ (I64Load16S memarg) = do
     checkMemoryInstr 2 memarg
     return $ I32 ==> I64
-getInstrType (I64Load16U memarg) = do
+getInstrType _ (I64Load16U memarg) = do
     checkMemoryInstr 2 memarg
     return $ I32 ==> I64
-getInstrType (I64Load32S memarg) = do
+getInstrType _ (I64Load32S memarg) = do
     checkMemoryInstr 4 memarg
     return $ I32 ==> I64
-getInstrType (I64Load32U memarg) = do
+getInstrType _ (I64Load32U memarg) = do
     checkMemoryInstr 4 memarg
     return $ I32 ==> I64
-getInstrType (I32Store memarg) = do
+getInstrType _ (I32Store memarg) = do
     checkMemoryInstr 4 memarg
     return $ [I32, I32] ==> empty
-getInstrType (I64Store memarg) = do
+getInstrType _ (I64Store memarg) = do
     checkMemoryInstr 8 memarg
     return $ [I32, I64] ==> empty
-getInstrType (F32Store memarg) = do
+getInstrType _ (F32Store memarg) = do
     checkMemoryInstr 4 memarg
     return $ [I32, F32] ==> empty
-getInstrType (F64Store memarg) = do
+getInstrType _ (F64Store memarg) = do
     checkMemoryInstr 8 memarg
     return $ [I32, F64] ==> empty
-getInstrType (I32Store8 memarg) = do
+getInstrType _ (I32Store8 memarg) = do
     checkMemoryInstr 1 memarg
     return $ [I32, I32] ==> empty
-getInstrType (I32Store16 memarg) = do
+getInstrType _ (I32Store16 memarg) = do
     checkMemoryInstr 2 memarg
     return $ [I32, I32] ==> empty
-getInstrType (I64Store8 memarg) = do
+getInstrType _ (I64Store8 memarg) = do
     checkMemoryInstr 1 memarg
     return $ [I32, I64] ==> empty
-getInstrType (I64Store16 memarg) = do
+getInstrType _ (I64Store16 memarg) = do
     checkMemoryInstr 2 memarg
     return $ [I32, I64] ==> empty
-getInstrType (I64Store32 memarg) = do
+getInstrType _ (I64Store32 memarg) = do
     checkMemoryInstr 4 memarg
     return $ [I32, I64] ==> empty
-getInstrType MemorySize = do
+getInstrType _ MemorySize = do
     Ctx { mems } <- ask 
     when (length mems < 1) $ throwError (MemoryIndexOutOfRange 0)
     return $ empty ==> I32
-getInstrType MemoryGrow = do
+getInstrType _ MemoryGrow = do
     Ctx { mems } <- ask
     when (length mems < 1) $ throwError (MemoryIndexOutOfRange 0)
     return $ I32 ==> I32
-getInstrType MemoryFill = do
+getInstrType _ MemoryFill = do
     Ctx { mems } <- ask
     when (length mems < 1) $ throwError (MemoryIndexOutOfRange 0)
     return $ [I32, I32, I32] ==> empty
-getInstrType MemoryCopy = do
+getInstrType _ MemoryCopy = do
     Ctx { mems } <- ask
     when (length mems < 1) $ throwError (MemoryIndexOutOfRange 0)
     return $ [I32, I32, I32] ==> empty
-getInstrType (MemoryInit dataIdx) = do
+getInstrType _ (MemoryInit dataIdx) = do
     Ctx { mems, datas } <- ask
     when (length mems < 1) $ throwError (MemoryIndexOutOfRange 0)
     when (length datas <= fromIntegral dataIdx) $ throwError (DataIndexOutOfRange dataIdx)
     return $ [I32, I32, I32] ==> empty
-getInstrType (DataDrop dataIdx) = do
+getInstrType _ (DataDrop dataIdx) = do
     Ctx { datas } <- ask
     when (length datas <= fromIntegral dataIdx) $ throwError (DataIndexOutOfRange dataIdx)
     return $ empty ==> empty
-getInstrType (TableInit tableIdx elemIdx) = do
+getInstrType _ (TableInit tableIdx elemIdx) = do
     Ctx { tables, elems } <- ask
     when (length tables <= fromIntegral tableIdx) $ throwError (TableIndexOutOfRange tableIdx)
     when (length elems <= fromIntegral elemIdx) $ throwError (ElemIndexOutOfRange elemIdx)
@@ -421,7 +426,7 @@ getInstrType (TableInit tableIdx elemIdx) = do
     let elemType = elems !! fromIntegral elemIdx
     when (elemType /= tableType) $ throwError (RefTypeMismatch tableType elemType)
     return $ [I32, I32, I32] ==> empty
-getInstrType (TableCopy toIdx fromIdx) = do
+getInstrType _ (TableCopy toIdx fromIdx) = do
     Ctx { tables } <- ask
     let (from, to) = (fromIntegral fromIdx, fromIntegral toIdx)
     when (length tables <= from) $ throwError (TableIndexOutOfRange fromIdx)
@@ -430,85 +435,85 @@ getInstrType (TableCopy toIdx fromIdx) = do
     let TableType _ toType = tables !! to
     when (fromType /= toType) $ throwError (RefTypeMismatch fromType toType)
     return $ [I32, I32, I32] ==> empty
-getInstrType (TableFill tableIdx) = do
+getInstrType _ (TableFill tableIdx) = do
     Ctx { tables } <- ask
     when (length tables <= fromIntegral tableIdx) $ throwError (TableIndexOutOfRange tableIdx)
     let TableType _ tableType = tables !! fromIntegral tableIdx
     return $ [I32, elemTypeToRefType tableType, I32] ==> empty
-getInstrType (TableSize tableIdx) = do
+getInstrType _ (TableSize tableIdx) = do
     Ctx { tables } <- ask
     when (length tables <= fromIntegral tableIdx) $ throwError (TableIndexOutOfRange tableIdx)
     return $ empty ==> I32
-getInstrType (TableGrow tableIdx) = do
+getInstrType _ (TableGrow tableIdx) = do
     Ctx { tables } <- ask
     when (length tables <= fromIntegral tableIdx) $ throwError (TableIndexOutOfRange tableIdx)
     let TableType _ tableType = tables !! fromIntegral tableIdx
     return $ [elemTypeToRefType tableType, I32] ==> I32
-getInstrType (TableGet tableIdx) = do
+getInstrType _ (TableGet tableIdx) = do
     Ctx { tables } <- ask
     when (length tables <= fromIntegral tableIdx) $ throwError (TableIndexOutOfRange tableIdx)
     let TableType _ tableType = tables !! fromIntegral tableIdx
     return $ I32 ==> (elemTypeToRefType tableType)
-getInstrType (TableSet tableIdx) = do
+getInstrType _ (TableSet tableIdx) = do
     Ctx { tables } <- ask
     when (length tables <= fromIntegral tableIdx) $ throwError (TableIndexOutOfRange tableIdx)
     let TableType _ tableType = tables !! fromIntegral tableIdx
     return $ [I32, elemTypeToRefType tableType] ==> empty
-getInstrType (ElemDrop elemIdx) = do
+getInstrType _ (ElemDrop elemIdx) = do
     Ctx { elems } <- ask
     when (length elems <= fromIntegral elemIdx) $ throwError (ElemIndexOutOfRange elemIdx)
     return $ empty ==> empty
-getInstrType (I32Const _) = return $ empty ==> I32
-getInstrType (I64Const _) = return $ empty ==> I64
-getInstrType (F32Const _) = return $ empty ==> F32
-getInstrType (F64Const _) = return $ empty ==> F64
-getInstrType (IUnOp BS32 _) = return $ I32 ==> I32
-getInstrType (IUnOp BS64 _) = return $ I64 ==> I64
-getInstrType (IBinOp BS32 _) = return $ [I32, I32] ==> I32
-getInstrType (IBinOp BS64 _) = return $ [I64, I64] ==> I64
-getInstrType I32Eqz = return $ I32 ==> I32
-getInstrType I64Eqz = return $ I64 ==> I32
-getInstrType (IRelOp BS32 _) = return $ [I32, I32] ==> I32
-getInstrType (IRelOp BS64 _) = return $ [I64, I64] ==> I32
-getInstrType (FUnOp BS32 _) = return $ F32 ==> F32
-getInstrType (FUnOp BS64 _) = return $ F64 ==> F64
-getInstrType (FBinOp BS32 _) = return $ [F32, F32] ==> F32
-getInstrType (FBinOp BS64 _) = return $ [F64, F64] ==> F64
-getInstrType (FRelOp BS32 _) = return $ [F32, F32] ==> I32
-getInstrType (FRelOp BS64 _) = return $ [F64, F64] ==> I32
-getInstrType I32WrapI64 = return $ I64 ==> I32
-getInstrType (ITruncFU BS32 BS32) = return $ F32 ==> I32
-getInstrType (ITruncFU BS32 BS64) = return $ F64 ==> I32
-getInstrType (ITruncFU BS64 BS32) = return $ F32 ==> I64
-getInstrType (ITruncFU BS64 BS64) = return $ F64 ==> I64
-getInstrType (ITruncFS BS32 BS32) = return $ F32 ==> I32
-getInstrType (ITruncFS BS32 BS64) = return $ F64 ==> I32
-getInstrType (ITruncFS BS64 BS32) = return $ F32 ==> I64
-getInstrType (ITruncFS BS64 BS64) = return $ F64 ==> I64
-getInstrType (ITruncSatFU BS32 BS32) = return $ F32 ==> I32
-getInstrType (ITruncSatFU BS32 BS64) = return $ F64 ==> I32
-getInstrType (ITruncSatFU BS64 BS32) = return $ F32 ==> I64
-getInstrType (ITruncSatFU BS64 BS64) = return $ F64 ==> I64
-getInstrType (ITruncSatFS BS32 BS32) = return $ F32 ==> I32
-getInstrType (ITruncSatFS BS32 BS64) = return $ F64 ==> I32
-getInstrType (ITruncSatFS BS64 BS32) = return $ F32 ==> I64
-getInstrType (ITruncSatFS BS64 BS64) = return $ F64 ==> I64
-getInstrType I64ExtendSI32 = return $ I32 ==> I64
-getInstrType I64ExtendUI32 = return $ I32 ==> I64
-getInstrType (FConvertIU BS32 BS32) = return $ I32 ==> F32
-getInstrType (FConvertIU BS32 BS64) = return $ I64 ==> F32
-getInstrType (FConvertIU BS64 BS32) = return $ I32 ==> F64
-getInstrType (FConvertIU BS64 BS64) = return $ I64 ==> F64
-getInstrType (FConvertIS BS32 BS32) = return $ I32 ==> F32
-getInstrType (FConvertIS BS32 BS64) = return $ I64 ==> F32
-getInstrType (FConvertIS BS64 BS32) = return $ I32 ==> F64
-getInstrType (FConvertIS BS64 BS64) = return $ I64 ==> F64
-getInstrType F32DemoteF64 = return $ F64 ==> F32
-getInstrType F64PromoteF32 = return $ F32 ==> F64
-getInstrType (IReinterpretF BS32) = return $ F32 ==> I32
-getInstrType (IReinterpretF BS64) = return $ F64 ==> I64
-getInstrType (FReinterpretI BS32) = return $ I32 ==> F32
-getInstrType (FReinterpretI BS64) = return $ I64 ==> F64
+getInstrType _ (I32Const _) = return $ empty ==> I32
+getInstrType _ (I64Const _) = return $ empty ==> I64
+getInstrType _ (F32Const _) = return $ empty ==> F32
+getInstrType _ (F64Const _) = return $ empty ==> F64
+getInstrType _ (IUnOp BS32 _) = return $ I32 ==> I32
+getInstrType _ (IUnOp BS64 _) = return $ I64 ==> I64
+getInstrType _ (IBinOp BS32 _) = return $ [I32, I32] ==> I32
+getInstrType _ (IBinOp BS64 _) = return $ [I64, I64] ==> I64
+getInstrType _ I32Eqz = return $ I32 ==> I32
+getInstrType _ I64Eqz = return $ I64 ==> I32
+getInstrType _ (IRelOp BS32 _) = return $ [I32, I32] ==> I32
+getInstrType _ (IRelOp BS64 _) = return $ [I64, I64] ==> I32
+getInstrType _ (FUnOp BS32 _) = return $ F32 ==> F32
+getInstrType _ (FUnOp BS64 _) = return $ F64 ==> F64
+getInstrType _ (FBinOp BS32 _) = return $ [F32, F32] ==> F32
+getInstrType _ (FBinOp BS64 _) = return $ [F64, F64] ==> F64
+getInstrType _ (FRelOp BS32 _) = return $ [F32, F32] ==> I32
+getInstrType _ (FRelOp BS64 _) = return $ [F64, F64] ==> I32
+getInstrType _ I32WrapI64 = return $ I64 ==> I32
+getInstrType _ (ITruncFU BS32 BS32) = return $ F32 ==> I32
+getInstrType _ (ITruncFU BS32 BS64) = return $ F64 ==> I32
+getInstrType _ (ITruncFU BS64 BS32) = return $ F32 ==> I64
+getInstrType _ (ITruncFU BS64 BS64) = return $ F64 ==> I64
+getInstrType _ (ITruncFS BS32 BS32) = return $ F32 ==> I32
+getInstrType _ (ITruncFS BS32 BS64) = return $ F64 ==> I32
+getInstrType _ (ITruncFS BS64 BS32) = return $ F32 ==> I64
+getInstrType _ (ITruncFS BS64 BS64) = return $ F64 ==> I64
+getInstrType _ (ITruncSatFU BS32 BS32) = return $ F32 ==> I32
+getInstrType _ (ITruncSatFU BS32 BS64) = return $ F64 ==> I32
+getInstrType _ (ITruncSatFU BS64 BS32) = return $ F32 ==> I64
+getInstrType _ (ITruncSatFU BS64 BS64) = return $ F64 ==> I64
+getInstrType _ (ITruncSatFS BS32 BS32) = return $ F32 ==> I32
+getInstrType _ (ITruncSatFS BS32 BS64) = return $ F64 ==> I32
+getInstrType _ (ITruncSatFS BS64 BS32) = return $ F32 ==> I64
+getInstrType _ (ITruncSatFS BS64 BS64) = return $ F64 ==> I64
+getInstrType _ I64ExtendSI32 = return $ I32 ==> I64
+getInstrType _ I64ExtendUI32 = return $ I32 ==> I64
+getInstrType _ (FConvertIU BS32 BS32) = return $ I32 ==> F32
+getInstrType _ (FConvertIU BS32 BS64) = return $ I64 ==> F32
+getInstrType _ (FConvertIU BS64 BS32) = return $ I32 ==> F64
+getInstrType _ (FConvertIU BS64 BS64) = return $ I64 ==> F64
+getInstrType _ (FConvertIS BS32 BS32) = return $ I32 ==> F32
+getInstrType _ (FConvertIS BS32 BS64) = return $ I64 ==> F32
+getInstrType _ (FConvertIS BS64 BS32) = return $ I32 ==> F64
+getInstrType _ (FConvertIS BS64 BS64) = return $ I64 ==> F64
+getInstrType _ F32DemoteF64 = return $ F64 ==> F32
+getInstrType _ F64PromoteF32 = return $ F32 ==> F64
+getInstrType _ (IReinterpretF BS32) = return $ F32 ==> I32
+getInstrType _ (IReinterpretF BS64) = return $ F64 ==> I64
+getInstrType _ (FReinterpretI BS32) = return $ I32 ==> F32
+getInstrType _ (FReinterpretI BS64) = return $ I64 ==> F64
 
 
 replace :: (Eq a) => a -> a -> [a] -> [a]
@@ -520,45 +525,46 @@ getExpressionTypeWithInput inp = fmap (inp `Arrow`) . foldM go inp
     where
         go :: [VType] -> Instruction Natural -> Checker [VType]
         go stack instr = do
-            (f `Arrow` t) <- getInstrType instr
+            (f `Arrow` t) <- getInstrType stack instr
             matchStack stack (reverse f) t
-        
-        isRef (Func)   = True
-        isRef (Extern) = True
-        isRef _        = False
-        
-        matchStack :: [VType] -> [VType] -> [VType] -> Checker [VType]
-        matchStack stack@(Any:_) _arg res = return $ res ++ stack
-        matchStack (Val v:stack) (Val v':args) res =
-            if v == v'
-            then matchStack stack args res
-            else throwError $ TypeMismatch ((reverse $ Val v':args) `Arrow` res) ([] `Arrow` (Val v:stack))
-        matchStack _ (Any:_) res = return $ res
-        matchStack (Val v:stack) (Var:args) res =
-            let subst = replace Var (Val v) in
-            matchStack stack (subst args) (subst res)
-        matchStack (Var:stack) (Val v:args) res =
-            let subst = replace Var (Val v) in
-            matchStack stack (subst args) (subst res)
-        matchStack (Val v:stack) (NonRefVar:args) res =
-            let subst = replace NonRefVar (Val v) in
-            if isRef v
-            then throwError $ TypeMismatch (empty ==> empty) (empty ==> empty)
-            else matchStack stack (subst args) (subst res)
-        matchStack (NonRefVar:stack) (Val v:args) res =
-            let subst = replace NonRefVar (Val v) in
-            if isRef v
-            then throwError $ TypeMismatch (empty ==> empty) (empty ==> empty)
-            else matchStack stack (subst args) (subst res)
-        matchStack (Var:stack) (NonRefVar:args) res =
-            let subst = replace NonRefVar NonRefVar in
-            matchStack stack (subst args) (subst res)
-        matchStack (NonRefVar:stack) (Var:args) res =
-            let subst = replace Var NonRefVar in
-            matchStack stack (subst args) (subst res)
-        matchStack stack [] res = return $ res ++ stack
-        matchStack [] args res = throwError $ TypeMismatch ((reverse args) `Arrow` res) ([] `Arrow` [])
-        matchStack st args res = error $ "inconsistent checker state: " ++ show (st, args, res)
+
+isRef :: ValueType -> Bool
+isRef (Func)   = True
+isRef (Extern) = True
+isRef _        = False
+
+matchStack :: [VType] -> [VType] -> [VType] -> Checker [VType]
+matchStack stack@(Any:_) _arg res = return $ res ++ stack
+matchStack (Val v:stack) (Val v':args) res =
+    if v == v'
+    then matchStack stack args res
+    else throwError $ TypeMismatch ((reverse $ Val v':args) `Arrow` res) ([] `Arrow` (Val v:stack))
+matchStack _ (Any:_) res = return $ res
+matchStack (Val v:stack) (Var:args) res =
+    let subst = replace Var (Val v) in
+    matchStack stack (subst args) (subst res)
+matchStack (Var:stack) (Val v:args) res =
+    let subst = replace Var (Val v) in
+    matchStack stack (subst args) (subst res)
+matchStack (Val v:stack) (NonRefVar:args) res =
+    let subst = replace NonRefVar (Val v) in
+    if isRef v
+    then throwError $ TypeMismatch (empty ==> empty) (empty ==> empty)
+    else matchStack stack (subst args) (subst res)
+matchStack (NonRefVar:stack) (Val v:args) res =
+    let subst = replace NonRefVar (Val v) in
+    if isRef v
+    then throwError $ TypeMismatch (empty ==> empty) (empty ==> empty)
+    else matchStack stack (subst args) (subst res)
+matchStack (Var:stack) (NonRefVar:args) res =
+    let subst = replace NonRefVar NonRefVar in
+    matchStack stack (subst args) (subst res)
+matchStack (NonRefVar:stack) (Var:args) res =
+    let subst = replace Var NonRefVar in
+    matchStack stack (subst args) (subst res)
+matchStack stack [] res = return $ res ++ stack
+matchStack [] args res = throwError $ TypeMismatch ((reverse args) `Arrow` res) ([] `Arrow` [])
+matchStack st args res = error $ "inconsistent checker state: " ++ show (st, args, res)
 
 getExpressionType :: Expression -> Checker Arrow
 getExpressionType = getExpressionTypeWithInput []
diff --git a/tests/Test.hs b/tests/Test.hs
index 14cf2cc..657a1e2 100644
--- a/tests/Test.hs
+++ b/tests/Test.hs
@@ -19,7 +19,7 @@ main = do
   files <-
     filter (not . List.isPrefixOf "simd") . filter (List.isSuffixOf ".wast")
       <$> Directory.listDirectory "tests/spec"
-  -- let files = ["unreached-valid.wast"]
+  -- let files = ["bulk.wast"]
   scriptTestCases <- (`mapM` files) $ \file -> do
     test <- LBS.readFile ("tests/spec/" ++ file)
     return $ testCase file $ do