Use ByteArray as V128 storage and basic const interpretation

src/Language/Wasm/Parser.y

@@ -54,7 +54,8 @@ import Language.Wasm.Structure (
         ElemType(..),
         Limit(..),
         GlobalType(..),
-        ValueType(..)
+        ValueType(..),
+        SimdShape(..)
     )
 
 import qualified Language.Wasm.Structure as S
@@ -64,7 +65,7 @@ import qualified Data.Text.Lazy as TL
 import qualified Data.Text.Lazy.Encoding as TLEncoding
 import qualified Data.Text.Lazy.Read as TLRead
 
-import qualified Data.ByteString as BS
+import qualified Data.Primitive.ByteArray as ByteArray
 import qualified Data.ByteString.Lazy as LBS
 import qualified Data.ByteString.Lazy.Char8 as LBSChar8
 import Data.Maybe (fromMaybe, fromJust, isNothing, catMaybes)
@@ -73,7 +74,7 @@ import Control.Monad (guard, foldM)
 import Control.Monad.Except (throwError)
 
 import Numeric.Natural (Natural)
-import Data.Word (Word32, Word64, Word8)
+import Data.Word (Word8, Word16, Word32, Word64)
 import Data.Bits ((.|.))
 import Numeric.IEEE (infinity, nan, maxFinite)
 import Language.Wasm.FloatUtils (doubleToFloat, floatToWord, doubleToWord)
@@ -348,6 +349,9 @@ import Language.Wasm.Lexer (
 'offset'              { Lexeme _ (TKeyword "offset") }
 'start'               { Lexeme _ (TKeyword "start") }
 'module'              { Lexeme _ (TKeyword "module") }
+-- simd
+'i32x4.add'           { Lexeme _ (TKeyword "i32x4.add") }
+'i64x2.add'           { Lexeme _ (TKeyword "i64x2.add") }
 -- script extension
 'binary'              { Lexeme _ (TKeyword "binary") }
 'quote'               { Lexeme _ (TKeyword "quote") }
@@ -404,14 +408,14 @@ index :: { Index }
 
 i8 :: { Integer }
     : int {%
-        if $1 >= -(2^7) && $1 <= 2^8
+        if $1 >= -(2^7) && $1 < 2^8
         then Right $ fromIntegral $ if $1 >= 0 then $1 else 2^8 + $1
         else Left ("I8 literal value is out of signed i8 boundaries: " ++ show $1)
     }
 
 i16 :: { Integer }
     : int {%
-        if $1 >= -(2^15) && $1 <= 2^16
+        if $1 >= -(2^15) && $1 < 2^16
         then Right $ fromIntegral $ if $1 >= 0 then $1 else 2^16 + $1
         else Left ("I16 literal value is out of signed i16 boundaries: " ++ show $1)
     }
@@ -689,6 +693,9 @@ plaininstr :: { PlainInstr }
     | 'i64.reinterpret_f64'          { IReinterpretF BS64 }
     | 'f32.reinterpret_i32'          { FReinterpretI BS32 }
     | 'f64.reinterpret_i64'          { FReinterpretI BS64 }
+    -- simd
+    | 'i32x4.add'                    { IBinOp (BS128 I32x4) IAdd }
+    | 'i64x2.add'                    { IBinOp (BS128 I64x2) IAdd }
 
 typeuse(next)
     : '(' typeuse1(folded_instr_list(next), instruction_list(next)) {
@@ -1285,8 +1292,6 @@ type MemoryIndex = Index
 type ElemIndex = Index
 type DataIndex = Index
 
-data SimdShape = I8x16 | I16x8 | I32x4 | I64x2 | F32x4 | F64x2 deriving (Show, Eq)
-
 data V128Rep =
     I8x16Const [Integer]
     | I16x8Const [Integer]
@@ -1592,37 +1597,19 @@ data FunCtx = FunCtx {
     ctxParams :: [ParamType]
 } deriving (Eq, Show)
 
-unpackWord32 :: Word32 -> [Word8]
-unpackWord32 w = [
-    fromIntegral $ w `rem` 0x100,
-    fromIntegral $ w `rem` 0x10000 `div` 0x100,
-    fromIntegral $ w `rem` 0x1000000 `div` 0x10000,
-    fromIntegral $ w `rem` 0x100000000 `div` 0x1000000]
-
-unpackWord64 :: Word64 -> [Word8]
-unpackWord64 w = [
-    fromIntegral $ w `rem` 0x100,
-    fromIntegral $ w `rem` 0x10000 `div` 0x100,
-    fromIntegral $ w `rem` 0x1000000 `div` 0x10000,
-    fromIntegral $ w `rem` 0x100000000 `div` 0x1000000,
-    fromIntegral $ w `rem` 0x10000000000 `div` 0x100000000,
-    fromIntegral $ w `rem` 0x1000000000000 `div` 0x10000000000,
-    fromIntegral $ w `rem` 0x100000000000000 `div` 0x1000000000000,
-    fromIntegral $ w `rem` 0x10000000000000000 `div` 0x100000000000000]
-
-v128RepToBytes :: V128Rep -> Either String BS.ByteString
-v128RepToBytes (I8x16Const bytes) = return $ BS.pack $ fromIntegral <$> bytes
+v128RepToBytes :: V128Rep -> Either String ByteArray.ByteArray
+v128RepToBytes (I8x16Const bytes) =
+    return $ ByteArray.byteArrayFromListN 16 $ (fromIntegral :: Integer -> Word8) <$> bytes
 v128RepToBytes (I16x8Const words) =
-    let asWord8 w = [fromIntegral $ w `rem` 0x100, fromIntegral $ w `rem` 0x10000 `div` 0x100] in
-    return $ BS.pack $ concat $ asWord8 <$> words
+    return $ ByteArray.byteArrayFromListN 8 $ (fromIntegral :: Integer -> Word16) <$> words
 v128RepToBytes (I32x4Const dwords) =
-    return $ BS.pack $ concat $ unpackWord32 . integerToWord32 <$> dwords
+    return $ ByteArray.byteArrayFromListN 4 $ integerToWord32 <$> dwords
 v128RepToBytes (I64x2Const qwords) =
-    return $ BS.pack $ concat $ unpackWord64 . integerToWord64 <$> qwords
+    return $ ByteArray.byteArrayFromListN 2 $ integerToWord64 <$> qwords
 v128RepToBytes (F32x4Const floats) =
-    BS.pack . concat <$> mapM (fmap (unpackWord32 . floatToWord) . asFloat) floats
+    ByteArray.byteArrayFromListN 4 <$> mapM (fmap floatToWord . asFloat) floats
 v128RepToBytes (F64x2Const doubles) =
-    BS.pack . concat <$> mapM (fmap (unpackWord64 . doubleToWord) . asDouble) doubles
+    ByteArray.byteArrayFromListN 2 <$> mapM (fmap doubleToWord . asDouble) doubles
 
 constInstructionToValue :: Instruction -> Either String (S.Instruction Natural)
 constInstructionToValue (PlainInstr (I32Const v)) = return $ S.I32Const $ integerToWord32 v