From 902819aee7d49ce7678752188f5778f801c6dbe2 Mon Sep 17 00:00:00 2001
From: Ilya Rezvov <rezvov.ilya@gmail.com>
Date: Sun, 24 Sep 2023 19:32:10 -0600
Subject: [PATCH] implement extadd simd operation

---
 src/Language/Wasm/Interpreter.hs | 26 ++++++++++++++++++++++++++
 src/Language/Wasm/Parser.y       |  8 ++++++++
 src/Language/Wasm/Structure.hs   |  1 +
 tests/Test.hs                    |  2 +-
 4 files changed, 36 insertions(+), 1 deletion(-)

diff --git a/src/Language/Wasm/Interpreter.hs b/src/Language/Wasm/Interpreter.hs
index a45b543..e64a13e 100644
--- a/src/Language/Wasm/Interpreter.hs
+++ b/src/Language/Wasm/Interpreter.hs
@@ -1433,6 +1433,32 @@ eval budget store inst FunctionInstance { funcType, moduleInstance, code = Funct
                     $ (fromIntegral . popCount) . ByteArray.indexByteArray @Word8 v <$> [0..15]
             in
             return $ Done ctx { stack = VV128 r : rest }
+        step ctx@EvalCtx{ stack = (VV128 v:rest) } (IUnOp (BS128 shape) (IExtAddPairwise signed)) =
+            let count = case shape of
+                    I16x8 -> 8
+                    I32x4 -> 4
+                    _ -> error "impossible due to validation"
+            in
+            let high = [1,3..2*(count - 1) + 1]in
+            let low = [0,2..2 *(count-1)] in
+            let r = case shape of
+                    I16x8 ->
+                        let op = if signed
+                                then \a b -> asWord16 $ fromIntegral (asInt8 a) + fromIntegral (asInt8 b)
+                                else \a b -> fromIntegral a + fromIntegral b
+                        in
+                        ByteArray.byteArrayFromListN count
+                            $ zipWith op (ByteArray.indexByteArray v <$> high) (ByteArray.indexByteArray v <$> low)
+                    I32x4 ->
+                        let op = if signed
+                                then \a b -> asWord32 $ fromIntegral (asInt16 a) + fromIntegral (asInt16 b)
+                                else \a b -> fromIntegral a + fromIntegral b
+                        in
+                        ByteArray.byteArrayFromListN count
+                            $ zipWith op (ByteArray.indexByteArray v <$> high) (ByteArray.indexByteArray v <$> low)
+                    _ -> 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) IAdd) =
             let r = case shape of
                     I8x16 -> lanewise @Word8 shape v1 v2 (+)
diff --git a/src/Language/Wasm/Parser.y b/src/Language/Wasm/Parser.y
index 19edab5..a733446 100644
--- a/src/Language/Wasm/Parser.y
+++ b/src/Language/Wasm/Parser.y
@@ -425,6 +425,10 @@ import Language.Wasm.Lexer (
 'i16x8.sub_sat_u'     { Lexeme _ (TKeyword "i16x8.sub_sat_u") }
 'i8x16.avgr_u'        { Lexeme _ (TKeyword "i8x16.avgr_u") }
 'i16x8.avgr_u'        { Lexeme _ (TKeyword "i16x8.avgr_u") }
+'i16x8.extadd_pairwise_i8x16_s' { Lexeme _ (TKeyword "i16x8.extadd_pairwise_i8x16_s") }
+'i32x4.extadd_pairwise_i16x8_s' { Lexeme _ (TKeyword "i32x4.extadd_pairwise_i16x8_s") }
+'i16x8.extadd_pairwise_i8x16_u' { Lexeme _ (TKeyword "i16x8.extadd_pairwise_i8x16_u") }
+'i32x4.extadd_pairwise_i16x8_u' { Lexeme _ (TKeyword "i32x4.extadd_pairwise_i16x8_u") }
 'i16x8.extmul_low_i8x16_s' { Lexeme _ (TKeyword "i16x8.extmul_low_i8x16_s") }
 'i32x4.extmul_low_i16x8_s' { Lexeme _ (TKeyword "i32x4.extmul_low_i16x8_s") }
 'i64x2.extmul_low_i32x4_s' { Lexeme _ (TKeyword "i64x2.extmul_low_i32x4_s") }
@@ -1058,6 +1062,10 @@ plaininstr :: { PlainInstr }
     | 'i16x8.neg'                        { IUnOp (BS128 I16x8) INeg }
     | 'i32x4.neg'                        { IUnOp (BS128 I32x4) INeg }
     | 'i64x2.neg'                        { IUnOp (BS128 I64x2) INeg }
+    | 'i16x8.extadd_pairwise_i8x16_s'    { IUnOp (BS128 I16x8) (IExtAddPairwise True) }
+    | 'i32x4.extadd_pairwise_i16x8_s'    { IUnOp (BS128 I32x4) (IExtAddPairwise True) }
+    | 'i16x8.extadd_pairwise_i8x16_u'    { IUnOp (BS128 I16x8) (IExtAddPairwise False) }
+    | 'i32x4.extadd_pairwise_i16x8_u'    { IUnOp (BS128 I32x4) (IExtAddPairwise False) }
     | 'i8x16.bitmask'                    { V128BitMask I8x16 }
     | 'i16x8.bitmask'                    { V128BitMask I16x8 }
     | 'i32x4.bitmask'                    { V128BitMask I32x4 }
diff --git a/src/Language/Wasm/Structure.hs b/src/Language/Wasm/Structure.hs
index b1ee60b..8fde116 100644
--- a/src/Language/Wasm/Structure.hs
+++ b/src/Language/Wasm/Structure.hs
@@ -74,6 +74,7 @@ data IUnOp =
     | INot
     | IAbs
     | INeg
+    | IExtAddPairwise {- Signed -} Bool
     deriving (Show, Eq, Generic, NFData)
 
 data IBinOp =
diff --git a/tests/Test.hs b/tests/Test.hs
index fb0a8fc..e774362 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_i64x2_extmul_i32x4.wast"]
+  -- let files = ["simd_i32x4_extadd_pairwise_i16x8.wast"]
   scriptTestCases <- (`mapM` files) $ \file -> do
     test <- LBS.readFile ("tests/spec/" ++ file)
     return $ testCase file $ do