implement i8x16.swizzle and extract_lane

src/Language/Wasm/Interpreter.hs

@@ -1489,6 +1489,12 @@ eval budget store inst FunctionInstance { funcType, moduleInstance, code = Funct
             return $ Done ctx { stack = VF32 (wordToFloat v) : rest }
         step ctx@EvalCtx{ stack = (VI64 v:rest) } (FReinterpretI BS64) =
             return $ Done ctx { stack = VF64 (wordToDouble v) : rest }
+        -- SIMD
+        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
             let (val, rest) = case shape of
                     I8x16 ->
@@ -1510,6 +1516,29 @@ eval budget store inst FunctionInstance { funcType, moduleInstance, code = Funct
                         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
+                    I8x16 ->
+                        let s = if signed
+                                then \i -> if i >= 0x80 then -1 * fromIntegral (0xFF - i + 1) else fromIntegral i
+                                else fromIntegral
+                        in
+                        VI32 $ asWord32 $ s $ ByteArray.indexByteArray @Word8 v (fromIntegral idx)
+                    I16x8 ->
+                        let s = if signed
+                                then \i -> if i >= 0x8000 then -1 * fromIntegral (0xFFFF - i + 1) else fromIntegral i
+                                else fromIntegral
+                        in
+                        VI32 $ asWord32 $ s $ ByteArray.indexByteArray @Word16 v (fromIntegral idx)
+                    I32x4 ->
+                        VI32 $ ByteArray.indexByteArray @Word32 v (fromIntegral idx)
+                    I64x2 ->
+                        VI64 $ ByteArray.indexByteArray @Word64 v (fromIntegral idx)
+                    F32x4 ->
+                        VF32 $ wordToFloat $ ByteArray.indexByteArray @Word32 v (fromIntegral idx)
+                    F64x2 ->
+                        VF64 $ wordToDouble $ ByteArray.indexByteArray @Word64 v (fromIntegral idx)
+            return $ Done ctx { stack = 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,12 +352,21 @@ import Language.Wasm.Lexer (
 'start'               { Lexeme _ (TKeyword "start") }
 'module'              { Lexeme _ (TKeyword "module") }
 -- simd
+'i8x16.swizzle'       { Lexeme _ (TKeyword "i8x16.swizzle") }
 'i8x16.splat'         { Lexeme _ (TKeyword "i8x16.splat") }
 'i16x8.splat'         { Lexeme _ (TKeyword "i16x8.splat") }
 'i32x4.splat'         { Lexeme _ (TKeyword "i32x4.splat") }
 'i64x2.splat'         { Lexeme _ (TKeyword "i64x2.splat") }
 'f32x4.splat'         { Lexeme _ (TKeyword "f32x4.splat") }
 'f64x2.splat'         { Lexeme _ (TKeyword "f64x2.splat") }
+'i8x16.extract_lane_u'{ Lexeme _ (TKeyword "i8x16.extract_lane_u") }
+'i16x8.extract_lane_u'{ Lexeme _ (TKeyword "i16x8.extract_lane_u") }
+'i8x16.extract_lane_s'{ Lexeme _ (TKeyword "i8x16.extract_lane_s") }
+'i16x8.extract_lane_s'{ Lexeme _ (TKeyword "i16x8.extract_lane_s") }
+'i32x4.extract_lane'  { Lexeme _ (TKeyword "i32x4.extract_lane") }
+'i64x2.extract_lane'  { Lexeme _ (TKeyword "i64x2.extract_lane") }
+'f32x4.extract_lane'  { Lexeme _ (TKeyword "f32x4.extract_lane") }
+'f64x2.extract_lane'  { Lexeme _ (TKeyword "f64x2.extract_lane") }
 'i32x4.add'           { Lexeme _ (TKeyword "i32x4.add") }
 'i64x2.add'           { Lexeme _ (TKeyword "i64x2.add") }
 -- script extension
@@ -704,12 +713,21 @@ plaininstr :: { PlainInstr }
     | 'f32.reinterpret_i32'          { FReinterpretI BS32 }
     | 'f64.reinterpret_i64'          { FReinterpretI BS64 }
     -- simd
+    | 'i8x16.swizzle'                { I8x16Swizzle }
     | '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.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 }
+    | 'i16x8.extract_lane_u' u32     { V128ExtractLane I16x8 $2 False }
+    | 'i32x4.extract_lane' u32       { V128ExtractLane I32x4 $2 False }
+    | 'i64x2.extract_lane' u32       { V128ExtractLane I64x2 $2 False }
+    | 'f32x4.extract_lane' u32       { V128ExtractLane F32x4 $2 False }
+    | 'f64x2.extract_lane' u32       { V128ExtractLane F64x2 $2 False }
     | 'i32x4.add'                    { IBinOp (BS128 I32x4) IAdd }
     | 'i64x2.add'                    { IBinOp (BS128 I64x2) IAdd }
 
@@ -1414,6 +1432,8 @@ data PlainInstr =
     | FReinterpretI BitSize
     -- Vector instructions
     | V128Splat SimdShape
+    | V128ExtractLane SimdShape Natural Bool
+    | I8x16Swizzle
     deriving (Show, Eq)
 
 data TypeDef = TypeDef (Maybe Ident) FuncType deriving (Show, Eq)
@@ -1968,6 +1988,8 @@ desugarize fields = do
         synInstrToStruct _ (PlainInstr (IReinterpretF sz)) = return $ S.IReinterpretF sz
         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 I8x16Swizzle) = return $ S.I8x16Swizzle
         synInstrToStruct ctx@FunCtx { ctxMod = Module { types } } BlockInstr {label, blockType, body} = do
             let ctx' = ctx { ctxLabels = label : ctxLabels ctx }
             bt <- case blockType of

src/Language/Wasm/Structure.hs

@@ -229,6 +229,8 @@ data Instruction index =
     | FReinterpretI BitSize
     -- Vector instructions
     | V128Splat SimdShape
+    | V128ExtractLane SimdShape index {- signed -} Bool
+    | I8x16Swizzle
     deriving (Show, Eq, Generic, NFData)
 
 type Expression = [Instruction Natural]

src/Language/Wasm/Validate.hs

@@ -522,16 +522,20 @@ 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 _ (V128Splat shape) = do
+getInstrType _ I8x16Swizzle =
-    let vt = case shape of
+    return $ [V128, V128] ==> V128
-            I8x16 -> I32
+getInstrType _ (V128Splat shape) =
-            I16x8 -> I32
+    return $ getShapeElemType shape ==> V128
-            I32x4 -> I32
+getInstrType _ (V128ExtractLane shape _ _) =
-            I64x2 -> I64
+    return $ V128 ==> getShapeElemType shape
-            F32x4 -> F32
-            F64x2 -> F64
-    return $ vt ==> V128
 
+getShapeElemType :: SimdShape -> ValueType
+getShapeElemType I8x16 = I32
+getShapeElemType I16x8 = I32
+getShapeElemType I32x4 = I32
+getShapeElemType I64x2 = I64
+getShapeElemType F32x4 = F32
+getShapeElemType F64x2 = F64
 
 replace :: (Eq a) => a -> a -> [a] -> [a]
 replace _ _ [] = []