fail on too big align value deserialization

src/Language/Wasm/Binary.hs

@@ -1,6 +1,7 @@
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE TypeApplications #-}
 
 module Language.Wasm.Binary (
     dumpModule,
@@ -16,6 +17,8 @@ import Data.Bits
 import Data.Word (Word8, Word32, Word64)
 import Data.Int (Int8, Int32, Int64)
 import Data.Serialize
+import Control.Monad (when)
+import Data.Primitive.ByteArray as BA
 import qualified Data.ByteString as BS
 import qualified Data.ByteString.Lazy as LBS
 import qualified Data.Text.Lazy as TL
@@ -221,6 +224,7 @@ instance Serialize ValueType where
     put I64 = putWord8 0x7E
     put F32 = putWord8 0x7D
     put F64 = putWord8 0x7C
+    put V128 = putWord8 0x7B
 
     get = do
         op <- getWord8
@@ -229,6 +233,7 @@ instance Serialize ValueType where
             0x7E -> return I64
             0x7D -> return F32
             0x7C -> return F64
+            0x7B -> return V128
             _ -> fail "unexpected byte in value type position"
 
 instance Serialize FuncType where
@@ -336,6 +341,7 @@ instance Serialize MemArg where
     put MemArg { align, offset } = putULEB128 align >> putULEB128 offset
     get = do
         align <- getULEB128 32
+        when (align >= 32) $ fail "malformed memop flags"
         offset <- getULEB128 32
         return $ MemArg { align, offset }
 
@@ -458,6 +464,10 @@ instance Serialize (Instruction Natural) where
     put (I64Const val) = putWord8 0x42 >> putSLEB128 (asInt64 val)
     put (F32Const val) = putWord8 0x43 >> putFloat32le val
     put (F64Const val) = putWord8 0x44 >> putFloat64le val
+    put (V128Const val) = do
+        putWord8 0xFD
+        putWord8 12
+        put $ BA.foldrByteArray @Word8 (:) [] val
     put I32Eqz = putWord8 0x45
     put (IRelOp BS32 IEq) = putWord8 0x46
     put (IRelOp BS32 INe) = putWord8 0x47
@@ -803,6 +813,13 @@ instance Serialize (Instruction Natural) where
                     0x06 -> return $ ITruncSatFS BS64 BS64
                     0x07 -> return $ ITruncSatFU BS64 BS64
                     _ -> fail "Unknown byte value after misc instruction byte"
+            0xFD -> do -- simd
+                ext <- getULEB128 32
+                case (ext :: Word32) of
+                    0x0C -> do
+                        bytes <- getByteString 16
+                        return $ V128Const $ BA.byteArrayFromListN 16 $ BS.unpack bytes
+                    _ -> fail "Unknown byte value after simd instruction byte"
             byte -> fail $ "Unknown byte value in place of instruction opcode: " ++ (show byte)
 
 putExpression :: Expression -> Put
@@ -877,10 +894,10 @@ instance Serialize ElemSegment where
         putVec $ map Expr elements
 
     get = do
-        op <- getWord8
         let funcIndexes = map ((:[]) . RefFunc . unIndex) <$> getVec
         let elemKind = byteGuard 0x00 >> return FuncRef
-        case op of
+        op <- getULEB128 32
+        case (op :: Word8) of
             0x00 -> do
                 offset <- getExpression
                 ElemSegment FuncRef (Active 0 offset) <$> funcIndexes

src/Language/Wasm/Lexer.x

@@ -39,13 +39,13 @@ $alpha     = [$lower $upper]
 $namepunct = [\! \# \$ \% \& \' \* \+ \- \. \/ \: \< \= \> \? \@ \∖ \^ \_ \` \| \~]
 $idchar    = [$digit $alpha $namepunct]
 $space     = [\  \x09 \x0A \x0D]
-$linechar  = [^ \x09]
+$linechar  = [^ \x09 \x0A \x0D]
 $sign      = [\+ \-]
 $doublequote = \"
 
 @keyword     = $lower $idchar*
 @reserved    = $idchar+
-@linecomment = ";;" $linechar* \x0A
+@linecomment = ";;" $linechar* [\x0A \x0D]
 @startblockcomment = "(;"
 @endblockcomment = ";)"
 @num = $digit (\_? $digit+)*
@@ -80,10 +80,10 @@ tokens :-
 <0> @id                                   { tokenStr TId }
 <0> "("                                   { constToken TOpenBracket }
 <0> ")"                                   { constToken TCloseBracket }
+<0> $sign? @hexfloat                      { parseHexFloat }
 <0> $sign? @num                           { parseDecimalSignedInt }
 <0> $sign? "0x" @hexnum                   { parseHexalSignedInt }
 <0> $sign? @float                         { parseDecFloat }
-<0> $sign? @hexfloat                      { parseHexFloat }
 <0, blockComment> @startblockcomment      { startBlockComment }
 <blockComment> [.\n]                      ;
 <blockComment> @endblockcomment           { endBlockComment }
@@ -119,22 +119,22 @@ minusNaN = negate nan
 inf = infinity
 minusInf = -infinity
 
-parseSign :: (Num a) => LBS.ByteString -> ((a -> a), Int64)
+parseSign :: (Num a) => LBS.ByteString -> ((a -> a), Int64, Maybe Bool)
 parseSign str =
     let Just (ch, _) = LBSUtf8.decode str in
     case ch of
-        '-' -> (negate, 1)
+        '-' -> (negate, 1, Just True)
-        '+' -> (abs, 1)
+        '+' -> (abs, 1, Just False)
-        otherwise -> (abs, 0)
+        otherwise -> (abs, 0, Nothing)
 
-{-# SPECIALIZE parseSign :: LBS.ByteString -> ((Integer -> Integer), Int64) #-}
+{-# SPECIALIZE parseSign :: LBS.ByteString -> ((Integer -> Integer), Int64, Maybe Bool) #-}
-{-# SPECIALIZE parseSign :: LBS.ByteString -> ((Double -> Double), Int64) #-}
+{-# SPECIALIZE parseSign :: LBS.ByteString -> ((Double -> Double), Int64, Maybe Bool) #-}
 
 parseHexalSignedInt :: AlexAction Lexeme
 parseHexalSignedInt = token $ \(pos, _, s, _) len -> 
-    let (sign, slen) = parseSign s in
+    let (sign, slen, nat) = parseSign s in
     let num = readHexFromPrefix (len - 2 - slen) $ LBSUtf8.drop (2 + slen) s in
-    Lexeme (Just pos) $ TIntLit $ sign num
+    Lexeme (Just pos) $ TIntLit nat $ sign num
 
 parseNanSigned :: AlexAction Lexeme
 parseNanSigned = token $ \(pos, _, s, _) len -> 
@@ -148,9 +148,9 @@ parseNanSigned = token $ \(pos, _, s, _) len ->
 
 parseDecimalSignedInt :: AlexAction Lexeme
 parseDecimalSignedInt = token $ \(pos, _, s, _) len ->
-    let (sign, slen) = parseSign s in
+    let (sign, slen, nat) = parseSign s in
     let num = readDecFromPrefix (len - slen) $ LBSUtf8.drop slen s in
-    Lexeme (Just pos) $ TIntLit $ sign num
+    Lexeme (Just pos) $ TIntLit nat $ sign num
 
 parseDecFloat :: AlexAction Lexeme
 parseDecFloat = token $ \(pos, _, s, _) len ->
@@ -226,11 +226,13 @@ readHexFloat toFloat sz expLimit manitisaSize str = do
                         then ([True], 0, exp' + 1)
                         else (rounded, 1, exp')
                     else (rounded, 0, exp')
-        if exp'' > expLimit || exp'' < (negate $ expLimit + manitisaSize) then Left "constant out of range" else return ()
+        e <- if exp'' > expLimit then Left "const out of range"
-        if exp'' >= (negate $ expLimit - 1)
+                else if exp'' < (negate $ expLimit + manitisaSize) then return $ negate $ expLimit + manitisaSize + 1
-        then return $ toFloat $ sign .|. ((fromIntegral $ exp'' + expLimit) `shiftL` manitisaSize) .|. ((fromBits (tail bits') + a) `shiftL` (manitisaSize + 1 - length bits'))
+                else return exp''
+        if e >= (negate $ expLimit - 1)
+        then return $ toFloat $ sign .|. ((fromIntegral $ e + expLimit) `shiftL` manitisaSize) .|. ((fromBits (tail bits') + a) `shiftL` (manitisaSize + 1 - length bits'))
         else do
-            let shift = expLimit + manitisaSize - length bits' - abs exp''
+            let shift = expLimit + manitisaSize - length bits' - abs e
             if shift < 0
             then return $ toFloat sign
             else return $ toFloat $ sign .|. ((fromBits bits' + a) `shiftL` shift)
@@ -299,7 +301,9 @@ endBlockComment _inp _len = do
     alexMonadScan
 
 startStringLiteral :: AlexAction Lexeme
-startStringLiteral _inp _len = do
+startStringLiteral (_, prev, _, _) _len = do
+    when (prev `notElem` "() \x09\x0A\x0D")
+        $ alexError "string literal should start after space or parent character"
     alexSetStartCode stringLiteral
     setLexerStringFlag True
     alexMonadScan
@@ -362,7 +366,7 @@ data NaN
     deriving (Show, Eq)
 
 data Token = TKeyword LBS.ByteString
-    | TIntLit Integer
+    | TIntLit {- Natural -} (Maybe Bool) Integer
     | TFloatLit FloatRep
     | TStringLit LBS.ByteString
     | TId LBS.ByteString

src/Language/Wasm/Parser.y

@@ -38,7 +38,8 @@ module Language.Wasm.Parser (
     Command(..),
     Action(..),
     Assertion(..),
-    Meta(..)
+    Meta(..),
+    ValuePattern(..)
 ) where
 
 import Language.Wasm.Structure (
@@ -54,7 +55,8 @@ import Language.Wasm.Structure (
         ElemType(..),
         Limit(..),
         GlobalType(..),
-        ValueType(..)
+        ValueType(..),
+        SimdShape(..)
     )
 
 import qualified Language.Wasm.Structure as S
@@ -64,6 +66,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.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)
@@ -72,10 +75,10 @@ import Control.Monad (guard, foldM)
 import Control.Monad.Except (throwError)
 
 import Numeric.Natural (Natural)
-import Data.Word (Word32, Word64)
+import Data.Word (Word8, Word16, Word32, Word64)
 import Data.Bits ((.|.))
 import Numeric.IEEE (infinity, nan, maxFinite)
-import Language.Wasm.FloatUtils (doubleToFloat)
+import Language.Wasm.FloatUtils (doubleToFloat, floatToWord, doubleToWord)
 import Control.DeepSeq (NFData)
 import GHC.Generics (Generic)
 
@@ -119,6 +122,7 @@ import Language.Wasm.Lexer (
 'i64'                           { Lexeme _ (TKeyword "i64") }
 'f32'                           { Lexeme _ (TKeyword "f32") }
 'f64'                           { Lexeme _ (TKeyword "f64") }
+'v128'                          { Lexeme _ (TKeyword "v128") }
 'mut'                           { Lexeme _ (TKeyword "mut") }
 'funcref'                       { Lexeme _ (TKeyword "funcref") }
 'externref'                     { Lexeme _ (TKeyword "externref") }
@@ -147,6 +151,23 @@ import Language.Wasm.Lexer (
 'i64.load'                      { Lexeme _ (TKeyword "i64.load") }
 'f32.load'                      { Lexeme _ (TKeyword "f32.load") }
 'f64.load'                      { Lexeme _ (TKeyword "f64.load") }
+'v128.load'                     { Lexeme _ (TKeyword "v128.load") }
+'v128.load8_lane'               { Lexeme _ (TKeyword "v128.load8_lane") }
+'v128.load16_lane'              { Lexeme _ (TKeyword "v128.load16_lane") }
+'v128.load32_lane'              { Lexeme _ (TKeyword "v128.load32_lane") }
+'v128.load64_lane'              { Lexeme _ (TKeyword "v128.load64_lane") }
+'v128.load8_splat'              { Lexeme _ (TKeyword "v128.load8_splat") }
+'v128.load16_splat'             { Lexeme _ (TKeyword "v128.load16_splat") }
+'v128.load32_splat'             { Lexeme _ (TKeyword "v128.load32_splat") }
+'v128.load64_splat'             { Lexeme _ (TKeyword "v128.load64_splat") }
+'v128.load32_zero'              { Lexeme _ (TKeyword "v128.load32_zero") }
+'v128.load64_zero'              { Lexeme _ (TKeyword "v128.load64_zero") }
+'v128.load8x8_s'                { Lexeme _ (TKeyword "v128.load8x8_s") }
+'v128.load8x8_u'                { Lexeme _ (TKeyword "v128.load8x8_u") }
+'v128.load16x4_s'               { Lexeme _ (TKeyword "v128.load16x4_s") }
+'v128.load16x4_u'               { Lexeme _ (TKeyword "v128.load16x4_u") }
+'v128.load32x2_s'               { Lexeme _ (TKeyword "v128.load32x2_s") }
+'v128.load32x2_u'               { Lexeme _ (TKeyword "v128.load32x2_u") }
 'i32.load8_s'                   { Lexeme _ (TKeyword "i32.load8_s") }
 'i32.load8_u'                   { Lexeme _ (TKeyword "i32.load8_u") }
 'i32.load16_s'                  { Lexeme _ (TKeyword "i32.load16_s") }
@@ -161,6 +182,11 @@ import Language.Wasm.Lexer (
 'i64.store'                     { Lexeme _ (TKeyword "i64.store") }
 'f32.store'                     { Lexeme _ (TKeyword "f32.store") }
 'f64.store'                     { Lexeme _ (TKeyword "f64.store") }
+'v128.store'                    { Lexeme _ (TKeyword "v128.store") }
+'v128.store8_lane'              { Lexeme _ (TKeyword "v128.store8_lane") }
+'v128.store16_lane'             { Lexeme _ (TKeyword "v128.store16_lane") }
+'v128.store32_lane'             { Lexeme _ (TKeyword "v128.store32_lane") }
+'v128.store64_lane'             { Lexeme _ (TKeyword "v128.store64_lane") }
 'i32.store8'                    { Lexeme _ (TKeyword "i32.store8") }
 'i32.store16'                   { Lexeme _ (TKeyword "i32.store16") }
 'i64.store8'                    { Lexeme _ (TKeyword "i64.store8") }
@@ -184,6 +210,7 @@ import Language.Wasm.Lexer (
 'i64.const'                     { Lexeme _ (TKeyword "i64.const") }
 'f32.const'                     { Lexeme _ (TKeyword "f32.const") }
 'f64.const'                     { Lexeme _ (TKeyword "f64.const") }
+'v128.const'                    { Lexeme _ (TKeyword "v128.const") }
 'i32.clz'                       { Lexeme _ (TKeyword "i32.clz") }
 'i32.ctz'                       { Lexeme _ (TKeyword "i32.ctz") }
 'i32.popcnt'                    { Lexeme _ (TKeyword "i32.popcnt") }
@@ -310,6 +337,16 @@ import Language.Wasm.Lexer (
 'f32.convert_i32_u'             { Lexeme _ (TKeyword "f32.convert_i32_u") }
 'f32.convert_i64_s'             { Lexeme _ (TKeyword "f32.convert_i64_s") }
 'f32.convert_i64_u'             { Lexeme _ (TKeyword "f32.convert_i64_u") }
+'f32x4.convert_i32x4_s'         { Lexeme _ (TKeyword "f32x4.convert_i32x4_s") }
+'f32x4.convert_i32x4_u'         { Lexeme _ (TKeyword "f32x4.convert_i32x4_u") }
+'f64x2.convert_low_i32x4_s'     { Lexeme _ (TKeyword "f64x2.convert_low_i32x4_s") }
+'f64x2.convert_low_i32x4_u'     { Lexeme _ (TKeyword "f64x2.convert_low_i32x4_u") }
+'i8x16.narrow_i16x8_s'          { Lexeme _ (TKeyword "i8x16.narrow_i16x8_s") }
+'i8x16.narrow_i16x8_u'          { Lexeme _ (TKeyword "i8x16.narrow_i16x8_u") }
+'i16x8.narrow_i32x4_s'          { Lexeme _ (TKeyword "i16x8.narrow_i32x4_s") }
+'i16x8.narrow_i32x4_u'          { Lexeme _ (TKeyword "i16x8.narrow_i32x4_u") }
+'f64x2.promote_low_f32x4'       { Lexeme _ (TKeyword "f64x2.promote_low_f32x4") }
+'f32x4.demote_f64x2_zero'       { Lexeme _ (TKeyword "f32x4.demote_f64x2_zero") }
 'f32.demote_f64'                { Lexeme _ (TKeyword "f32.demote_f64") }
 'f64.convert_i32_s'             { Lexeme _ (TKeyword "f64.convert_i32_s") }
 'f64.convert_i32_u'             { Lexeme _ (TKeyword "f64.convert_i32_u") }
@@ -320,6 +357,12 @@ import Language.Wasm.Lexer (
 'i64.reinterpret_f64'           { Lexeme _ (TKeyword "i64.reinterpret_f64") }
 'f32.reinterpret_i32'           { Lexeme _ (TKeyword "f32.reinterpret_i32") }
 'f64.reinterpret_i64'           { Lexeme _ (TKeyword "f64.reinterpret_i64") }
+'i8x16'                         { Lexeme _ (TKeyword "i8x16") }
+'i16x8'                         { Lexeme _ (TKeyword "i16x8") }
+'i32x4'                         { Lexeme _ (TKeyword "i32x4") }
+'i64x2'                         { Lexeme _ (TKeyword "i64x2") }
+'f32x4'                         { Lexeme _ (TKeyword "f32x4") }
+'f64x2'                         { Lexeme _ (TKeyword "f64x2") }
 'block'                         { Lexeme _ (TKeyword "block") }
 'loop'                          { Lexeme _ (TKeyword "loop") }
 'if'                            { Lexeme _ (TKeyword "if") }
@@ -339,6 +382,214 @@ import Language.Wasm.Lexer (
 'offset'                        { Lexeme _ (TKeyword "offset") }
 '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") }
+'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") }
+'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") }
+'i8x16.popcnt'                  { Lexeme _ (TKeyword "i8x16.popcnt") }
+'v128.not'                      { Lexeme _ (TKeyword "v128.not") }
+'v128.and'                      { Lexeme _ (TKeyword "v128.and") }
+'v128.andnot'                   { Lexeme _ (TKeyword "v128.andnot") }
+'v128.or'                       { Lexeme _ (TKeyword "v128.or") }
+'v128.xor'                      { Lexeme _ (TKeyword "v128.xor") }
+'v128.any_true'                 { Lexeme _ (TKeyword "v128.any_true") }
+'v128.bitselect'                { Lexeme _ (TKeyword "v128.bitselect") }
+'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") }
+'i8x16.add_sat_s'               { Lexeme _ (TKeyword "i8x16.add_sat_s") }
+'i16x8.add_sat_s'               { Lexeme _ (TKeyword "i16x8.add_sat_s") }
+'i8x16.sub_sat_s'               { Lexeme _ (TKeyword "i8x16.sub_sat_s") }
+'i16x8.sub_sat_s'               { Lexeme _ (TKeyword "i16x8.sub_sat_s") }
+'i8x16.add_sat_u'               { Lexeme _ (TKeyword "i8x16.add_sat_u") }
+'i16x8.add_sat_u'               { Lexeme _ (TKeyword "i16x8.add_sat_u") }
+'i8x16.sub_sat_u'               { Lexeme _ (TKeyword "i8x16.sub_sat_u") }
+'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") }
+'i16x8.extmul_low_i8x16_u'      { Lexeme _ (TKeyword "i16x8.extmul_low_i8x16_u") }
+'i32x4.extmul_low_i16x8_u'      { Lexeme _ (TKeyword "i32x4.extmul_low_i16x8_u") }
+'i64x2.extmul_low_i32x4_u'      { Lexeme _ (TKeyword "i64x2.extmul_low_i32x4_u") }
+'i16x8.extmul_high_i8x16_s'     { Lexeme _ (TKeyword "i16x8.extmul_high_i8x16_s") }
+'i32x4.extmul_high_i16x8_s'     { Lexeme _ (TKeyword "i32x4.extmul_high_i16x8_s") }
+'i64x2.extmul_high_i32x4_s'     { Lexeme _ (TKeyword "i64x2.extmul_high_i32x4_s") }
+'i16x8.extmul_high_i8x16_u'     { Lexeme _ (TKeyword "i16x8.extmul_high_i8x16_u") }
+'i32x4.extmul_high_i16x8_u'     { Lexeme _ (TKeyword "i32x4.extmul_high_i16x8_u") }
+'i64x2.extmul_high_i32x4_u'     { Lexeme _ (TKeyword "i64x2.extmul_high_i32x4_u") }
+'i8x16.min_s'                   { Lexeme _ (TKeyword "i8x16.min_s") }
+'i16x8.min_s'                   { Lexeme _ (TKeyword "i16x8.min_s") }
+'i32x4.min_s'                   { Lexeme _ (TKeyword "i32x4.min_s") }
+'i8x16.min_u'                   { Lexeme _ (TKeyword "i8x16.min_u") }
+'i16x8.min_u'                   { Lexeme _ (TKeyword "i16x8.min_u") }
+'i32x4.min_u'                   { Lexeme _ (TKeyword "i32x4.min_u") }
+'i8x16.max_s'                   { Lexeme _ (TKeyword "i8x16.max_s") }
+'i16x8.max_s'                   { Lexeme _ (TKeyword "i16x8.max_s") }
+'i32x4.max_s'                   { Lexeme _ (TKeyword "i32x4.max_s") }
+'i8x16.max_u'                   { Lexeme _ (TKeyword "i8x16.max_u") }
+'i16x8.max_u'                   { Lexeme _ (TKeyword "i16x8.max_u") }
+'i32x4.max_u'                   { Lexeme _ (TKeyword "i32x4.max_u") }
+'i16x8.mul'                     { Lexeme _ (TKeyword "i16x8.mul") }
+'i32x4.mul'                     { Lexeme _ (TKeyword "i32x4.mul") }
+'i64x2.mul'                     { Lexeme _ (TKeyword "i64x2.mul") }
+'i8x16.abs'                     { Lexeme _ (TKeyword "i8x16.abs") }
+'i16x8.abs'                     { Lexeme _ (TKeyword "i16x8.abs") }
+'i32x4.abs'                     { Lexeme _ (TKeyword "i32x4.abs") }
+'i64x2.abs'                     { Lexeme _ (TKeyword "i64x2.abs") }
+'i8x16.neg'                     { Lexeme _ (TKeyword "i8x16.neg") }
+'i16x8.neg'                     { Lexeme _ (TKeyword "i16x8.neg") }
+'i32x4.neg'                     { Lexeme _ (TKeyword "i32x4.neg") }
+'i64x2.neg'                     { Lexeme _ (TKeyword "i64x2.neg") }
+'i8x16.shl'                     { Lexeme _ (TKeyword "i8x16.shl") }
+'i16x8.shl'                     { Lexeme _ (TKeyword "i16x8.shl") }
+'i32x4.shl'                     { Lexeme _ (TKeyword "i32x4.shl") }
+'i64x2.shl'                     { Lexeme _ (TKeyword "i64x2.shl") }
+'i8x16.shr_u'                   { Lexeme _ (TKeyword "i8x16.shr_u") }
+'i16x8.shr_u'                   { Lexeme _ (TKeyword "i16x8.shr_u") }
+'i32x4.shr_u'                   { Lexeme _ (TKeyword "i32x4.shr_u") }
+'i64x2.shr_u'                   { Lexeme _ (TKeyword "i64x2.shr_u") }
+'i8x16.shr_s'                   { Lexeme _ (TKeyword "i8x16.shr_s") }
+'i16x8.shr_s'                   { Lexeme _ (TKeyword "i16x8.shr_s") }
+'i32x4.shr_s'                   { Lexeme _ (TKeyword "i32x4.shr_s") }
+'i64x2.shr_s'                   { Lexeme _ (TKeyword "i64x2.shr_s") }
+'i8x16.bitmask'                 { Lexeme _ (TKeyword "i8x16.bitmask") }
+'i16x8.bitmask'                 { Lexeme _ (TKeyword "i16x8.bitmask") }
+'i32x4.bitmask'                 { Lexeme _ (TKeyword "i32x4.bitmask") }
+'i64x2.bitmask'                 { Lexeme _ (TKeyword "i64x2.bitmask") }
+'i8x16.eq'                      { Lexeme _ (TKeyword "i8x16.eq") }
+'i16x8.eq'                      { Lexeme _ (TKeyword "i16x8.eq") }
+'i32x4.eq'                      { Lexeme _ (TKeyword "i32x4.eq") }
+'i64x2.eq'                      { Lexeme _ (TKeyword "i64x2.eq") }
+'i8x16.ne'                      { Lexeme _ (TKeyword "i8x16.ne") }
+'i16x8.ne'                      { Lexeme _ (TKeyword "i16x8.ne") }
+'i32x4.ne'                      { Lexeme _ (TKeyword "i32x4.ne") }
+'i64x2.ne'                      { Lexeme _ (TKeyword "i64x2.ne") }
+'i8x16.lt_s'                    { Lexeme _ (TKeyword "i8x16.lt_s") }
+'i16x8.lt_s'                    { Lexeme _ (TKeyword "i16x8.lt_s") }
+'i32x4.lt_s'                    { Lexeme _ (TKeyword "i32x4.lt_s") }
+'i64x2.lt_s'                    { Lexeme _ (TKeyword "i64x2.lt_s") }
+'i8x16.lt_u'                    { Lexeme _ (TKeyword "i8x16.lt_u") }
+'i16x8.lt_u'                    { Lexeme _ (TKeyword "i16x8.lt_u") }
+'i32x4.lt_u'                    { Lexeme _ (TKeyword "i32x4.lt_u") }
+'i64x2.lt_u'                    { Lexeme _ (TKeyword "i64x2.lt_u") }
+'i8x16.le_s'                    { Lexeme _ (TKeyword "i8x16.le_s") }
+'i16x8.le_s'                    { Lexeme _ (TKeyword "i16x8.le_s") }
+'i32x4.le_s'                    { Lexeme _ (TKeyword "i32x4.le_s") }
+'i64x2.le_s'                    { Lexeme _ (TKeyword "i64x2.le_s") }
+'i8x16.le_u'                    { Lexeme _ (TKeyword "i8x16.le_u") }
+'i16x8.le_u'                    { Lexeme _ (TKeyword "i16x8.le_u") }
+'i32x4.le_u'                    { Lexeme _ (TKeyword "i32x4.le_u") }
+'i64x2.le_u'                    { Lexeme _ (TKeyword "i64x2.le_u") }
+'i8x16.gt_s'                    { Lexeme _ (TKeyword "i8x16.gt_s") }
+'i16x8.gt_s'                    { Lexeme _ (TKeyword "i16x8.gt_s") }
+'i32x4.gt_s'                    { Lexeme _ (TKeyword "i32x4.gt_s") }
+'i64x2.gt_s'                    { Lexeme _ (TKeyword "i64x2.gt_s") }
+'i8x16.gt_u'                    { Lexeme _ (TKeyword "i8x16.gt_u") }
+'i16x8.gt_u'                    { Lexeme _ (TKeyword "i16x8.gt_u") }
+'i32x4.gt_u'                    { Lexeme _ (TKeyword "i32x4.gt_u") }
+'i64x2.gt_u'                    { Lexeme _ (TKeyword "i64x2.gt_u") }
+'i8x16.ge_s'                    { Lexeme _ (TKeyword "i8x16.ge_s") }
+'i16x8.ge_s'                    { Lexeme _ (TKeyword "i16x8.ge_s") }
+'i32x4.ge_s'                    { Lexeme _ (TKeyword "i32x4.ge_s") }
+'i64x2.ge_s'                    { Lexeme _ (TKeyword "i64x2.ge_s") }
+'i8x16.ge_u'                    { Lexeme _ (TKeyword "i8x16.ge_u") }
+'i16x8.ge_u'                    { Lexeme _ (TKeyword "i16x8.ge_u") }
+'i32x4.ge_u'                    { Lexeme _ (TKeyword "i32x4.ge_u") }
+'i64x2.ge_u'                    { Lexeme _ (TKeyword "i64x2.ge_u") }
+'f32x4.add'                     { Lexeme _ (TKeyword "f32x4.add") }
+'f64x2.add'                     { Lexeme _ (TKeyword "f64x2.add") }
+'f32x4.sub'                     { Lexeme _ (TKeyword "f32x4.sub") }
+'f64x2.sub'                     { Lexeme _ (TKeyword "f64x2.sub") }
+'f32x4.mul'                     { Lexeme _ (TKeyword "f32x4.mul") }
+'f64x2.mul'                     { Lexeme _ (TKeyword "f64x2.mul") }
+'f32x4.div'                     { Lexeme _ (TKeyword "f32x4.div") }
+'f64x2.div'                     { Lexeme _ (TKeyword "f64x2.div") }
+'f32x4.min'                     { Lexeme _ (TKeyword "f32x4.min") }
+'f64x2.min'                     { Lexeme _ (TKeyword "f64x2.min") }
+'f32x4.max'                     { Lexeme _ (TKeyword "f32x4.max") }
+'f64x2.max'                     { Lexeme _ (TKeyword "f64x2.max") }
+'f32x4.pmin'                    { Lexeme _ (TKeyword "f32x4.pmin") }
+'f64x2.pmin'                    { Lexeme _ (TKeyword "f64x2.pmin") }
+'f32x4.pmax'                    { Lexeme _ (TKeyword "f32x4.pmax") }
+'f64x2.pmax'                    { Lexeme _ (TKeyword "f64x2.pmax") }
+'f32x4.abs'                     { Lexeme _ (TKeyword "f32x4.abs") }
+'f64x2.abs'                     { Lexeme _ (TKeyword "f64x2.abs") }
+'f32x4.neg'                     { Lexeme _ (TKeyword "f32x4.neg") }
+'f64x2.neg'                     { Lexeme _ (TKeyword "f64x2.neg") }
+'f32x4.ceil'                    { Lexeme _ (TKeyword "f32x4.ceil") }
+'f64x2.ceil'                    { Lexeme _ (TKeyword "f64x2.ceil") }
+'f32x4.floor'                   { Lexeme _ (TKeyword "f32x4.floor") }
+'f64x2.floor'                   { Lexeme _ (TKeyword "f64x2.floor") }
+'f32x4.trunc'                   { Lexeme _ (TKeyword "f32x4.trunc") }
+'f64x2.trunc'                   { Lexeme _ (TKeyword "f64x2.trunc") }
+'f32x4.nearest'                 { Lexeme _ (TKeyword "f32x4.nearest") }
+'f64x2.nearest'                 { Lexeme _ (TKeyword "f64x2.nearest") }
+'f32x4.sqrt'                    { Lexeme _ (TKeyword "f32x4.sqrt") }
+'f64x2.sqrt'                    { Lexeme _ (TKeyword "f64x2.sqrt") }
+'f32x4.eq'                      { Lexeme _ (TKeyword "f32x4.eq") }
+'f64x2.eq'                      { Lexeme _ (TKeyword "f64x2.eq") }
+'f32x4.ne'                      { Lexeme _ (TKeyword "f32x4.ne") }
+'f64x2.ne'                      { Lexeme _ (TKeyword "f64x2.ne") }
+'f32x4.lt'                      { Lexeme _ (TKeyword "f32x4.lt") }
+'f64x2.lt'                      { Lexeme _ (TKeyword "f64x2.lt") }
+'f32x4.le'                      { Lexeme _ (TKeyword "f32x4.le") }
+'f64x2.le'                      { Lexeme _ (TKeyword "f64x2.le") }
+'f32x4.gt'                      { Lexeme _ (TKeyword "f32x4.gt") }
+'f64x2.gt'                      { Lexeme _ (TKeyword "f64x2.gt") }
+'f32x4.ge'                      { Lexeme _ (TKeyword "f32x4.ge") }
+'f64x2.ge'                      { Lexeme _ (TKeyword "f64x2.ge") }
+'i16x8.extend_high_i8x16_s'     { Lexeme _ (TKeyword "i16x8.extend_high_i8x16_s") }
+'i16x8.extend_high_i8x16_u'     { Lexeme _ (TKeyword "i16x8.extend_high_i8x16_u") }
+'i16x8.extend_low_i8x16_s'      { Lexeme _ (TKeyword "i16x8.extend_low_i8x16_s") }
+'i16x8.extend_low_i8x16_u'      { Lexeme _ (TKeyword "i16x8.extend_low_i8x16_u") }
+'i32x4.extend_high_i16x8_s'     { Lexeme _ (TKeyword "i32x4.extend_high_i16x8_s") }
+'i32x4.extend_high_i16x8_u'     { Lexeme _ (TKeyword "i32x4.extend_high_i16x8_u") }
+'i32x4.extend_low_i16x8_s'      { Lexeme _ (TKeyword "i32x4.extend_low_i16x8_s") }
+'i32x4.extend_low_i16x8_u'      { Lexeme _ (TKeyword "i32x4.extend_low_i16x8_u") }
+'i64x2.extend_high_i32x4_s'     { Lexeme _ (TKeyword "i64x2.extend_high_i32x4_s") }
+'i64x2.extend_high_i32x4_u'     { Lexeme _ (TKeyword "i64x2.extend_high_i32x4_u") }
+'i64x2.extend_low_i32x4_s'      { Lexeme _ (TKeyword "i64x2.extend_low_i32x4_s") }
+'i64x2.extend_low_i32x4_u'      { Lexeme _ (TKeyword "i64x2.extend_low_i32x4_u") }
+'i32x4.trunc_sat_f32x4_s'       { Lexeme _ (TKeyword "i32x4.trunc_sat_f32x4_s") }
+'i32x4.trunc_sat_f32x4_u'       { Lexeme _ (TKeyword "i32x4.trunc_sat_f32x4_u") }
+'i32x4.trunc_sat_f64x2_s_zero'  { Lexeme _ (TKeyword "i32x4.trunc_sat_f64x2_s_zero") }
+'i32x4.trunc_sat_f64x2_u_zero'  { Lexeme _ (TKeyword "i32x4.trunc_sat_f64x2_u_zero") }
+'i32x4.dot_i16x8_s'             { Lexeme _ (TKeyword "i32x4.dot_i16x8_s") }
+'i16x8.q15mulr_sat_s'           { Lexeme _ (TKeyword "i16x8.q15mulr_sat_s") }
 -- script extension
 'binary'                        { Lexeme _ (TKeyword "binary") }
 'quote'                         { Lexeme _ (TKeyword "quote") }
@@ -358,7 +609,9 @@ import Language.Wasm.Lexer (
 'output'                        { Lexeme _ (TKeyword "output") }
 -- script extension end
 id                              { Lexeme _ (TId $$) }
-int                   { Lexeme _ (TIntLit $$) }
+signed_pos                      { Lexeme _ (TIntLit (Just False) $$) }
+signed_neg                      { Lexeme _ (TIntLit (Just True) $$) }
+nat                             { Lexeme _ (TIntLit Nothing $$) }
 f64                             { Lexeme _ (TFloatLit $$) }
 offset                          { Lexeme _ (TKeyword (asOffset -> Just $$)) }
 align                           { Lexeme _ (TKeyword (asAlign -> Just $$)) }
@@ -385,13 +638,33 @@ valtype :: { ValueType }
     | 'i64' { I64 }
     | 'f32' { F32 }
     | 'f64' { F64 }
+    | 'v128' { V128 }
     | 'funcref' { Func }
     | 'externref' { Extern }
 
+int :: {Integer}
+    : signed_neg { $1 }
+    | signed_pos { $1 }
+    | nat { $1 }
+
 index :: { Index }
     : u32 { Index $1 }
     | ident { Named $1 }
 
+i8 :: { Integer }
+    : int {%
+        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
+        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)
+    }
+
 int32 :: { Integer }
     : int {%
         if $1 >= -(2^31) && $1 < 2^32
@@ -414,7 +687,20 @@ int64 :: { Integer }
     }
 
 float32 :: { FloatRep }
-    : int {%
+    : signed_neg {%
+        -- it is stupid, but to preserve minus bit of "-0" we have to do it
+        let maxInt = 340282356779733623858607532500980858880 in
+        if $1 <= maxInt && $1 >= -maxInt
+        then return $ BinRep $ if $1 == 0 then negate $ fromIntegral $1 else fromIntegral $1
+        else Left "constant out of range"
+    }
+    | signed_pos {%
+        let maxInt = 340282356779733623858607532500980858880 in
+        if $1 <= maxInt && $1 >= -maxInt
+        then return $ BinRep $ fromIntegral $1
+        else Left "constant out of range"
+    }
+    | nat {%
         let maxInt = 340282356779733623858607532500980858880 in
         if $1 <= maxInt && $1 >= -maxInt
         then return $ BinRep $ fromIntegral $1
@@ -423,7 +709,20 @@ float32 :: { FloatRep }
     | f64 { $1 }
 
 float64 :: { FloatRep }
-    : int {%
+    : signed_neg {%
+        -- it is stupid, but to preserve minus bit of "-0" we have to do it
+        let maxInt = round (maxFinite :: Double) in
+        if $1 <= maxInt && $1 >= -maxInt
+        then fmap (BinRep . if $1 == 0 then negate else id) $ doubleFromInteger $1
+        else Left "constant out of range"
+    }
+    | signed_pos {%
+        let maxInt = round (maxFinite :: Double) in
+        if $1 <= maxInt && $1 >= -maxInt
+        then fmap BinRep $ doubleFromInteger $1
+        else Left "constant out of range"
+    }
+    | nat {%
         let maxInt = round (maxFinite :: Double) in
         if $1 <= maxInt && $1 >= -maxInt
         then fmap BinRep $ doubleFromInteger $1
@@ -431,6 +730,37 @@ float64 :: { FloatRep }
     }
     | f64 { $1 }
 
+simd_shape :: { SimdShape }
+    : 'i8x16' { I8x16 }
+    | 'i16x8' { I16x8 }
+    | 'i32x4' { I32x4 }
+    | 'i64x2' { I64x2 }
+    | 'f32x4' { F32x4 }
+    | 'f64x2' { F64x2 }
+
+v128_const :: { V128Rep }
+    : 'i8x16' i8 i8 i8 i8 i8 i8 i8 i8 i8 i8 i8 i8 i8 i8 i8 i8 {
+        I8x16Const [$2, $3, $4, $5, $6, $7, $8, $9, $10, $11, $12, $13, $14, $15, $16, $17]
+    }
+    | 'i16x8' i16 i16 i16 i16 i16 i16 i16 i16 {
+        I16x8Const [$2, $3, $4, $5, $6, $7, $8, $9]
+    }
+    | 'i32x4' int32 int32 int32 int32 {
+        I32x4Const [$2, $3, $4, $5]
+    }
+    | 'i64x2' int64 int64 {
+        I64x2Const [$2, $3]
+    }
+    | 'f32x4' float32 float32 float32 float32 {
+        F32x4Const [$2, $3, $4, $5]
+    }
+    | 'f64x2' float64 float64 {
+        F64x2Const [$2, $3]
+    }
+
+lane_index :: { Natural }
+    : nat {% if $1 < 256 then Right $ fromIntegral $1 else Left "malformed lane index"}
+
 plaininstr :: { PlainInstr }
     -- control instructions
     : 'unreachable'                  { Unreachable }
@@ -457,6 +787,23 @@ plaininstr :: { PlainInstr }
     | 'i64.load' memarg8             { I64Load $2 }
     | 'f32.load' memarg4             { F32Load $2 }
     | 'f64.load' memarg8             { F64Load $2 }
+    | 'v128.load' memarg16           { V128Load $2 }
+    | 'v128.load8_lane' memarg1 lane_index  { V128Load8Lane $2 $3 }
+    | 'v128.load16_lane' memarg2 lane_index { V128Load16Lane $2 $3 }
+    | 'v128.load32_lane' memarg4 lane_index { V128Load32Lane $2 $3 }
+    | 'v128.load64_lane' memarg8 lane_index { V128Load64Lane $2 $3 }
+    | 'v128.load8_splat' memarg1     { V128Load8Splat $2 }
+    | 'v128.load16_splat' memarg2    { V128Load16Splat $2 }
+    | 'v128.load32_splat' memarg4    { V128Load32Splat $2 }
+    | 'v128.load64_splat' memarg8    { V128Load64Splat $2 }
+    | 'v128.load32_zero' memarg4     { V128Load32Zero $2 }
+    | 'v128.load64_zero' memarg8     { V128Load64Zero $2 }
+    | 'v128.load8x8_s' memarg8       { V128Load8x8S $2 }
+    | 'v128.load8x8_u' memarg8       { V128Load8x8U $2 }
+    | 'v128.load16x4_s' memarg8      { V128Load16x4S $2 }
+    | 'v128.load16x4_u' memarg8      { V128Load16x4U $2 }
+    | 'v128.load32x2_s' memarg8      { V128Load32x2S $2 }
+    | 'v128.load32x2_u' memarg8      { V128Load32x2U $2 }
     | 'i32.load8_s' memarg1          { I32Load8S $2 }
     | 'i32.load8_u' memarg1          { I32Load8U $2 }
     | 'i32.load16_s' memarg2         { I32Load16S $2 }
@@ -471,6 +818,11 @@ plaininstr :: { PlainInstr }
     | 'i64.store' memarg8            { I64Store $2 }
     | 'f32.store' memarg4            { F32Store $2 }
     | 'f64.store' memarg8            { F64Store $2 }
+    | 'v128.store' memarg16          { V128Store $2 }
+    | 'v128.store8_lane' memarg1 lane_index { V128Store8Lane $2 $3 }
+    | 'v128.store16_lane' memarg2 lane_index { V128Store16Lane $2 $3 }
+    | 'v128.store32_lane' memarg4 lane_index { V128Store32Lane $2 $3 }
+    | 'v128.store64_lane' memarg8 lane_index { V128Store64Lane $2 $3 }
     | 'i32.store8' memarg1           { I32Store8 $2 }
     | 'i32.store16' memarg2          { I32Store16 $2 }
     | 'i64.store8' memarg1           { I64Store8 $2 }
@@ -500,6 +852,7 @@ plaininstr :: { PlainInstr }
     | 'i64.const' int64                  { I64Const $2 }
     | 'f32.const' float32                { F32Const $2 }
     | 'f64.const' float64                { F64Const $2 }
+    | 'v128.const' v128_const            { V128Const $2 }
     | 'i32.clz'                          { IUnOp BS32 IClz }
     | 'i32.ctz'                          { IUnOp BS32 ICtz }
     | 'i32.popcnt'                       { IUnOp BS32 IPopcnt }
@@ -626,6 +979,16 @@ plaininstr :: { PlainInstr }
     | 'f32.convert_i32_u'                { FConvertIU BS32 BS32 }
     | 'f32.convert_i64_s'                { FConvertIS BS32 BS64 }
     | 'f32.convert_i64_u'                { FConvertIU BS32 BS64 }
+    | 'f32x4.convert_i32x4_s'            { FConvertIS (BS128 F32x4) (BS128 I32x4) }
+    | 'f32x4.convert_i32x4_u'            { FConvertIU (BS128 F32x4) (BS128 I32x4) }
+    | 'f64x2.convert_low_i32x4_s'        { FConvertIS (BS128 F64x2) (BS128 I32x4) }
+    | 'f64x2.convert_low_i32x4_u'        { FConvertIU (BS128 F64x2) (BS128 I32x4) }
+    | 'i8x16.narrow_i16x8_s'             { V128Narrow I8x16 I16x8 True }
+    | 'i8x16.narrow_i16x8_u'             { V128Narrow I8x16 I16x8 False }
+    | 'i16x8.narrow_i32x4_s'             { V128Narrow I16x8 I32x4 True }
+    | 'i16x8.narrow_i32x4_u'             { V128Narrow I16x8 I32x4 False }
+    | 'f64x2.promote_low_f32x4'          { F64x2PromoteLowF32x4 }
+    | 'f32x4.demote_f64x2_zero'          { F32x4DemoteF64x2Zero }
     | 'f32.demote_f64'                   { F32DemoteF64 }
     | 'f64.convert_i32_s'                { FConvertIS BS64 BS32 }
     | 'f64.convert_i32_u'                { FConvertIU BS64 BS32 }
@@ -636,6 +999,219 @@ plaininstr :: { PlainInstr }
     | 'i64.reinterpret_f64'              { IReinterpretF BS64 }
     | 'f32.reinterpret_i32'              { FReinterpretI BS32 }
     | 'f64.reinterpret_i64'              { FReinterpretI BS64 }
+    -- simd
+    | 'i8x16.shuffle' u32 u32 u32 u32 u32 u32 u32 u32 u32 u32 u32 u32 u32 u32 u32 u32 {%
+        let idxs = [$2, $3, $4, $5, $6, $7, $8, $9, $10, $11, $12, $13, $14, $15, $16, $17] in
+        if any (\i -> i < 0 || i > 0xFF) idxs
+        then Left "malformed lane index"
+        else Right $ I8x16Shuffle $ map fromIntegral idxs
+    }
+    | 'i8x16.swizzle'                    { I8x16Swizzle }
+    | 'v128.not'                         { IUnOp (BS128 I128x1) INot }
+    | 'v128.and'                         { IBinOp (BS128 I128x1) IAnd }
+    | 'v128.andnot'                      { IBinOp (BS128 I128x1) IAndNot }
+    | 'v128.or'                          { IBinOp (BS128 I128x1) IOr }
+    | 'v128.xor'                         { IBinOp (BS128 I128x1) IXor }
+    | 'v128.bitselect'                   { V128BitSelect }
+    | '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 }
+    | 'i8x16.extract_lane_s' lane_index  { V128ExtractLane I8x16 $2 True }
+    | 'i16x8.extract_lane_s' lane_index  { V128ExtractLane I16x8 $2 True }
+    | 'i8x16.extract_lane_u' lane_index  { V128ExtractLane I8x16 $2 False }
+    | 'i16x8.extract_lane_u' lane_index  { V128ExtractLane I16x8 $2 False }
+    | 'i32x4.extract_lane' lane_index    { V128ExtractLane I32x4 $2 False }
+    | 'i64x2.extract_lane' lane_index    { V128ExtractLane I64x2 $2 False }
+    | 'f32x4.extract_lane' lane_index    { V128ExtractLane F32x4 $2 False }
+    | 'f64x2.extract_lane' lane_index    { V128ExtractLane F64x2 $2 False }
+    | 'i8x16.replace_lane' lane_index    { V128ReplaceLane I8x16 $2 }
+    | 'i16x8.replace_lane' lane_index    { V128ReplaceLane I16x8 $2 }
+    | 'i32x4.replace_lane' lane_index    { V128ReplaceLane I32x4 $2 }
+    | 'i64x2.replace_lane' lane_index    { V128ReplaceLane I64x2 $2 }
+    | 'f32x4.replace_lane' lane_index    { V128ReplaceLane F32x4 $2 }
+    | 'f64x2.replace_lane' lane_index    { 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 }
+    | 'i8x16.add_sat_s'                  { IBinOp (BS128 I8x16) IAddSatS }
+    | 'i16x8.add_sat_s'                  { IBinOp (BS128 I16x8) IAddSatS }
+    | 'i8x16.sub_sat_s'                  { IBinOp (BS128 I8x16) ISubSatS }
+    | 'i16x8.sub_sat_s'                  { IBinOp (BS128 I16x8) ISubSatS }
+    | 'i8x16.add_sat_u'                  { IBinOp (BS128 I8x16) IAddSatU }
+    | 'i16x8.add_sat_u'                  { IBinOp (BS128 I16x8) IAddSatU }
+    | 'i8x16.sub_sat_u'                  { IBinOp (BS128 I8x16) ISubSatU }
+    | 'i16x8.sub_sat_u'                  { IBinOp (BS128 I16x8) ISubSatU }
+    | 'i8x16.avgr_u'                     { IBinOp (BS128 I8x16) IAvgrU }
+    | 'i16x8.avgr_u'                     { IBinOp (BS128 I16x8) IAvgrU }
+    | 'i8x16.min_s'                      { IBinOp (BS128 I8x16) IMinS }
+    | 'i16x8.min_s'                      { IBinOp (BS128 I16x8) IMinS }
+    | 'i32x4.min_s'                      { IBinOp (BS128 I32x4) IMinS }
+    | 'i8x16.min_u'                      { IBinOp (BS128 I8x16) IMinU }
+    | 'i16x8.min_u'                      { IBinOp (BS128 I16x8) IMinU }
+    | 'i32x4.min_u'                      { IBinOp (BS128 I32x4) IMinU }
+    | 'i8x16.max_s'                      { IBinOp (BS128 I8x16) IMaxS }
+    | 'i16x8.max_s'                      { IBinOp (BS128 I16x8) IMaxS }
+    | 'i32x4.max_s'                      { IBinOp (BS128 I32x4) IMaxS }
+    | 'i8x16.max_u'                      { IBinOp (BS128 I8x16) IMaxU }
+    | 'i16x8.max_u'                      { IBinOp (BS128 I16x8) IMaxU }
+    | 'i32x4.max_u'                      { IBinOp (BS128 I32x4) IMaxU }
+    | 'i16x8.extmul_low_i8x16_s'         { IBinOp (BS128 I16x8) (IExtMul True False) }
+    | 'i32x4.extmul_low_i16x8_s'         { IBinOp (BS128 I32x4) (IExtMul True False) }
+    | 'i64x2.extmul_low_i32x4_s'         { IBinOp (BS128 I64x2) (IExtMul True False) }
+    | 'i16x8.extmul_low_i8x16_u'         { IBinOp (BS128 I16x8) (IExtMul False False) }
+    | 'i32x4.extmul_low_i16x8_u'         { IBinOp (BS128 I32x4) (IExtMul False False) }
+    | 'i64x2.extmul_low_i32x4_u'         { IBinOp (BS128 I64x2) (IExtMul False False) }
+    | 'i16x8.extmul_high_i8x16_s'        { IBinOp (BS128 I16x8) (IExtMul True True) }
+    | 'i32x4.extmul_high_i16x8_s'        { IBinOp (BS128 I32x4) (IExtMul True True) }
+    | 'i64x2.extmul_high_i32x4_s'        { IBinOp (BS128 I64x2) (IExtMul True True) }
+    | 'i16x8.extmul_high_i8x16_u'        { IBinOp (BS128 I16x8) (IExtMul False True) }
+    | 'i32x4.extmul_high_i16x8_u'        { IBinOp (BS128 I32x4) (IExtMul False True) }
+    | 'i64x2.extmul_high_i32x4_u'        { IBinOp (BS128 I64x2) (IExtMul False True) }
+    | 'i16x8.mul'                        { IBinOp (BS128 I16x8) IMul }
+    | 'i32x4.mul'                        { IBinOp (BS128 I32x4) IMul }
+    | 'i64x2.mul'                        { IBinOp (BS128 I64x2) IMul }
+    | 'i8x16.shl'                        { IBinOp (BS128 I8x16) IShl }
+    | 'i16x8.shl'                        { IBinOp (BS128 I16x8) IShl }
+    | 'i32x4.shl'                        { IBinOp (BS128 I32x4) IShl }
+    | 'i64x2.shl'                        { IBinOp (BS128 I64x2) IShl }
+    | 'i8x16.shr_u'                      { IBinOp (BS128 I8x16) IShrU }
+    | 'i16x8.shr_u'                      { IBinOp (BS128 I16x8) IShrU }
+    | 'i32x4.shr_u'                      { IBinOp (BS128 I32x4) IShrU }
+    | 'i64x2.shr_u'                      { IBinOp (BS128 I64x2) IShrU }
+    | 'i8x16.shr_s'                      { IBinOp (BS128 I8x16) IShrS }
+    | 'i16x8.shr_s'                      { IBinOp (BS128 I16x8) IShrS }
+    | 'i32x4.shr_s'                      { IBinOp (BS128 I32x4) IShrS }
+    | 'i64x2.shr_s'                      { IBinOp (BS128 I64x2) IShrS }
+    | 'i8x16.popcnt'                     { IUnOp (BS128 I8x16) IPopcnt }
+    | 'i8x16.abs'                        { IUnOp (BS128 I8x16) IAbs }
+    | 'i16x8.abs'                        { IUnOp (BS128 I16x8) IAbs }
+    | 'i32x4.abs'                        { IUnOp (BS128 I32x4) IAbs }
+    | 'i64x2.abs'                        { IUnOp (BS128 I64x2) IAbs }
+    | 'i8x16.neg'                        { IUnOp (BS128 I8x16) INeg }
+    | '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 }
+    | 'i64x2.bitmask'                    { V128BitMask I64x2 }
+    | 'i8x16.eq'                         { IRelOp (BS128 I8x16) IEq }
+    | 'i16x8.eq'                         { IRelOp (BS128 I16x8) IEq }
+    | 'i32x4.eq'                         { IRelOp (BS128 I32x4) IEq }
+    | 'i64x2.eq'                         { IRelOp (BS128 I64x2) IEq }
+    | 'i8x16.ne'                         { IRelOp (BS128 I8x16) INe }
+    | 'i16x8.ne'                         { IRelOp (BS128 I16x8) INe }
+    | 'i32x4.ne'                         { IRelOp (BS128 I32x4) INe }
+    | 'i64x2.ne'                         { IRelOp (BS128 I64x2) INe }
+    | 'i8x16.lt_s'                       { IRelOp (BS128 I8x16) ILtS }
+    | 'i16x8.lt_s'                       { IRelOp (BS128 I16x8) ILtS }
+    | 'i32x4.lt_s'                       { IRelOp (BS128 I32x4) ILtS }
+    | 'i64x2.lt_s'                       { IRelOp (BS128 I64x2) ILtS }
+    | 'i8x16.lt_u'                       { IRelOp (BS128 I8x16) ILtU }
+    | 'i16x8.lt_u'                       { IRelOp (BS128 I16x8) ILtU }
+    | 'i32x4.lt_u'                       { IRelOp (BS128 I32x4) ILtU }
+    | 'i64x2.lt_u'                       { IRelOp (BS128 I64x2) ILtU }
+    | 'i8x16.le_s'                       { IRelOp (BS128 I8x16) ILeS }
+    | 'i16x8.le_s'                       { IRelOp (BS128 I16x8) ILeS }
+    | 'i32x4.le_s'                       { IRelOp (BS128 I32x4) ILeS }
+    | 'i64x2.le_s'                       { IRelOp (BS128 I64x2) ILeS }
+    | 'i8x16.le_u'                       { IRelOp (BS128 I8x16) ILeU }
+    | 'i16x8.le_u'                       { IRelOp (BS128 I16x8) ILeU }
+    | 'i32x4.le_u'                       { IRelOp (BS128 I32x4) ILeU }
+    | 'i64x2.le_u'                       { IRelOp (BS128 I64x2) ILeU }
+    | 'i8x16.gt_s'                       { IRelOp (BS128 I8x16) IGtS }
+    | 'i16x8.gt_s'                       { IRelOp (BS128 I16x8) IGtS }
+    | 'i32x4.gt_s'                       { IRelOp (BS128 I32x4) IGtS }
+    | 'i64x2.gt_s'                       { IRelOp (BS128 I64x2) IGtS }
+    | 'i8x16.gt_u'                       { IRelOp (BS128 I8x16) IGtU }
+    | 'i16x8.gt_u'                       { IRelOp (BS128 I16x8) IGtU }
+    | 'i32x4.gt_u'                       { IRelOp (BS128 I32x4) IGtU }
+    | 'i64x2.gt_u'                       { IRelOp (BS128 I64x2) IGtU }
+    | 'i8x16.ge_s'                       { IRelOp (BS128 I8x16) IGeS }
+    | 'i16x8.ge_s'                       { IRelOp (BS128 I16x8) IGeS }
+    | 'i32x4.ge_s'                       { IRelOp (BS128 I32x4) IGeS }
+    | 'i64x2.ge_s'                       { IRelOp (BS128 I64x2) IGeS }
+    | 'i8x16.ge_u'                       { IRelOp (BS128 I8x16) IGeU }
+    | 'i16x8.ge_u'                       { IRelOp (BS128 I16x8) IGeU }
+    | 'i32x4.ge_u'                       { IRelOp (BS128 I32x4) IGeU }
+    | 'i64x2.ge_u'                       { IRelOp (BS128 I64x2) IGeU }
+    | 'f32x4.add'                        { FBinOp (BS128 F32x4) FAdd }
+    | 'f64x2.add'                        { FBinOp (BS128 F64x2) FAdd }
+    | 'f32x4.sub'                        { FBinOp (BS128 F32x4) FSub }
+    | 'f64x2.sub'                        { FBinOp (BS128 F64x2) FSub }
+    | 'f32x4.mul'                        { FBinOp (BS128 F32x4) FMul }
+    | 'f64x2.mul'                        { FBinOp (BS128 F64x2) FMul }
+    | 'f32x4.div'                        { FBinOp (BS128 F32x4) FDiv }
+    | 'f64x2.div'                        { FBinOp (BS128 F64x2) FDiv }
+    | 'f32x4.min'                        { FBinOp (BS128 F32x4) FMin }
+    | 'f64x2.min'                        { FBinOp (BS128 F64x2) FMin }
+    | 'f32x4.max'                        { FBinOp (BS128 F32x4) FMax }
+    | 'f64x2.max'                        { FBinOp (BS128 F64x2) FMax }
+    | 'f32x4.pmin'                       { FBinOp (BS128 F32x4) FPMin }
+    | 'f64x2.pmin'                       { FBinOp (BS128 F64x2) FPMin }
+    | 'f32x4.pmax'                       { FBinOp (BS128 F32x4) FPMax }
+    | 'f64x2.pmax'                       { FBinOp (BS128 F64x2) FPMax }
+    | 'f32x4.abs'                        { FUnOp (BS128 F32x4) FAbs }
+    | 'f64x2.abs'                        { FUnOp (BS128 F64x2) FAbs }
+    | 'f32x4.neg'                        { FUnOp (BS128 F32x4) FNeg }
+    | 'f64x2.neg'                        { FUnOp (BS128 F64x2) FNeg }
+    | 'f32x4.ceil'                       { FUnOp (BS128 F32x4) FCeil }
+    | 'f64x2.ceil'                       { FUnOp (BS128 F64x2) FCeil }
+    | 'f32x4.floor'                      { FUnOp (BS128 F32x4) FFloor }
+    | 'f64x2.floor'                      { FUnOp (BS128 F64x2) FFloor }
+    | 'f32x4.trunc'                      { FUnOp (BS128 F32x4) FTrunc }
+    | 'f64x2.trunc'                      { FUnOp (BS128 F64x2) FTrunc }
+    | 'f32x4.nearest'                    { FUnOp (BS128 F32x4) FNearest }
+    | 'f64x2.nearest'                    { FUnOp (BS128 F64x2) FNearest }
+    | 'f32x4.sqrt'                       { FUnOp (BS128 F32x4) FSqrt }
+    | 'f64x2.sqrt'                       { FUnOp (BS128 F64x2) FSqrt }
+    | 'f32x4.eq'                         { FRelOp (BS128 F32x4) FEq }
+    | 'f64x2.eq'                         { FRelOp (BS128 F64x2) FEq }
+    | 'f32x4.ne'                         { FRelOp (BS128 F32x4) FNe }
+    | 'f64x2.ne'                         { FRelOp (BS128 F64x2) FNe }
+    | 'f32x4.lt'                         { FRelOp (BS128 F32x4) FLt }
+    | 'f64x2.lt'                         { FRelOp (BS128 F64x2) FLt }
+    | 'f32x4.le'                         { FRelOp (BS128 F32x4) FLe }
+    | 'f64x2.le'                         { FRelOp (BS128 F64x2) FLe }
+    | 'f32x4.gt'                         { FRelOp (BS128 F32x4) FGt }
+    | 'f64x2.gt'                         { FRelOp (BS128 F64x2) FGt }
+    | 'f32x4.ge'                         { FRelOp (BS128 F32x4) FGe }
+    | 'f64x2.ge'                         { FRelOp (BS128 F64x2) FGe }
+    | 'i16x8.extend_high_i8x16_s'        { V128IExtend I16x8 I8x16 True True }
+    | 'i16x8.extend_high_i8x16_u'        { V128IExtend I16x8 I8x16 True False }
+    | 'i16x8.extend_low_i8x16_s'         { V128IExtend I16x8 I8x16 False True }
+    | 'i16x8.extend_low_i8x16_u'         { V128IExtend I16x8 I8x16 False False }
+    | 'i32x4.extend_high_i16x8_s'        { V128IExtend I32x4 I16x8 True True }
+    | 'i32x4.extend_high_i16x8_u'        { V128IExtend I32x4 I16x8 True False }
+    | 'i32x4.extend_low_i16x8_s'         { V128IExtend I32x4 I16x8 False True }
+    | 'i32x4.extend_low_i16x8_u'         { V128IExtend I32x4 I16x8 False False}
+    | 'i64x2.extend_high_i32x4_s'        { V128IExtend I64x2 I32x4 True True }
+    | 'i64x2.extend_high_i32x4_u'        { V128IExtend I64x2 I32x4 True False }
+    | 'i64x2.extend_low_i32x4_s'         { V128IExtend I64x2 I32x4 False True }
+    | 'i64x2.extend_low_i32x4_u'         { V128IExtend I64x2 I32x4 False False }
+    | 'i32x4.trunc_sat_f32x4_s'          { I32x4TruncSatF True BS32 }
+    | 'i32x4.trunc_sat_f32x4_u'          { I32x4TruncSatF False BS32 }
+    | 'i32x4.trunc_sat_f64x2_s_zero'     { I32x4TruncSatF True BS64 }
+    | 'i32x4.trunc_sat_f64x2_u_zero'     { I32x4TruncSatF False BS64 }
+    | 'i32x4.dot_i16x8_s'                { I32x4DotI16x8S }
+    | 'i16x8.q15mulr_sat_s'              { I16x8Q15MulrSatS }
 
 typeuse(next)
     : '(' typeuse1(folded_instr_list(next), instruction_list(next)) {
@@ -702,14 +1278,20 @@ memarg4 :: { MemArg }
 memarg8 :: { MemArg }
     : opt(offset) opt(align) {% parseMemArg 8 $1 $2 }
 
+memarg16 :: { MemArg }
+    : opt(offset) opt(align) {% parseMemArg 16 $1 $2 }
+
 select_type_or_instructions(terminator)
-    : terminator { ($1, Nothing, []) }
+    : '(' select_type_or_instructions1(terminator) { $2 }
-    | '(' select_type_or_instructions1(terminator) { $2 }
+    | instruction_list(terminator) {
+        let (end, instr) = $1 in
+        (end, Nothing, instr)
+    }
 
 select_type_or_instructions1(terminator) 
-    : 'result' list(valtype) ')' mixed_instruction_list(terminator) {
+    : 'result' list(valtype) ')' select_type_or_instructions(terminator) {
-        let (end, instr) = $4 in
+        let (end, res, instr) = $4 in
-        (end, Just $2, instr)
+        (end, Just ($2 ++ fromMaybe [] res), instr)
     }
     | folded_instr_list(terminator) {
         let (end, instr) = $1 in
@@ -1007,7 +1589,7 @@ elem1_active_offset :: { ([Instruction], ElemType, [[Instruction]]) }
 elemlist :: { (ElemType, [[Instruction]]) }
     : 'func' list(index) { (FuncRef, funcIndexToExpr $2) }
     | 'funcref' list(elemexpr) { (FuncRef, $2) }
-    | 'externref' { (ExternRef, []) }
+    | 'externref' list(elemexpr) { (ExternRef, $2) }
     | list(index) { (FuncRef, funcIndexToExpr $1) }
 
 elemexpr :: { [Instruction] }
@@ -1082,13 +1664,13 @@ module1 :: { ModuleDef }
 
 action1 :: { Action }
     : 'invoke' opt(ident) string list(folded_instr) ')' {%
-        fmap (Invoke $2 $3) $ (mapM (mapM constInstructionToValue) $4)
+        fmap (Invoke $2 $3) $ (mapM (constInstructionToValue . head) $4)
     }
     | 'get' opt(ident) string ')' { Get $2 $3 }
 
 assertion1 :: { (Maybe AlexPosn, Assertion) }
     : 'assert_return' '(' action1 list(folded_instr) ')' {%
-        fmap ((\a -> ($1, a)) . AssertReturn $3) $ (mapM (mapM constInstructionToValue) $4)
+        fmap ((\a -> ($1, a)) . AssertReturn $3) $ (mapM (constInstructionToValue . head) $4)
     }
     | 'assert_return_canonical_nan' '(' action1 ')' { ($1, AssertReturnCanonicalNaN $3) }
     | 'assert_return_arithmetic_nan' '(' action1 ')' { ($1, AssertReturnArithmeticNaN $3) }
@@ -1229,6 +1811,15 @@ type MemoryIndex = Index
 type ElemIndex = Index
 type DataIndex = Index
 
+data V128Rep =
+    I8x16Const [Integer]
+    | I16x8Const [Integer]
+    | I32x4Const [Integer]
+    | I64x2Const [Integer]
+    | F32x4Const [FloatRep]
+    | F64x2Const [FloatRep]
+    deriving (Show, Eq)
+
 data PlainInstr =
     -- Control instructions
     Unreachable
@@ -1258,6 +1849,23 @@ data PlainInstr =
     | I64Load MemArg
     | F32Load MemArg
     | F64Load MemArg
+    | V128Load MemArg
+    | V128Load8Lane MemArg Natural
+    | V128Load16Lane MemArg Natural
+    | V128Load32Lane MemArg Natural
+    | V128Load64Lane MemArg Natural
+    | V128Load8Splat MemArg
+    | V128Load16Splat MemArg
+    | V128Load32Splat MemArg
+    | V128Load64Splat MemArg
+    | V128Load32Zero MemArg
+    | V128Load64Zero MemArg
+    | V128Load8x8S MemArg
+    | V128Load8x8U MemArg
+    | V128Load16x4S MemArg
+    | V128Load16x4U MemArg
+    | V128Load32x2S MemArg
+    | V128Load32x2U MemArg
     | I32Load8S MemArg
     | I32Load8U MemArg
     | I32Load16S MemArg
@@ -1272,6 +1880,11 @@ data PlainInstr =
     | I64Store MemArg
     | F32Store MemArg
     | F64Store MemArg
+    | V128Store MemArg
+    | V128Store8Lane MemArg Natural
+    | V128Store16Lane MemArg Natural
+    | V128Store32Lane MemArg Natural
+    | V128Store64Lane MemArg Natural
     | I32Store8 MemArg
     | I32Store16 MemArg
     | I64Store8 MemArg
@@ -1297,6 +1910,7 @@ data PlainInstr =
     | I64Const Integer
     | F32Const FloatRep
     | F64Const FloatRep
+    | V128Const V128Rep
     | IUnOp BitSize IUnOp
     | IBinOp BitSize IBinOp
     | I32Eqz
@@ -1318,6 +1932,23 @@ data PlainInstr =
     | F64PromoteF32
     | IReinterpretF BitSize
     | FReinterpretI BitSize
+    -- Vector instructions
+    | V128Splat SimdShape
+    | V128ExtractLane SimdShape Natural Bool
+    | V128ReplaceLane SimdShape Natural
+    | V128AllTrue SimdShape
+    | V128BitMask SimdShape
+    | V128AnyTrue
+    | V128BitSelect
+    | I8x16Shuffle [Int]
+    | I8x16Swizzle
+    | V128Narrow SimdShape SimdShape Bool
+    | F64x2PromoteLowF32x4
+    | F32x4DemoteF64x2Zero
+    | V128IExtend SimdShape SimdShape {- high -} Bool {- signed -} Bool
+    | I32x4TruncSatF {- signed -} Bool {- Float Size -} BitSize
+    | I32x4DotI16x8S
+    | I16x8Q15MulrSatS
     deriving (Show, Eq)
 
 data TypeDef = TypeDef (Maybe Ident) FuncType deriving (Show, Eq)
@@ -1491,15 +2122,22 @@ data Command
     | Meta Meta
     deriving (Show, Eq)
 
+data ValuePattern =
+    ExactValue (S.Instruction Natural)
+    | CanonicalNan
+    | ArithmeticNan
+    | VectorPat SimdShape [ValuePattern]
+    deriving (Show, Eq)
+
 data Action
-    = Invoke (Maybe Ident) TL.Text [S.Expression]
+    = Invoke (Maybe Ident) TL.Text [ValuePattern]
     | Get (Maybe Ident) TL.Text
     deriving (Show, Eq)
 
 type FailureString = TL.Text
 
 data Assertion
-    = AssertReturn Action [S.Expression]
+    = AssertReturn Action [ValuePattern]
     | AssertReturnCanonicalNaN Action
     | AssertReturnArithmeticNaN Action
     | AssertTrap (Either Action ModuleDef) FailureString
@@ -1524,13 +2162,41 @@ data FunCtx = FunCtx {
     ctxParams :: [ParamType]
 } deriving (Eq, Show)
 
-constInstructionToValue :: Instruction -> Either String (S.Instruction Natural)
+v128RepToBytes :: V128Rep -> Either String ByteArray.ByteArray
-constInstructionToValue (PlainInstr (I32Const v)) = return $ S.I32Const $ integerToWord32 v
+v128RepToBytes (I8x16Const bytes) =
-constInstructionToValue (PlainInstr (F32Const v)) = S.F32Const <$> asFloat v
+    return $ ByteArray.byteArrayFromListN 16 $ (fromIntegral :: Integer -> Word8) <$> bytes
-constInstructionToValue (PlainInstr (I64Const v)) = return $ S.I64Const $ integerToWord64 v
+v128RepToBytes (I16x8Const words) =
-constInstructionToValue (PlainInstr (F64Const v)) = S.F64Const <$> asDouble v
+    return $ ByteArray.byteArrayFromListN 8 $ (fromIntegral :: Integer -> Word16) <$> words
-constInstructionToValue (PlainInstr (RefNull et)) = return $ S.RefNull et
+v128RepToBytes (I32x4Const dwords) =
-constInstructionToValue (PlainInstr (RefExtern n)) = return $ S.RefExtern n
+    return $ ByteArray.byteArrayFromListN 4 $ integerToWord32 <$> dwords
+v128RepToBytes (I64x2Const qwords) =
+    return $ ByteArray.byteArrayFromListN 2 $ integerToWord64 <$> qwords
+v128RepToBytes (F32x4Const floats) =
+    ByteArray.byteArrayFromListN 4 <$> mapM (fmap floatToWord . asFloat) floats
+v128RepToBytes (F64x2Const doubles) =
+    ByteArray.byteArrayFromListN 2 <$> mapM (fmap doubleToWord . asDouble) doubles
+
+isNaNRep :: FloatRep -> Bool
+isNaNRep (NanRep Canonical) = True
+isNaNRep (NanRep Arithmetic) = True
+isNaNRep _ = False
+
+constInstructionToValue :: Instruction -> Either String ValuePattern
+constInstructionToValue (PlainInstr (I32Const v)) = return $ ExactValue $ S.I32Const $ integerToWord32 v
+constInstructionToValue (PlainInstr (F32Const (NanRep Canonical))) = return CanonicalNan
+constInstructionToValue (PlainInstr (F32Const (NanRep Arithmetic))) = return ArithmeticNan
+constInstructionToValue (PlainInstr (F32Const v)) = ExactValue . S.F32Const <$> asFloat v
+constInstructionToValue (PlainInstr (I64Const v)) = return $ ExactValue $ S.I64Const $ integerToWord64 v
+constInstructionToValue (PlainInstr (F64Const (NanRep Canonical))) = return CanonicalNan
+constInstructionToValue (PlainInstr (F64Const (NanRep Arithmetic))) = return ArithmeticNan
+constInstructionToValue (PlainInstr (F64Const v)) = ExactValue . S.F64Const <$> asDouble v
+constInstructionToValue (PlainInstr (V128Const (F32x4Const floats))) | any isNaNRep floats =
+    VectorPat F32x4 <$> mapM (constInstructionToValue . PlainInstr . F32Const) floats
+constInstructionToValue (PlainInstr (V128Const (F64x2Const floats))) | any isNaNRep floats =
+    VectorPat F64x2 <$> mapM (constInstructionToValue . PlainInstr . F64Const) floats
+constInstructionToValue (PlainInstr (V128Const v)) = ExactValue . S.V128Const <$> v128RepToBytes v
+constInstructionToValue (PlainInstr (RefNull et)) = return $ ExactValue $ S.RefNull et
+constInstructionToValue (PlainInstr (RefExtern n)) = return $ ExactValue $ S.RefExtern n
 constInstructionToValue _ = Left "Only const instructions supported as arguments for actions"
 
 funcIndexToExpr :: [FuncIndex] -> [[Instruction]]
@@ -1751,6 +2417,23 @@ desugarize fields = do
         synInstrToStruct _ (PlainInstr (I64Load memArg)) = return $ S.I64Load memArg
         synInstrToStruct _ (PlainInstr (F32Load memArg)) = return $ S.F32Load memArg
         synInstrToStruct _ (PlainInstr (F64Load memArg)) = return $ S.F64Load memArg
+        synInstrToStruct _ (PlainInstr (V128Load memArg)) = return $ S.V128Load memArg
+        synInstrToStruct _ (PlainInstr (V128Load8Lane memArg idx)) = return $ S.V128Load8Lane memArg idx
+        synInstrToStruct _ (PlainInstr (V128Load16Lane memArg idx)) = return $ S.V128Load16Lane memArg idx
+        synInstrToStruct _ (PlainInstr (V128Load32Lane memArg idx)) = return $ S.V128Load32Lane memArg idx
+        synInstrToStruct _ (PlainInstr (V128Load64Lane memArg idx)) = return $ S.V128Load64Lane memArg idx
+        synInstrToStruct _ (PlainInstr (V128Load8Splat memArg)) = return $ S.V128Load8Splat memArg
+        synInstrToStruct _ (PlainInstr (V128Load16Splat memArg)) = return $ S.V128Load16Splat memArg
+        synInstrToStruct _ (PlainInstr (V128Load32Splat memArg)) = return $ S.V128Load32Splat memArg
+        synInstrToStruct _ (PlainInstr (V128Load64Splat memArg)) = return $ S.V128Load64Splat memArg
+        synInstrToStruct _ (PlainInstr (V128Load32Zero memArg)) = return $ S.V128Load32Zero memArg
+        synInstrToStruct _ (PlainInstr (V128Load64Zero memArg)) = return $ S.V128Load64Zero memArg
+        synInstrToStruct _ (PlainInstr (V128Load8x8S memArg)) = return $ S.V128Load8x8S memArg
+        synInstrToStruct _ (PlainInstr (V128Load8x8U memArg)) = return $ S.V128Load8x8U memArg
+        synInstrToStruct _ (PlainInstr (V128Load16x4S memArg)) = return $ S.V128Load16x4S memArg
+        synInstrToStruct _ (PlainInstr (V128Load16x4U memArg)) = return $ S.V128Load16x4U memArg
+        synInstrToStruct _ (PlainInstr (V128Load32x2S memArg)) = return $ S.V128Load32x2S memArg
+        synInstrToStruct _ (PlainInstr (V128Load32x2U memArg)) = return $ S.V128Load32x2U memArg
         synInstrToStruct _ (PlainInstr (I32Load8S memArg)) = return $ S.I32Load8S memArg
         synInstrToStruct _ (PlainInstr (I32Load8U memArg)) = return $ S.I32Load8U memArg
         synInstrToStruct _ (PlainInstr (I32Load16S memArg)) = return $ S.I32Load16S memArg
@@ -1765,6 +2448,11 @@ desugarize fields = do
         synInstrToStruct _ (PlainInstr (I64Store memArg)) = return $ S.I64Store memArg
         synInstrToStruct _ (PlainInstr (F32Store memArg)) = return $ S.F32Store memArg
         synInstrToStruct _ (PlainInstr (F64Store memArg)) = return $ S.F64Store memArg
+        synInstrToStruct _ (PlainInstr (V128Store memArg)) = return $ S.V128Store memArg
+        synInstrToStruct _ (PlainInstr (V128Store8Lane memArg idx)) = return $ S.V128Store8Lane memArg idx
+        synInstrToStruct _ (PlainInstr (V128Store16Lane memArg idx)) = return $ S.V128Store16Lane memArg idx
+        synInstrToStruct _ (PlainInstr (V128Store32Lane memArg idx)) = return $ S.V128Store32Lane memArg idx
+        synInstrToStruct _ (PlainInstr (V128Store64Lane memArg idx)) = return $ S.V128Store64Lane memArg idx
         synInstrToStruct _ (PlainInstr (I32Store8 memArg)) = return $ S.I32Store8 memArg
         synInstrToStruct _ (PlainInstr (I32Store16 memArg)) = return $ S.I32Store16 memArg
         synInstrToStruct _ (PlainInstr (I64Store8 memArg)) = return $ S.I64Store8 memArg
@@ -1832,6 +2520,7 @@ desugarize fields = do
         synInstrToStruct _ (PlainInstr (F64Const (NanRep Canonical))) =
             Left "canonical nan constant allowed only in script"
         synInstrToStruct _ (PlainInstr (F64Const rep)) = S.F64Const <$> asDouble rep
+        synInstrToStruct _ (PlainInstr (V128Const rep)) = S.V128Const <$> v128RepToBytes rep
         synInstrToStruct _ (PlainInstr (IUnOp sz op)) = return $ S.IUnOp sz op
         synInstrToStruct _ (PlainInstr (IBinOp sz op)) = return $ S.IBinOp sz op
         synInstrToStruct _ (PlainInstr I32Eqz) = return $ S.I32Eqz
@@ -1853,6 +2542,22 @@ desugarize fields = do
         synInstrToStruct _ (PlainInstr F64PromoteF32) = return $ S.F64PromoteF32
         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 (V128ReplaceLane shape idx)) = return $ S.V128ReplaceLane shape idx
+        synInstrToStruct _ (PlainInstr (V128AllTrue shape)) = return $ S.V128AllTrue shape
+        synInstrToStruct _ (PlainInstr (V128BitMask shape)) = return $ S.V128BitMask shape
+        synInstrToStruct _ (PlainInstr V128AnyTrue) = return $ S.V128AnyTrue
+        synInstrToStruct _ (PlainInstr V128BitSelect) = return $ S.V128BitSelect
+        synInstrToStruct _ (PlainInstr (I8x16Shuffle idxs)) = return $ S.I8x16Shuffle idxs
+        synInstrToStruct _ (PlainInstr I8x16Swizzle) = return $ S.I8x16Swizzle
+        synInstrToStruct _ (PlainInstr F64x2PromoteLowF32x4) = return $ S.F64x2PromoteLowF32x4
+        synInstrToStruct _ (PlainInstr F32x4DemoteF64x2Zero) = return $ S.F32x4DemoteF64x2Zero
+        synInstrToStruct _ (PlainInstr (V128Narrow t f s)) = return $ S.V128Narrow t f s
+        synInstrToStruct _ (PlainInstr (V128IExtend t f h s)) = return $ S.V128IExtend t f h s
+        synInstrToStruct _ (PlainInstr (I32x4TruncSatF s sz)) = return $ S.I32x4TruncSatF s sz
+        synInstrToStruct _ (PlainInstr I32x4DotI16x8S) = return $ S.I32x4DotI16x8S
+        synInstrToStruct _ (PlainInstr I16x8Q15MulrSatS) = return $ S.I16x8Q15MulrSatS
         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/Script.hs

@@ -11,6 +11,7 @@ import qualified Data.Text.Lazy.Encoding as TLEncoding
 import qualified Control.Monad.State as State
 import Control.Monad.IO.Class (liftIO)
 import Numeric.IEEE (identicalIEEE)
+import qualified Data.Primitive.ByteArray as ByteArray
 import qualified Control.DeepSeq as DeepSeq
 import Data.Maybe (fromJust, isNothing)
 import Debug.Trace (trace)
@@ -30,6 +31,9 @@ import qualified Language.Wasm.Structure as Struct
 import qualified Language.Wasm.Parser as Parser
 import qualified Language.Wasm.Lexer as Lexer
 import qualified Language.Wasm.Binary as Binary
+import Language.Wasm.FloatUtils (floatToWord, wordToFloat, doubleToWord, wordToDouble)
+import Numeric.IEEE (nan)
+import Data.Bits ((.&.))
 
 type OnAssertFail = String -> Assertion -> IO ()
 
@@ -56,6 +60,7 @@ runScript onAssertFail script = do
     (st, inst) <- Interpreter.makeHostModule Interpreter.emptyStore [
             ("print", hostPrint []),
             ("print_i32", hostPrint [Struct.I32]),
+            ("print_i64", hostPrint [Struct.I64]),
             ("print_i32_f32", hostPrint [Struct.I32, Struct.F32]),
             ("print_f64_f64", hostPrint [Struct.F64, Struct.F64]),
             ("print_f32", hostPrint [Struct.F32]),
@@ -73,8 +78,8 @@ runScript onAssertFail script = do
         hostGlobals = do
             let globI32 = Interpreter.makeConstGlobal $ Interpreter.VI32 666
             let globI64 = Interpreter.makeConstGlobal $ Interpreter.VI64 666
-            let globF32 = Interpreter.makeConstGlobal $ Interpreter.VF32 666
+            let globF32 = Interpreter.makeConstGlobal $ Interpreter.VF32 666.6
-            let globF64 = Interpreter.makeConstGlobal $ Interpreter.VF64 666
+            let globF64 = Interpreter.makeConstGlobal $ Interpreter.VF64 666.6
             return (
                     Interpreter.HostGlobal globI32,
                     Interpreter.HostGlobal globI64,
@@ -118,16 +123,23 @@ runScript onAssertFail script = do
         getModule st (Just (Ident i)) = Map.lookup i (modules st)
         getModule st Nothing = lastModule st
 
-        asArg :: Struct.Expression -> Interpreter.Value
+        asArg :: Parser.ValuePattern -> Interpreter.Value
-        asArg [Struct.I32Const v] = Interpreter.VI32 v
+        asArg (Parser.ExactValue (Struct.I32Const v)) = Interpreter.VI32 v
-        asArg [Struct.F32Const v] = Interpreter.VF32 v
+        asArg (Parser.ExactValue (Struct.F32Const v)) = Interpreter.VF32 v
-        asArg [Struct.I64Const v] = Interpreter.VI64 v
+        asArg (Parser.ExactValue (Struct.I64Const v)) = Interpreter.VI64 v
-        asArg [Struct.F64Const v] = Interpreter.VF64 v
+        asArg (Parser.ExactValue (Struct.F64Const v)) = Interpreter.VF64 v
-        asArg [Struct.RefNull Struct.FuncRef] = Interpreter.RF Nothing
+        asArg (Parser.ExactValue (Struct.V128Const v)) = Interpreter.VV128 v
-        asArg [Struct.RefNull Struct.ExternRef] = Interpreter.RE Nothing
+        asArg (Parser.ExactValue (Struct.RefNull Struct.FuncRef)) = Interpreter.RF Nothing
-        asArg [Struct.RefExtern v] = Interpreter.RE (Just v)
+        asArg (Parser.ExactValue (Struct.RefNull Struct.ExternRef))= Interpreter.RE Nothing
+        asArg (Parser.ExactValue (Struct.RefExtern v)) = Interpreter.RE (Just v)
         asArg expr = error $ "Only const instructions supported as arguments for actions: " ++ show expr
 
+        showArg :: Parser.ValuePattern -> String
+        showArg v@(Parser.ExactValue _) = show $ asArg v
+        showArg Parser.CanonicalNan = "nan:canonical"
+        showArg Parser.ArithmeticNan = "nan:arithmetic"
+        showArg (Parser.VectorPat _ pat) = show $ showArg <$> pat
+
         runAction :: ScriptState -> Action -> IO (Maybe [Interpreter.Value])
         runAction st (Invoke ident name args) = do
             case getModule st ident of
@@ -141,12 +153,31 @@ runScript onAssertFail script = do
         isValueEqual :: Interpreter.Value -> Interpreter.Value -> Bool
         isValueEqual (Interpreter.VI32 v1) (Interpreter.VI32 v2) = v1 == v2
         isValueEqual (Interpreter.VI64 v1) (Interpreter.VI64 v2) = v1 == v2
-        isValueEqual (Interpreter.VF32 v1) (Interpreter.VF32 v2) = (isNaN v1 && isNaN v2) || identicalIEEE v1 v2
+        isValueEqual (Interpreter.VF32 v1) (Interpreter.VF32 v2) = identicalIEEE v1 v2
-        isValueEqual (Interpreter.VF64 v1) (Interpreter.VF64 v2) = (isNaN v1 && isNaN v2) || identicalIEEE v1 v2
+        isValueEqual (Interpreter.VF64 v1) (Interpreter.VF64 v2) = identicalIEEE v1 v2
+        isValueEqual (Interpreter.VV128 a) (Interpreter.VV128 b) = ByteArray.compareByteArrays a 0 b 0 16 == EQ
         isValueEqual (Interpreter.RF f1) (Interpreter.RF f2) = f1 == f2
         isValueEqual (Interpreter.RE e1) (Interpreter.RE e2) = e1 == e2
         isValueEqual _ _ = False
 
+        isValueMatch :: Interpreter.Value -> Parser.ValuePattern -> Bool
+        isValueMatch val v@(Parser.ExactValue _) = isValueEqual val $ asArg v
+        isValueMatch (Interpreter.VF32 v) Parser.CanonicalNan = identicalIEEE v nan || identicalIEEE v (abs nan)
+        isValueMatch (Interpreter.VF32 v) Parser.ArithmeticNan =
+            let posNan = 0x7F800000 in
+            floatToWord v .&. posNan == posNan
+        isValueMatch (Interpreter.VF64 v) Parser.CanonicalNan = identicalIEEE v nan || identicalIEEE v (abs nan)
+        isValueMatch (Interpreter.VF64 v) Parser.ArithmeticNan =
+            let posNan = 0x7FF0000000000000 in
+            doubleToWord v .&. posNan == posNan
+        isValueMatch (Interpreter.VV128 v) (Parser.VectorPat Struct.F32x4 pat) =
+            let vals = Interpreter.VF32 . wordToFloat . ByteArray.indexByteArray v <$> [0..3] in
+            and $ zipWith isValueMatch vals pat
+        isValueMatch (Interpreter.VV128 v) (Parser.VectorPat Struct.F64x2 pat) =
+            let vals = Interpreter.VF64 . wordToDouble . ByteArray.indexByteArray v <$> [0, 1] in
+            and $ zipWith isValueMatch vals pat
+        isValueMatch _ _ = False
+
         isNaNReturned :: Action -> Assertion -> AssertM ()
         isNaNReturned action assert = do
             result <- runActionInAssert action
@@ -184,6 +215,7 @@ runScript onAssertFail script = do
         getFailureString (Validate.FunctionIndexOutOfRange idx) = ["unknown function", "unknown function " <> TL.pack (show idx)]
         getFailureString (Validate.GlobalIndexOutOfRange idx) = ["unknown global", "unknown global " <> TL.pack (show idx)]
         getFailureString Validate.LabelIndexOutOfRange = ["unknown label"]
+        getFailureString Validate.LaneIndexOutOfRange = ["invalid lane index"]
         getFailureString Validate.TypeIndexOutOfRange = ["unknown type"]
         getFailureString Validate.MinMoreThanMaxInMemoryLimit = ["size minimum must not be greater than maximum"]
         getFailureString Validate.MemoryLimitExceeded = ["memory size must be at most 65536 pages (4GiB)"]
@@ -215,10 +247,10 @@ runScript onAssertFail script = do
             result <- runActionInAssert action
             case result of
                 Just result -> do
-                    if length result == length expected && (all id $ zipWith isValueEqual result (map asArg expected))
+                    if length result == length expected && (all id $ zipWith isValueMatch result expected)
                     then return ()
-                    else printFailedAssert ("Expected " ++ show (map asArg expected) ++ ", but action returned " ++ show result) assert
+                    else printFailedAssert ("Expected " ++ show (map showArg expected) ++ ", but action returned " ++ show result) assert
-                Nothing -> printFailedAssert ("Expected " ++ show (map asArg expected) ++ ", but action returned Trap") assert
+                Nothing -> printFailedAssert ("Expected " ++ show (map showArg expected) ++ ", but action returned Trap") assert
         runAssert assert@(AssertReturnCanonicalNaN action) = isNaNReturned action assert
         runAssert assert@(AssertReturnArithmeticNaN action) = isNaNReturned action assert
         runAssert assert@(AssertInvalid moduleDef failureString) =

src/Language/Wasm/Structure.hs

@@ -33,6 +33,7 @@ module Language.Wasm.Structure (
     FuncType(..),
     ValueType(..),
     BlockType(..),
+    SimdShape(..),
     ParamsType,
     ResultType,
     LocalsType,
@@ -53,12 +54,15 @@ module Language.Wasm.Structure (
 
 import Numeric.Natural (Natural)
 import Data.Word (Word32, Word64)
+import qualified Data.Primitive.ByteArray as ByteArray
 import qualified Data.ByteString.Lazy as LBS
 import qualified Data.Text.Lazy as TL
 import Control.DeepSeq (NFData)
 import GHC.Generics (Generic)
 
-data BitSize = BS32 | BS64 deriving (Show, Eq, Generic, NFData)
+data SimdShape = I8x16 | I16x8 | I32x4 | I64x2 | F32x4 | F64x2 | I128x1 deriving (Show, Eq, Generic, NFData)
+
+data BitSize = BS32 | BS64 | BS128 SimdShape deriving (Show, Eq, Generic, NFData)
 
 data IUnOp =
     IClz
@@ -67,17 +71,27 @@ data IUnOp =
     | IExtend8S
     | IExtend16S
     | IExtend32S
+    | INot
+    | IAbs
+    | INeg
+    | IExtAddPairwise {- Signed -} Bool
     deriving (Show, Eq, Generic, NFData)
 
 data IBinOp =
     IAdd
     | ISub
+    | IAddSatS
+    | ISubSatS
+    | IAddSatU
+    | ISubSatU
+    | IAvgrU
     | IMul
     | IDivU
     | IDivS
     | IRemU
     | IRemS
     | IAnd
+    | IAndNot
     | IOr
     | IXor
     | IShl
@@ -85,13 +99,18 @@ data IBinOp =
     | IShrS
     | IRotl
     | IRotr
+    | IMinU
+    | IMinS
+    | IMaxU
+    | IMaxS
+    | IExtMul {- Signed -} Bool {- High -} Bool
     deriving (Show, Eq, Generic, NFData)
 
 data IRelOp = IEq | INe | ILtU | ILtS | IGtU | IGtS | ILeU | ILeS | IGeU | IGeS deriving (Show, Eq, Generic, NFData)
 
 data FUnOp = FAbs | FNeg | FCeil | FFloor | FTrunc | FNearest | FSqrt deriving (Show, Eq, Generic, NFData)
 
-data FBinOp = FAdd | FSub | FMul | FDiv | FMin | FMax | FCopySign deriving (Show, Eq, Generic, NFData)
+data FBinOp = FAdd | FSub | FMul | FDiv | FMin | FMax | FCopySign | FPMin | FPMax deriving (Show, Eq, Generic, NFData)
 
 data FRelOp = FEq | FNe | FLt | FGt | FLe | FGe deriving (Show, Eq, Generic, NFData)
 
@@ -112,6 +131,7 @@ data ValueType =
     | I64
     | F32
     | F64
+    | V128
     | Func
     | Extern
     deriving (Show, Eq, Generic, NFData)
@@ -159,6 +179,23 @@ data Instruction index =
     | I64Load MemArg
     | F32Load MemArg
     | F64Load MemArg
+    | V128Load MemArg
+    | V128Load8Lane MemArg Natural
+    | V128Load16Lane MemArg Natural
+    | V128Load32Lane MemArg Natural
+    | V128Load64Lane MemArg Natural
+    | V128Load8Splat MemArg
+    | V128Load16Splat MemArg
+    | V128Load32Splat MemArg
+    | V128Load64Splat MemArg
+    | V128Load32Zero MemArg
+    | V128Load64Zero MemArg
+    | V128Load8x8S MemArg
+    | V128Load8x8U MemArg
+    | V128Load16x4S MemArg
+    | V128Load16x4U MemArg
+    | V128Load32x2S MemArg
+    | V128Load32x2U MemArg
     | I32Load8S MemArg
     | I32Load8U MemArg
     | I32Load16S MemArg
@@ -173,6 +210,11 @@ data Instruction index =
     | I64Store MemArg
     | F32Store MemArg
     | F64Store MemArg
+    | V128Store MemArg
+    | V128Store8Lane MemArg Natural
+    | V128Store16Lane MemArg Natural
+    | V128Store32Lane MemArg Natural
+    | V128Store64Lane MemArg Natural
     | I32Store8 MemArg
     | I32Store16 MemArg
     | I64Store8 MemArg
@@ -198,6 +240,7 @@ data Instruction index =
     | I64Const Word64
     | F32Const Float
     | F64Const Double
+    | V128Const ByteArray.ByteArray
     | IUnOp BitSize IUnOp
     | IBinOp BitSize IBinOp
     | I32Eqz
@@ -219,6 +262,23 @@ data Instruction index =
     | F64PromoteF32
     | IReinterpretF BitSize
     | FReinterpretI BitSize
+    -- Vector instructions
+    | V128Splat SimdShape
+    | V128ExtractLane SimdShape index {- signed -} Bool
+    | V128ReplaceLane SimdShape index
+    | V128AllTrue SimdShape
+    | V128BitMask SimdShape
+    | V128AnyTrue
+    | V128BitSelect
+    | I8x16Swizzle
+    | I8x16Shuffle [Int]
+    | V128Narrow SimdShape SimdShape {- signed -} Bool
+    | F64x2PromoteLowF32x4
+    | F32x4DemoteF64x2Zero
+    | V128IExtend SimdShape SimdShape {- high -} Bool {- signed -} Bool
+    | I32x4TruncSatF {- signed -} Bool {- Float Size -} BitSize
+    | I32x4DotI16x8S
+    | I16x8Q15MulrSatS
     deriving (Show, Eq, Generic, NFData)
 
 type Expression = [Instruction Natural]

src/Language/Wasm/Validate.hs

@@ -40,6 +40,7 @@ data ValidationError =
     | ElemIndexOutOfRange Natural
     | DataIndexOutOfRange Natural
     | LabelIndexOutOfRange
+    | LaneIndexOutOfRange
     | TypeIndexOutOfRange
     | ResultTypeDoesntMatch
     | TypeMismatch { actual :: Arrow, expected :: Arrow }
@@ -141,7 +142,7 @@ isArrowMatch (f `Arrow` t) ( f' `Arrow` t') = isEndMatch f f' && isEndMatch t t'
 data Ctx = Ctx {
     types :: [FuncType],
     funcs :: [FuncType],
-    tables :: [TableType],
+    tableTypes :: [TableType],
     elems :: [ElemType],
     datas :: [DataMode],
     mems :: [Limit],
@@ -192,10 +193,13 @@ getLabel lbl = do
 withLabel :: [ValueType] -> Checker a -> Checker a
 withLabel result = withReaderT (\ctx -> ctx { labels = result : labels ctx })
 
-isMemArgValid :: Int -> MemArg -> Checker ()
+isMemArgValid :: Natural -> MemArg -> Checker ()
-isMemArgValid sizeInBytes MemArg { align } = if 2 ^ align <= sizeInBytes then return () else throwError AlignmentOverflow
+isMemArgValid sizeInBytes MemArg { align } =
+    if 2 ^ align <= sizeInBytes
+    then return ()
+    else throwError AlignmentOverflow
 
-checkMemoryInstr :: Int -> MemArg -> Checker ()
+checkMemoryInstr :: Natural -> MemArg -> Checker ()
 checkMemoryInstr size memarg = do
     isMemArgValid size memarg
     Ctx { mems } <- ask 
@@ -273,10 +277,12 @@ getInstrType _ (Call fun) = do
     Ctx { funcs } <- ask
     maybeToEither (FunctionIndexOutOfRange fun) $ asArrow <$> funcs !? fun
 getInstrType _ (CallIndirect tableIdx sign) = do
-    Ctx { types, tables } <- ask
+    Ctx { types, tableTypes = tables } <- ask
     if length tables <= fromIntegral tableIdx
     then throwError (TableIndexOutOfRange tableIdx)
     else do
+        let TableType _ elemType = tables !! fromIntegral tableIdx
+        when (elemType /= FuncRef) $ throwError (RefTypeMismatch FuncRef ExternRef)
         Arrow from to <- maybeToEither TypeIndexOutOfRange $ asArrow <$> types !? sign
         return $ (from ++ [Val I32]) ==> to
 getInstrType _ Drop = do
@@ -336,6 +342,61 @@ getInstrType _ (F32Load memarg) = do
 getInstrType _ (F64Load memarg) = do
     checkMemoryInstr 8 memarg
     return $ I32 ==> F64
+getInstrType _ (V128Load memarg) = do
+    checkMemoryInstr 16 memarg
+    return $ I32 ==> V128
+getInstrType _ (V128Load8Lane memarg idx) = do
+    checkMemoryInstr 1 memarg
+    when (idx >= 16) $ throwError LaneIndexOutOfRange
+    return $ [I32, V128] ==> V128
+getInstrType _ (V128Load16Lane memarg idx) = do
+    checkMemoryInstr 2 memarg
+    when (idx >= 8) $ throwError LaneIndexOutOfRange
+    return $ [I32, V128] ==> V128
+getInstrType _ (V128Load32Lane memarg idx) = do
+    checkMemoryInstr 4 memarg
+    when (idx >= 4) $ throwError LaneIndexOutOfRange
+    return $ [I32, V128] ==> V128
+getInstrType _ (V128Load64Lane memarg idx) = do
+    checkMemoryInstr 8 memarg
+    when (idx >= 2) $ throwError LaneIndexOutOfRange
+    return $ [I32, V128] ==> V128
+getInstrType _ (V128Load8Splat memarg) = do
+    checkMemoryInstr 1 memarg
+    return $ I32 ==> V128
+getInstrType _ (V128Load16Splat memarg) = do
+    checkMemoryInstr 2 memarg
+    return $ I32 ==> V128
+getInstrType _ (V128Load32Splat memarg) = do
+    checkMemoryInstr 4 memarg
+    return $ I32 ==> V128
+getInstrType _ (V128Load64Splat memarg) = do
+    checkMemoryInstr 8 memarg
+    return $ I32 ==> V128
+getInstrType _ (V128Load32Zero memarg) = do
+    checkMemoryInstr 4 memarg
+    return $ I32 ==> V128
+getInstrType _ (V128Load64Zero memarg) = do
+    checkMemoryInstr 8 memarg
+    return $ I32 ==> V128
+getInstrType _ (V128Load8x8S memarg) = do
+    checkMemoryInstr 8 memarg
+    return $ I32 ==> V128
+getInstrType _ (V128Load8x8U memarg) = do
+    checkMemoryInstr 8 memarg
+    return $ I32 ==> V128
+getInstrType _ (V128Load16x4S memarg) = do
+    checkMemoryInstr 8 memarg
+    return $ I32 ==> V128
+getInstrType _ (V128Load16x4U memarg) = do
+    checkMemoryInstr 8 memarg
+    return $ I32 ==> V128
+getInstrType _ (V128Load32x2S memarg) = do
+    checkMemoryInstr 8 memarg
+    return $ I32 ==> V128
+getInstrType _ (V128Load32x2U memarg) = do
+    checkMemoryInstr 8 memarg
+    return $ I32 ==> V128
 getInstrType _ (I32Load8S memarg) = do
     checkMemoryInstr 1 memarg
     return $ I32 ==> I32
@@ -378,6 +439,25 @@ getInstrType _ (F32Store memarg) = do
 getInstrType _ (F64Store memarg) = do
     checkMemoryInstr 8 memarg
     return $ [I32, F64] ==> empty
+getInstrType _ (V128Store memarg) = do
+    checkMemoryInstr 16 memarg
+    return $ [I32, V128] ==> empty
+getInstrType _ (V128Store8Lane memarg idx) = do
+    checkMemoryInstr 1 memarg
+    when (idx >= 16) $ throwError LaneIndexOutOfRange
+    return $ [I32, V128] ==> empty
+getInstrType _ (V128Store16Lane memarg idx) = do
+    checkMemoryInstr 2 memarg
+    when (idx >= 8) $ throwError LaneIndexOutOfRange
+    return $ [I32, V128] ==> empty
+getInstrType _ (V128Store32Lane memarg idx) = do
+    checkMemoryInstr 4 memarg
+    when (idx >= 4) $ throwError LaneIndexOutOfRange
+    return $ [I32, V128] ==> empty
+getInstrType _ (V128Store64Lane memarg idx) = do
+    checkMemoryInstr 8 memarg
+    when (idx >= 2) $ throwError LaneIndexOutOfRange
+    return $ [I32, V128] ==> empty
 getInstrType _ (I32Store8 memarg) = do
     checkMemoryInstr 1 memarg
     return $ [I32, I32] ==> empty
@@ -419,7 +499,7 @@ getInstrType _ (DataDrop dataIdx) = do
     when (length datas <= fromIntegral dataIdx) $ throwError (DataIndexOutOfRange dataIdx)
     return $ empty ==> empty
 getInstrType _ (TableInit tableIdx elemIdx) = do
-    Ctx { tables, elems } <- ask
+    Ctx { tableTypes = tables, elems } <- ask
     when (length tables <= fromIntegral tableIdx) $ throwError (TableIndexOutOfRange tableIdx)
     when (length elems <= fromIntegral elemIdx) $ throwError (ElemIndexOutOfRange elemIdx)
     let TableType _ tableType = tables !! fromIntegral tableIdx
@@ -427,7 +507,7 @@ getInstrType _ (TableInit tableIdx elemIdx) = do
     when (elemType /= tableType) $ throwError (RefTypeMismatch tableType elemType)
     return $ [I32, I32, I32] ==> empty
 getInstrType _ (TableCopy toIdx fromIdx) = do
-    Ctx { tables } <- ask
+    Ctx { tableTypes = tables } <- ask
     let (from, to) = (fromIntegral fromIdx, fromIntegral toIdx)
     when (length tables <= from) $ throwError (TableIndexOutOfRange fromIdx)
     when (length tables <= to) $ throwError (TableIndexOutOfRange toIdx)
@@ -436,26 +516,26 @@ getInstrType _ (TableCopy toIdx fromIdx) = do
     when (fromType /= toType) $ throwError (RefTypeMismatch fromType toType)
     return $ [I32, I32, I32] ==> empty
 getInstrType _ (TableFill tableIdx) = do
-    Ctx { tables } <- ask
+    Ctx { tableTypes = tables } <- ask
     when (length tables <= fromIntegral tableIdx) $ throwError (TableIndexOutOfRange tableIdx)
     let TableType _ tableType = tables !! fromIntegral tableIdx
     return $ [I32, elemTypeToRefType tableType, I32] ==> empty
 getInstrType _ (TableSize tableIdx) = do
-    Ctx { tables } <- ask
+    Ctx { tableTypes = tables } <- ask
     when (length tables <= fromIntegral tableIdx) $ throwError (TableIndexOutOfRange tableIdx)
     return $ empty ==> I32
 getInstrType _ (TableGrow tableIdx) = do
-    Ctx { tables } <- ask
+    Ctx { tableTypes = tables } <- ask
     when (length tables <= fromIntegral tableIdx) $ throwError (TableIndexOutOfRange tableIdx)
     let TableType _ tableType = tables !! fromIntegral tableIdx
     return $ [elemTypeToRefType tableType, I32] ==> I32
 getInstrType _ (TableGet tableIdx) = do
-    Ctx { tables } <- ask
+    Ctx { tableTypes = tables } <- ask
     when (length tables <= fromIntegral tableIdx) $ throwError (TableIndexOutOfRange tableIdx)
     let TableType _ tableType = tables !! fromIntegral tableIdx
     return $ I32 ==> (elemTypeToRefType tableType)
 getInstrType _ (TableSet tableIdx) = do
-    Ctx { tables } <- ask
+    Ctx { tableTypes = tables } <- ask
     when (length tables <= fromIntegral tableIdx) $ throwError (TableIndexOutOfRange tableIdx)
     let TableType _ tableType = tables !! fromIntegral tableIdx
     return $ [I32, elemTypeToRefType tableType] ==> empty
@@ -467,20 +547,29 @@ getInstrType _ (I32Const _) = return $ empty ==> I32
 getInstrType _ (I64Const _) = return $ empty ==> I64
 getInstrType _ (F32Const _) = return $ empty ==> F32
 getInstrType _ (F64Const _) = return $ empty ==> F64
+getInstrType _ (V128Const _) = return $ empty ==> V128
 getInstrType _ (IUnOp BS32 _) = return $ I32 ==> I32
 getInstrType _ (IUnOp BS64 _) = return $ I64 ==> I64
+getInstrType _ (IUnOp (BS128 _) _) = return $ V128 ==> V128
 getInstrType _ (IBinOp BS32 _) = return $ [I32, I32] ==> I32
 getInstrType _ (IBinOp BS64 _) = return $ [I64, I64] ==> I64
+getInstrType _ (IBinOp (BS128 _) op) | op == IShl || op == IShrS || op == IShrU =
+    return $ [V128, I32] ==> V128
+getInstrType _ (IBinOp (BS128 _) _) = return $ [V128, V128] ==> V128
 getInstrType _ I32Eqz = return $ I32 ==> I32
 getInstrType _ I64Eqz = return $ I64 ==> I32
 getInstrType _ (IRelOp BS32 _) = return $ [I32, I32] ==> I32
 getInstrType _ (IRelOp BS64 _) = return $ [I64, I64] ==> I32
+getInstrType _ (IRelOp (BS128 _) _) = return $ [V128, V128] ==> V128
 getInstrType _ (FUnOp BS32 _) = return $ F32 ==> F32
 getInstrType _ (FUnOp BS64 _) = return $ F64 ==> F64
+getInstrType _ (FUnOp (BS128 _) _) = return $ V128 ==> V128
 getInstrType _ (FBinOp BS32 _) = return $ [F32, F32] ==> F32
 getInstrType _ (FBinOp BS64 _) = return $ [F64, F64] ==> F64
+getInstrType _ (FBinOp (BS128 _) _) = return $ [V128, V128] ==> V128
 getInstrType _ (FRelOp BS32 _) = return $ [F32, F32] ==> I32
 getInstrType _ (FRelOp BS64 _) = return $ [F64, F64] ==> I32
+getInstrType _ (FRelOp (BS128 _) _) = return $ [V128, V128] ==> V128
 getInstrType _ I32WrapI64 = return $ I64 ==> I32
 getInstrType _ (ITruncFU BS32 BS32) = return $ F32 ==> I32
 getInstrType _ (ITruncFU BS32 BS64) = return $ F64 ==> I32
@@ -504,17 +593,71 @@ getInstrType _ (FConvertIU BS32 BS32) = return $ I32 ==> F32
 getInstrType _ (FConvertIU BS32 BS64) = return $ I64 ==> F32
 getInstrType _ (FConvertIU BS64 BS32) = return $ I32 ==> F64
 getInstrType _ (FConvertIU BS64 BS64) = return $ I64 ==> F64
+getInstrType _ (FConvertIU (BS128 _) (BS128 _)) = return $ V128 ==> V128
 getInstrType _ (FConvertIS BS32 BS32) = return $ I32 ==> F32
 getInstrType _ (FConvertIS BS32 BS64) = return $ I64 ==> F32
 getInstrType _ (FConvertIS BS64 BS32) = return $ I32 ==> F64
 getInstrType _ (FConvertIS BS64 BS64) = return $ I64 ==> F64
+getInstrType _ (FConvertIS (BS128 _) (BS128 _)) = return $ V128 ==> V128
 getInstrType _ F32DemoteF64 = return $ F64 ==> F32
 getInstrType _ F64PromoteF32 = return $ F32 ==> F64
 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 _ I8x16Swizzle =
+    return $ [V128, V128] ==> V128
+getInstrType _ (I8x16Shuffle idxs) = do
+    when (any (>= 32) idxs) $ throwError LaneIndexOutOfRange
+    return $ [V128, V128] ==> V128
+getInstrType _ (V128Splat shape) =
+    return $ getShapeElemType shape ==> V128
+getInstrType _ (V128ExtractLane shape idx _) = do
+    when (idx >= lanesCount shape) $ throwError LaneIndexOutOfRange
+    return $ V128 ==> getShapeElemType shape
+getInstrType _ (V128ReplaceLane shape idx) = do
+    when (idx >= lanesCount shape) $ throwError LaneIndexOutOfRange
+    return $ [V128, getShapeElemType shape] ==> V128
+getInstrType _ (V128AllTrue _) =
+    return $ V128 ==> I32
+getInstrType _ V128AnyTrue =
+    return $ V128 ==> I32
+getInstrType _ V128BitSelect =
+    return $ [V128, V128, V128] ==> V128
+getInstrType _ (V128BitMask _) =
+    return $ V128 ==> I32
+getInstrType _ (V128Narrow _ _ _) =
+    return $ [V128, V128] ==> V128
+getInstrType _ F64x2PromoteLowF32x4 =
+    return $ V128 ==> V128
+getInstrType _ F32x4DemoteF64x2Zero =
+    return $ V128 ==> V128
+getInstrType _ (V128IExtend _ _ _ _) =
+    return $ V128 ==> V128
+getInstrType _ (I32x4TruncSatF _ _) =
+    return $ V128 ==> V128
+getInstrType _ I32x4DotI16x8S =
+    return $[V128, V128] ==> V128
+getInstrType _ I16x8Q15MulrSatS =
+    return $ [V128, V128] ==> V128
 
+getShapeElemType :: SimdShape -> ValueType
+getShapeElemType I8x16 = I32
+getShapeElemType I16x8 = I32
+getShapeElemType I32x4 = I32
+getShapeElemType I64x2 = I64
+getShapeElemType F32x4 = F32
+getShapeElemType F64x2 = F64
+
+lanesCount :: SimdShape -> Natural
+lanesCount shape = case shape of
+    I8x16 -> 16
+    I16x8 -> 8
+    I32x4 -> 4
+    I64x2 -> 2
+    F32x4 -> 4
+    F64x2 -> 2
+    I128x1 -> 1
 
 replace :: (Eq a) => a -> a -> [a] -> [a]
 replace _ _ [] = []
@@ -575,6 +718,7 @@ isConstExpression ((I32Const _):rest) = isConstExpression rest
 isConstExpression ((I64Const _):rest) = isConstExpression rest
 isConstExpression ((F32Const _):rest) = isConstExpression rest
 isConstExpression ((F64Const _):rest) = isConstExpression rest
+isConstExpression ((V128Const _):rest) = isConstExpression rest
 isConstExpression ((RefNull _):rest) = isConstExpression rest
 isConstExpression ((RefFunc _):rest) = isConstExpression rest
 isConstExpression ((GetGlobal idx):rest) = do
@@ -604,7 +748,7 @@ ctxFromModule locals labels returns m =
     Ctx {
         types,
         funcs = getFuncTypes m,
-        tables = tableImports ++ map (\(Table t) -> t) tables,
+        tableTypes = tableImports ++ map (\(Table t) -> t) tables,
         elems = map elemType elems,
         datas = map dataMode datas,
         mems = memsImports ++ map (\(Memory l) -> l) mems,
@@ -706,8 +850,6 @@ elemsShouldBeValid m@Module { elems, functions, tables, imports } =
     where
         isElemValid :: Ctx -> ElemSegment -> ValidationResult
         isElemValid ctx (ElemSegment elemType mode elements) = do
-            unless (elemType == FuncRef)
-                $ throwError $ RefTypeMismatch FuncRef elemType
             forM_ elements $ \elem -> runChecker ctx $ do
                 arr <- getExpressionType elem
                 isConstExpression elem
@@ -722,6 +864,9 @@ elemsShouldBeValid m@Module { elems, functions, tables, imports } =
                     let tableImports = filter isTableImport imports
                     when (tableIdx >= fromIntegral (length tableImports + length tables)) $ do
                         throwError $ TableIndexOutOfRange tableIdx
+                    let TableType _ tableType = tableTypes ctx !! (fromIntegral tableIdx)
+                    when (tableType /= elemType) $ do
+                        throwError $ RefTypeMismatch elemType tableType
                 _ -> return ()
         
         isValidRef :: ElemType -> Arrow -> Bool

tests/Test.hs

@@ -17,9 +17,9 @@ import qualified Data.List as List
 main :: IO ()
 main = do
   files <-
-    filter (not . List.isPrefixOf "simd") . filter (List.isSuffixOf ".wast")
+    filter (List.isSuffixOf ".wast")
       <$> Directory.listDirectory "tests/spec"
-  -- let files = ["bulk.wast"]
+  -- let files = ["align.wast"]
   scriptTestCases <- (`mapM` files) $ \file -> do
     test <- LBS.readFile ("tests/spec/" ++ file)
     return $ testCase file $ do

wasm.cabal

@@ -56,7 +56,7 @@ library
     , happy:happy >=1.9.4 && < 1.21
   build-depends:
       array >=0.5 && < 0.6
-    , base >=4.6 && < 5
+    , base >=4.11 && < 5
     , bytestring >=0.10 && < 0.12
     , cereal >=0.5 && < 0.6
     , containers >=0.5 && < 0.7