parse shuffle and replace_lane

src/Language/Wasm/Interpreter.hs

@@ -1283,6 +1283,15 @@ 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) ISub) =
+            let r = case shape of
+                    I8x16 -> lanewise @Word8 shape v1 v2 (-)
+                    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 = (VF32 v:rest) } (FUnOp BS32 FAbs) =
             return $ Done ctx { stack = VF32 (abs v) : rest }
         step ctx@EvalCtx{ stack = (VF32 v:rest) } (FUnOp BS32 FNeg) =
@@ -1490,31 +1499,33 @@ eval budget store inst FunctionInstance { funcType, moduleInstance, code = Funct
         step ctx@EvalCtx{ stack = (VI64 v:rest) } (FReinterpretI BS64) =
             return $ Done ctx { stack = VF64 (wordToDouble v) : rest }
         -- SIMD
+        step ctx@EvalCtx{ stack = (VV128 v2:VV128 v1:rest) } (I8x16Shuffle idxs) =
+            let get i = if i >= 16
+                    then ByteArray.indexByteArray @Word8 v2 (i - 16)
+                    else ByteArray.indexByteArray @Word8 v1 i
+            in
+            let val = ByteArray.byteArrayFromListN @Word8 16 $ get <$> idxs in
+            return $ Done ctx { stack = VV128 val : rest }
         step ctx@EvalCtx{ stack = (VV128 s:VV128 a:rest) } I8x16Swizzle =
             let get i = if i > 15 then 0 else ByteArray.indexByteArray @Word8 a $ fromIntegral i in
             let lanes = get . ByteArray.indexByteArray @Word8 s <$> [0..15] in
             let val = ByteArray.byteArrayFromListN @Word8 16 lanes in
             return $ Done ctx { stack = VV128 val : rest }
-        step ctx@EvalCtx{ stack } (V128Splat shape) = do
+        step ctx@EvalCtx{ stack = (h:rest) } (V128Splat shape) = do
-            let (val, rest) = case shape of
+            let val = case (shape, h) of
-                    I8x16 ->
+                    (I8x16, VI32 v) ->
-                        let (VI32 v:rest) = stack in
+                        ByteArray.byteArrayFromListN @Word8 16 $ take 16 $ repeat $ fromIntegral $ asInt32 v
-                        (ByteArray.byteArrayFromListN @Word8 16 $ take 16 $ repeat $ fromIntegral $ asInt32 v, rest)
+                    (I16x8, VI32 v) ->
-                    I16x8 ->
+                        ByteArray.byteArrayFromListN @Word16 8 $ take 8 $ repeat $ fromIntegral $ asInt32 v
-                        let (VI32 v:rest) = stack in
+                    (I32x4, VI32 v) ->
-                        (ByteArray.byteArrayFromListN @Word16 8 $ take 8 $ repeat $ fromIntegral $ asInt32 v, rest)
+                        ByteArray.byteArrayFromListN @Word32 4 $ take 4 $ repeat v
-                    I32x4 ->
+                    (I64x2, VI64 v) ->
-                        let (VI32 v:rest) = stack in
+                        ByteArray.byteArrayFromListN @Word64 2 [v, v]
-                        (ByteArray.byteArrayFromListN @Word32 4 $ take 4 $ repeat v, rest)
+                    (F32x4, VF32 f) ->
-                    I64x2 ->
+                        ByteArray.byteArrayFromListN @Word32 4 $ take 4 $ repeat $ floatToWord f
-                        let (VI64 v:rest) = stack in
+                    (F64x2, VF64 d) ->
-                        (ByteArray.byteArrayFromListN @Word64 2 [v, v], rest)
+                        ByteArray.byteArrayFromListN @Word64 2 [doubleToWord d, doubleToWord d]
-                    F32x4 ->
+                    _ -> error "impossible due to validation"
-                        let (VF32 f:rest) = stack in
-                        (ByteArray.byteArrayFromListN @Word32 4 $ take 4 $ repeat $ floatToWord f, rest)
-                    F64x2 ->
-                        let (VF64 d:rest) = stack in
-                        (ByteArray.byteArrayFromListN @Word64 2 [doubleToWord d, doubleToWord d], rest)
             return $ Done ctx { stack = VV128 val : rest }
         step ctx@EvalCtx{ stack = (VV128 v:rest) } (V128ExtractLane shape idx signed) = do
             let val = case shape of
@@ -1538,7 +1549,31 @@ eval budget store inst FunctionInstance { funcType, moduleInstance, code = Funct
                         VF32 $ wordToFloat $ ByteArray.indexByteArray @Word32 v (fromIntegral idx)
                     F64x2 ->
                         VF64 $ wordToDouble $ ByteArray.indexByteArray @Word64 v (fromIntegral idx)
+                    _ -> error "impossible due to validation"
             return $ Done ctx { stack = val : rest }
+        step ctx@EvalCtx{ stack = (lane:VV128 v:rest) } (V128ReplaceLane shape idx) = do
+            arr <- ByteArray.thawByteArray v 0 16
+            val <- case (shape, lane) of
+                    (I8x16, VI32 c) -> do
+                        ByteArray.writeByteArray @Word8 arr (fromIntegral idx) (fromIntegral c)
+                        ByteArray.unsafeFreezeByteArray arr
+                    (I16x8, VI32 c) -> do
+                        ByteArray.writeByteArray @Word16 arr (fromIntegral idx) (fromIntegral c)
+                        ByteArray.unsafeFreezeByteArray arr
+                    (I32x4, VI32 c) -> do
+                        ByteArray.writeByteArray arr (fromIntegral idx) c
+                        ByteArray.unsafeFreezeByteArray arr
+                    (I64x2, VI64 c) -> do
+                        ByteArray.writeByteArray arr (fromIntegral idx) c
+                        ByteArray.unsafeFreezeByteArray arr
+                    (F32x4, VF32 c) -> do
+                        ByteArray.writeByteArray arr (fromIntegral idx) $ floatToWord c
+                        ByteArray.unsafeFreezeByteArray arr
+                    (F64x2, VF64 c) -> do
+                        ByteArray.writeByteArray arr (fromIntegral idx) $ doubleToWord c
+                        ByteArray.unsafeFreezeByteArray arr
+                    _ -> error "impossible due to validation"
+            return $ Done ctx { stack = VV128 val : rest }
         step EvalCtx{ stack } instr = error $ "Error during evaluation of instruction: " ++ show instr ++ ". Stack " ++ show stack
 eval _ _ _ HostInstance { funcType, hostCode } args = Just <$> hostCode args
 

src/Language/Wasm/Parser.y

@@ -352,6 +352,7 @@ import Language.Wasm.Lexer (
 'start'               { Lexeme _ (TKeyword "start") }
 'module'              { Lexeme _ (TKeyword "module") }
 -- simd
+'i8x16.shuffle'       { Lexeme _ (TKeyword "i8x16.shuffle") }
 'i8x16.swizzle'       { Lexeme _ (TKeyword "i8x16.swizzle") }
 'i8x16.splat'         { Lexeme _ (TKeyword "i8x16.splat") }
 'i16x8.splat'         { Lexeme _ (TKeyword "i16x8.splat") }
@@ -367,8 +368,27 @@ import Language.Wasm.Lexer (
 'i64x2.extract_lane'  { Lexeme _ (TKeyword "i64x2.extract_lane") }
 'f32x4.extract_lane'  { Lexeme _ (TKeyword "f32x4.extract_lane") }
 'f64x2.extract_lane'  { Lexeme _ (TKeyword "f64x2.extract_lane") }
+'i8x16.replace_lane'  { Lexeme _ (TKeyword "i8x16.replace_lane") }
+'i16x8.replace_lane'  { Lexeme _ (TKeyword "i16x8.replace_lane") }
+'i32x4.replace_lane'  { Lexeme _ (TKeyword "i32x4.replace_lane") }
+'i64x2.replace_lane'  { Lexeme _ (TKeyword "i64x2.replace_lane") }
+'f32x4.replace_lane'  { Lexeme _ (TKeyword "f32x4.replace_lane") }
+'f64x2.replace_lane'  { Lexeme _ (TKeyword "f64x2.replace_lane") }
+'i8x16.all_true'      { Lexeme _ (TKeyword "i8x16.all_true") }
+'i16x8.all_true'      { Lexeme _ (TKeyword "i16x8.all_true") }
+'i32x4.all_true'      { Lexeme _ (TKeyword "i32x4.all_true") }
+'i64x2.all_true'      { Lexeme _ (TKeyword "i64x2.all_true") }
+'f32x4.all_true'      { Lexeme _ (TKeyword "f32x4.all_true") }
+'f64x2.all_true'      { Lexeme _ (TKeyword "f64x2.all_true") }
+'v128.any_true'       { Lexeme _ (TKeyword "v128.any_true") }
+'i8x16.add'           { Lexeme _ (TKeyword "i8x16.add") }
+'i16x8.add'           { Lexeme _ (TKeyword "i16x8.add") }
 'i32x4.add'           { Lexeme _ (TKeyword "i32x4.add") }
 'i64x2.add'           { Lexeme _ (TKeyword "i64x2.add") }
+'i8x16.sub'           { Lexeme _ (TKeyword "i8x16.sub") }
+'i16x8.sub'           { Lexeme _ (TKeyword "i16x8.sub") }
+'i32x4.sub'           { Lexeme _ (TKeyword "i32x4.sub") }
+'i64x2.sub'           { Lexeme _ (TKeyword "i64x2.sub") }
 -- script extension
 'binary'              { Lexeme _ (TKeyword "binary") }
 'quote'               { Lexeme _ (TKeyword "quote") }
@@ -713,13 +733,24 @@ plaininstr :: { PlainInstr }
     | 'f32.reinterpret_i32'          { FReinterpretI BS32 }
     | 'f64.reinterpret_i64'          { FReinterpretI BS64 }
     -- simd
+    | 'i8x16.shuffle' i8 i8 i8 i8 i8 i8 i8 i8 i8 i8 i8 i8 i8 i8 i8 i8 {
+        I8x16Shuffle $ map fromIntegral
+            [$2, $3, $4, $5, $6, $7, $8, $9, $10, $11, $12, $13, $14, $15, $16, $17]
+    }
     | 'i8x16.swizzle'                { I8x16Swizzle }
+    | 'v128.any_true'                { V128AnyTrue }
     | 'i8x16.splat'                  { V128Splat I8x16 }
     | 'i16x8.splat'                  { V128Splat I16x8 }
     | 'i32x4.splat'                  { V128Splat I32x4 }
     | 'i64x2.splat'                  { V128Splat I64x2 }
     | 'f32x4.splat'                  { V128Splat F32x4 }
     | 'f64x2.splat'                  { V128Splat F64x2 }
+    | 'i8x16.all_true'               { V128AllTrue I8x16 }
+    | 'i16x8.all_true'               { V128AllTrue I16x8 }
+    | 'i32x4.all_true'               { V128AllTrue I32x4 }
+    | 'i64x2.all_true'               { V128AllTrue I64x2 }
+    | 'f32x4.all_true'               { V128AllTrue F32x4 }
+    | 'f64x2.all_true'               { V128AllTrue F64x2 }
     | 'i8x16.extract_lane_s' u32     { V128ExtractLane I8x16 $2 True }
     | 'i16x8.extract_lane_s' u32     { V128ExtractLane I16x8 $2 True }
     | 'i8x16.extract_lane_u' u32     { V128ExtractLane I8x16 $2 False }
@@ -728,8 +759,20 @@ plaininstr :: { PlainInstr }
     | 'i64x2.extract_lane' u32       { V128ExtractLane I64x2 $2 False }
     | 'f32x4.extract_lane' u32       { V128ExtractLane F32x4 $2 False }
     | 'f64x2.extract_lane' u32       { V128ExtractLane F64x2 $2 False }
+    | 'i8x16.replace_lane' u32       { V128ReplaceLane I8x16 $2 }
+    | 'i16x8.replace_lane' u32       { V128ReplaceLane I16x8 $2 }
+    | 'i32x4.replace_lane' u32       { V128ReplaceLane I32x4 $2 }
+    | 'i64x2.replace_lane' u32       { V128ReplaceLane I64x2 $2 }
+    | 'f32x4.replace_lane' u32       { V128ReplaceLane F32x4 $2 }
+    | 'f64x2.replace_lane' u32       { V128ReplaceLane F64x2 $2 }
+    | 'i8x16.add'                    { IBinOp (BS128 I8x16) IAdd }
+    | 'i16x8.add'                    { IBinOp (BS128 I16x8) IAdd }
     | 'i32x4.add'                    { IBinOp (BS128 I32x4) IAdd }
     | 'i64x2.add'                    { IBinOp (BS128 I64x2) IAdd }
+    | 'i8x16.sub'                    { IBinOp (BS128 I8x16) ISub }
+    | 'i16x8.sub'                    { IBinOp (BS128 I16x8) ISub }
+    | 'i32x4.sub'                    { IBinOp (BS128 I32x4) ISub }
+    | 'i64x2.sub'                    { IBinOp (BS128 I64x2) ISub }
 
 typeuse(next)
     : '(' typeuse1(folded_instr_list(next), instruction_list(next)) {
@@ -1433,6 +1476,10 @@ data PlainInstr =
     -- Vector instructions
     | V128Splat SimdShape
     | V128ExtractLane SimdShape Natural Bool
+    | V128ReplaceLane SimdShape Natural
+    | V128AllTrue SimdShape
+    | V128AnyTrue
+    | I8x16Shuffle [Int]
     | I8x16Swizzle
     deriving (Show, Eq)
 
@@ -1989,6 +2036,10 @@ desugarize fields = do
         synInstrToStruct _ (PlainInstr (FReinterpretI sz)) = return $ S.FReinterpretI sz
         synInstrToStruct _ (PlainInstr (V128Splat shape)) = return $ S.V128Splat shape
         synInstrToStruct _ (PlainInstr (V128ExtractLane shape idx sign)) = return $ S.V128ExtractLane shape idx sign
+        synInstrToStruct _ (PlainInstr (V128ReplaceLane shape idx)) = return $ S.V128ReplaceLane shape idx
+        synInstrToStruct _ (PlainInstr (V128AllTrue shape)) = return $ S.V128AllTrue shape
+        synInstrToStruct _ (PlainInstr V128AnyTrue) = return $ S.V128AnyTrue
+        synInstrToStruct _ (PlainInstr (I8x16Shuffle idxs)) = return $ S.I8x16Shuffle idxs
         synInstrToStruct _ (PlainInstr I8x16Swizzle) = return $ S.I8x16Swizzle
         synInstrToStruct ctx@FunCtx { ctxMod = Module { types } } BlockInstr {label, blockType, body} = do
             let ctx' = ctx { ctxLabels = label : ctxLabels ctx }

src/Language/Wasm/Structure.hs

@@ -230,7 +230,11 @@ data Instruction index =
     -- Vector instructions
     | V128Splat SimdShape
     | V128ExtractLane SimdShape index {- signed -} Bool
+    | V128ReplaceLane SimdShape index
+    | V128AllTrue SimdShape
+    | V128AnyTrue
     | I8x16Swizzle
+    | I8x16Shuffle [Int]
     deriving (Show, Eq, Generic, NFData)
 
 type Expression = [Instruction Natural]

src/Language/Wasm/Validate.hs

@@ -524,10 +524,18 @@ getInstrType _ (FReinterpretI BS32) = return $ I32 ==> F32
 getInstrType _ (FReinterpretI BS64) = return $ I64 ==> F64
 getInstrType _ I8x16Swizzle =
     return $ [V128, V128] ==> V128
+getInstrType _ (I8x16Shuffle _) =
+    return $ [V128, V128] ==> V128
 getInstrType _ (V128Splat shape) =
     return $ getShapeElemType shape ==> V128
 getInstrType _ (V128ExtractLane shape _ _) =
     return $ V128 ==> getShapeElemType shape
+getInstrType _ (V128ReplaceLane shape _) =
+    return $ [V128, getShapeElemType shape] ==> V128
+getInstrType _ (V128AllTrue _) =
+    return $ V128 ==> I32
+getInstrType _ V128AnyTrue =
+    return $ V128 ==> I32
 
 getShapeElemType :: SimdShape -> ValueType
 getShapeElemType I8x16 = I32

tests/Test.hs

@@ -20,7 +20,7 @@ main = do
     filter (List.isPrefixOf "simd") . 
     filter (List.isSuffixOf ".wast")
       <$> Directory.listDirectory "tests/spec"
-  let files = ["simd_splat.wast"]
+  let files = ["simd_lane.wast"]
   scriptTestCases <- (`mapM` files) $ \file -> do
     test <- LBS.readFile ("tests/spec/" ++ file)
     return $ testCase file $ do