From d98d1b718f5c1128b33b9e631f2e83a4cccdf733 Mon Sep 17 00:00:00 2001
From: Ilya Rezvov <rezvov.ilya@gmail.com>
Date: Fri, 8 Sep 2023 22:39:12 -0600
Subject: [PATCH] implement v128.imul

---
 src/Language/Wasm/Interpreter.hs | 8 ++++++++
 src/Language/Wasm/Parser.y       | 6 ++++++
 tests/Test.hs                    | 2 +-
 3 files changed, 15 insertions(+), 1 deletion(-)

diff --git a/src/Language/Wasm/Interpreter.hs b/src/Language/Wasm/Interpreter.hs
index 0ba466b..69c1e9d 100644
--- a/src/Language/Wasm/Interpreter.hs
+++ b/src/Language/Wasm/Interpreter.hs
@@ -1446,6 +1446,14 @@ eval budget store inst FunctionInstance { funcType, moduleInstance, code = Funct
                     _ -> error "impossible due to validation"
             in
             return $ Done ctx { stack = VV128 r : rest }
+        step ctx@EvalCtx{ stack = (VV128 v2:VV128 v1:rest) } (IBinOp (BS128 shape) IMul) =
+            let r = case shape of
+                    I16x8 -> lanewise @Word16 shape v1 v2 (*)
+                    I32x4 -> lanewise @Word32 shape v1 v2 (*)
+                    I64x2 -> lanewise @Word64 shape v1 v2 (*)
+                    _ -> error "impossible due to validation"
+            in
+            return $ Done ctx { stack = VV128 r : rest }
         step ctx@EvalCtx{ stack = (VV128 v2:VV128 v1:rest) } (IBinOp (BS128 shape) IAddSatU) =
             let r = case shape of
                     I8x16 -> lanewise @Word8 shape v1 v2 $ \a b ->
diff --git a/src/Language/Wasm/Parser.y b/src/Language/Wasm/Parser.y
index 1063aa6..0740846 100644
--- a/src/Language/Wasm/Parser.y
+++ b/src/Language/Wasm/Parser.y
@@ -421,6 +421,9 @@ import Language.Wasm.Lexer (
 'i16x8.add_sat_u'     { Lexeme _ (TKeyword "i16x8.add_sat_u") }
 'i8x16.sub_sat_u'     { Lexeme _ (TKeyword "i8x16.sub_sat_u") }
 'i16x8.sub_sat_u'     { Lexeme _ (TKeyword "i16x8.sub_sat_u") }
+'i16x8.mul'           { Lexeme _ (TKeyword "i16x8.mul") }
+'i32x4.mul'           { Lexeme _ (TKeyword "i32x4.mul") }
+'i64x2.mul'           { Lexeme _ (TKeyword "i64x2.mul") }
 'i8x16.abs'           { Lexeme _ (TKeyword "i8x16.abs") }
 'i16x8.abs'           { Lexeme _ (TKeyword "i16x8.abs") }
 'i32x4.abs'           { Lexeme _ (TKeyword "i32x4.abs") }
@@ -899,6 +902,9 @@ plaininstr :: { PlainInstr }
     | 'i16x8.add_sat_u'                  { IBinOp (BS128 I16x8) IAddSatU }
     | 'i8x16.sub_sat_u'                  { IBinOp (BS128 I8x16) ISubSatU }
     | 'i16x8.sub_sat_u'                  { IBinOp (BS128 I16x8) ISubSatU }
+    | 'i16x8.mul'                        { IBinOp (BS128 I16x8) IMul }
+    | 'i32x4.mul'                        { IBinOp (BS128 I32x4) IMul }
+    | 'i64x2.mul'                        { IBinOp (BS128 I64x2) IMul }
     | 'i8x16.shl'                        { IBinOp (BS128 I8x16) IShl }
     | 'i16x8.shl'                        { IBinOp (BS128 I16x8) IShl }
     | 'i32x4.shl'                        { IBinOp (BS128 I32x4) IShl }
diff --git a/tests/Test.hs b/tests/Test.hs
index e12bb7d..ea4e84a 100644
--- a/tests/Test.hs
+++ b/tests/Test.hs
@@ -20,7 +20,7 @@ main = do
     filter (List.isPrefixOf "simd") . 
     filter (List.isSuffixOf ".wast")
       <$> Directory.listDirectory "tests/spec"
-  -- let files = ["simd_i8x16_sat_arith.wast"]
+  let files = ["simd_i16x8_cmp.wast"]
   scriptTestCases <- (`mapM` files) $ \file -> do
     test <- LBS.readFile ("tests/spec/" ++ file)
     return $ testCase file $ do