parse and implement simd_i32x4_trunc_sat_f64x2 instruction

src/Language/Wasm/Interpreter.hs

@@ -2277,9 +2277,9 @@ 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 v:rest) } (I32x4TruncSatF32x4 signed) =
+        step ctx@EvalCtx{ stack = (VV128 v:rest) } (I32x4TruncSatF signed sz) =
             let
-                floatTruncSat :: Bool -> Float -> Word32
+                floatTruncSat :: (RealFloat f) => Bool -> f -> Word32
                 floatTruncSat True v  | isNaN v = 0
                 floatTruncSat True v  | v >= 2^31 = 0x7fffffff
                 floatTruncSat True v  | v < -2^31 - 1 = 0x80000000
@@ -2288,7 +2288,11 @@ eval budget store inst FunctionInstance { funcType, moduleInstance, code = Funct
                 floatTruncSat False v | v >= 2^32 = 0xffffffff
                 floatTruncSat False v = truncate v
             in
-            let r = floatTruncSat signed . ByteArray.indexByteArray @Float v <$> [0..3] in
+            let r = case sz of
+                    BS32 -> floatTruncSat signed . ByteArray.indexByteArray @Float v <$> [0..3]
+                    BS64 -> (floatTruncSat signed . ByteArray.indexByteArray @Double v <$> [0..1]) ++ [0, 0]
+                    _ -> error "impossible due to validation"
+            in
             return $ Done ctx { stack = VV128 (ByteArray.byteArrayFromList @Word32 r) : 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/Structure.hs

@@ -276,7 +276,7 @@ data Instruction index =
     | F64x2PromoteLowF32x4
     | F32x4DemoteF64x2Zero
     | V128IExtend SimdShape SimdShape {- high -} Bool {- signed -} Bool
-    | I32x4TruncSatF32x4 {- signed -} Bool
+    | I32x4TruncSatF {- signed -} Bool {- Float Size -} BitSize
     deriving (Show, Eq, Generic, NFData)
 
 type Expression = [Instruction Natural]

src/Language/Wasm/Validate.hs

@@ -629,7 +629,7 @@ getInstrType _ F32x4DemoteF64x2Zero =
     return $ V128 ==> V128
 getInstrType _ (V128IExtend _ _ _ _) =
     return $ V128 ==> V128
-getInstrType _ (I32x4TruncSatF32x4 _) =
+getInstrType _ (I32x4TruncSatF _ _) =
     return $ V128 ==> V128
 
 getShapeElemType :: SimdShape -> ValueType

tests/Test.hs

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