Merge pull request #25 from RyanGlScott/ghc-9.8-9.10

Bump dependencies ranges to allow building with GHC 9.8 and 9.10
Allow building with GHC 9.8 and 9.10
2024-06-04 07:22:59 -06:00 · 2024-06-03 07:00:39 -04:00
10 changed files with 474 additions and 2350 deletions
@@ -1,7 +1,6 @@
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE TypeApplications #-}

 module Language.Wasm.Binary (
    dumpModule,
@@ -17,8 +16,6 @@ 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
@@ -224,7 +221,6 @@ instance Serialize ValueType where
    put I64 = putWord8 0x7E
    put F32 = putWord8 0x7D
    put F64 = putWord8 0x7C
-    put V128 = putWord8 0x7B

    get = do
        op <- getWord8
@@ -233,7 +229,6 @@ 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
@@ -341,7 +336,6 @@ 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 }

@@ -464,10 +458,6 @@ 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
@@ -813,13 +803,6 @@ 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
@@ -39,13 +39,13 @@ $alpha     = [$lower $upper]
 $namepunct = [\! \# \$ \% \& \' \* \+ \- \. \/ \: \< \= \> \? \@ \∖ \^ \_ \` \| \~]
 $idchar    = [$digit $alpha $namepunct]
 $space     = [\  \x09 \x0A \x0D]
-$linechar  = [^ \x09 \x0A \x0D]
+$linechar  = [^ \x09]
 $sign      = [\+ \-]
 $doublequote = \"

@keyword     = $lower $idchar*
@reserved    = $idchar+
-@linecomment = ";;" $linechar* [\x0A \x0D]
+@linecomment = ";;" $linechar* \x0A
@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, Maybe Bool)
+parseSign :: (Num a) => LBS.ByteString -> ((a -> a), Int64)
 parseSign str =
    let Just (ch, _) = LBSUtf8.decode str in
    case ch of
-        '-' -> (negate, 1, Just True)
-        '+' -> (abs, 1, Just False)
-        otherwise -> (abs, 0, Nothing)
+        '-' -> (negate, 1)
+        '+' -> (abs, 1)
+        otherwise -> (abs, 0)

-{-# SPECIALIZE parseSign :: LBS.ByteString -> ((Integer -> Integer), Int64, Maybe Bool) #-}
-{-# SPECIALIZE parseSign :: LBS.ByteString -> ((Double -> Double), Int64, Maybe Bool) #-}
+{-# SPECIALIZE parseSign :: LBS.ByteString -> ((Integer -> Integer), Int64) #-}
+{-# SPECIALIZE parseSign :: LBS.ByteString -> ((Double -> Double), Int64) #-}

 parseHexalSignedInt :: AlexAction Lexeme
 parseHexalSignedInt = token $ \(pos, _, s, _) len -> 
-    let (sign, slen, nat) = parseSign s in
+    let (sign, slen) = parseSign s in
    let num = readHexFromPrefix (len - 2 - slen) $ LBSUtf8.drop (2 + slen) s in
-    Lexeme (Just pos) $ TIntLit nat $ sign num
+    Lexeme (Just pos) $ TIntLit $ 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, nat) = parseSign s in
+    let (sign, slen) = parseSign s in
    let num = readDecFromPrefix (len - slen) $ LBSUtf8.drop slen s in
-    Lexeme (Just pos) $ TIntLit nat $ sign num
+    Lexeme (Just pos) $ TIntLit $ sign num

 parseDecFloat :: AlexAction Lexeme
 parseDecFloat = token $ \(pos, _, s, _) len ->
@@ -226,13 +226,11 @@ readHexFloat toFloat sz expLimit manitisaSize str = do
                        then ([True], 0, exp' + 1)
                        else (rounded, 1, exp')
                    else (rounded, 0, exp')
-        e <- if exp'' > expLimit then Left "const out of range"
-                else if exp'' < (negate $ expLimit + manitisaSize) then return $ negate $ expLimit + manitisaSize + 1
-                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'))
+        if exp'' > expLimit || exp'' < (negate $ expLimit + manitisaSize) then Left "constant out of range" else return ()
+        if exp'' >= (negate $ expLimit - 1)
+        then return $ toFloat $ sign .|. ((fromIntegral $ exp'' + expLimit) `shiftL` manitisaSize) .|. ((fromBits (tail bits') + a) `shiftL` (manitisaSize + 1 - length bits'))
        else do
-            let shift = expLimit + manitisaSize - length bits' - abs e
+            let shift = expLimit + manitisaSize - length bits' - abs exp''
            if shift < 0
            then return $ toFloat sign
            else return $ toFloat $ sign .|. ((fromBits bits' + a) `shiftL` shift)
@@ -366,7 +364,7 @@ data NaN
    deriving (Show, Eq)

 data Token = TKeyword LBS.ByteString
-    | TIntLit {- Natural -} (Maybe Bool) Integer
+    | TIntLit Integer
    | TFloatLit FloatRep
    | TStringLit LBS.ByteString
    | TId LBS.ByteString
@@ -11,7 +11,6 @@ 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)
@@ -31,9 +30,6 @@ 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 ()

@@ -78,8 +74,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.6
-            let globF64 = Interpreter.makeConstGlobal $ Interpreter.VF64 666.6
+            let globF32 = Interpreter.makeConstGlobal $ Interpreter.VF32 666
+            let globF64 = Interpreter.makeConstGlobal $ Interpreter.VF64 666
            return (
                    Interpreter.HostGlobal globI32,
                    Interpreter.HostGlobal globI64,
@@ -123,23 +119,16 @@ runScript onAssertFail script = do
        getModule st (Just (Ident i)) = Map.lookup i (modules st)
        getModule st Nothing = lastModule st

-        asArg :: Parser.ValuePattern -> Interpreter.Value
-        asArg (Parser.ExactValue (Struct.I32Const v)) = Interpreter.VI32 v
-        asArg (Parser.ExactValue (Struct.F32Const v)) = Interpreter.VF32 v
-        asArg (Parser.ExactValue (Struct.I64Const v)) = Interpreter.VI64 v
-        asArg (Parser.ExactValue (Struct.F64Const v)) = Interpreter.VF64 v
-        asArg (Parser.ExactValue (Struct.V128Const v)) = Interpreter.VV128 v
-        asArg (Parser.ExactValue (Struct.RefNull Struct.FuncRef)) = Interpreter.RF Nothing
-        asArg (Parser.ExactValue (Struct.RefNull Struct.ExternRef))= Interpreter.RE Nothing
-        asArg (Parser.ExactValue (Struct.RefExtern v)) = Interpreter.RE (Just v)
+        asArg :: Struct.Expression -> Interpreter.Value
+        asArg [Struct.I32Const v] = Interpreter.VI32 v
+        asArg [Struct.F32Const v] = Interpreter.VF32 v
+        asArg [Struct.I64Const v] = Interpreter.VI64 v
+        asArg [Struct.F64Const v] = Interpreter.VF64 v
+        asArg [Struct.RefNull Struct.FuncRef] = Interpreter.RF Nothing
+        asArg [Struct.RefNull Struct.ExternRef] = Interpreter.RE Nothing
+        asArg [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
@@ -153,31 +142,12 @@ 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) = 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.VF32 v1) (Interpreter.VF32 v2) = (isNaN v1 && isNaN v2) || identicalIEEE v1 v2
+        isValueEqual (Interpreter.VF64 v1) (Interpreter.VF64 v2) = (isNaN v1 && isNaN v2) || identicalIEEE v1 v2
        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
@@ -215,7 +185,6 @@ 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)"]
@@ -247,10 +216,10 @@ runScript onAssertFail script = do
            result <- runActionInAssert action
            case result of
                Just result -> do
-                    if length result == length expected && (all id $ zipWith isValueMatch result expected)
+                    if length result == length expected && (all id $ zipWith isValueEqual result (map asArg expected))
                    then return ()
-                    else printFailedAssert ("Expected " ++ show (map showArg expected) ++ ", but action returned " ++ show result) assert
-                Nothing -> printFailedAssert ("Expected " ++ show (map showArg expected) ++ ", but action returned Trap") assert
+                    else printFailedAssert ("Expected " ++ show (map asArg expected) ++ ", but action returned " ++ show result) assert
+                Nothing -> printFailedAssert ("Expected " ++ show (map asArg 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) =
@@ -33,7 +33,6 @@ module Language.Wasm.Structure (
    FuncType(..),
    ValueType(..),
    BlockType(..),
-    SimdShape(..),
    ParamsType,
    ResultType,
    LocalsType,
@@ -54,15 +53,12 @@ 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 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 BitSize = BS32 | BS64 deriving (Show, Eq, Generic, NFData)

 data IUnOp =
    IClz
@@ -71,27 +67,17 @@ 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
@@ -99,18 +85,13 @@ 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 | FPMin | FPMax deriving (Show, Eq, Generic, NFData)
+data FBinOp = FAdd | FSub | FMul | FDiv | FMin | FMax | FCopySign deriving (Show, Eq, Generic, NFData)

 data FRelOp = FEq | FNe | FLt | FGt | FLe | FGe deriving (Show, Eq, Generic, NFData)

@@ -131,7 +112,6 @@ data ValueType =
    | I64
    | F32
    | F64
-    | V128
    | Func
    | Extern
    deriving (Show, Eq, Generic, NFData)
@@ -179,23 +159,6 @@ 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
@@ -210,11 +173,6 @@ 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
@@ -240,7 +198,6 @@ data Instruction index =
    | I64Const Word64
    | F32Const Float
    | F64Const Double
-    | V128Const ByteArray.ByteArray
    | IUnOp BitSize IUnOp
    | IBinOp BitSize IBinOp
    | I32Eqz
@@ -262,23 +219,6 @@ 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]
@@ -40,7 +40,6 @@ data ValidationError =
    | ElemIndexOutOfRange Natural
    | DataIndexOutOfRange Natural
    | LabelIndexOutOfRange
-    | LaneIndexOutOfRange
    | TypeIndexOutOfRange
    | ResultTypeDoesntMatch
    | TypeMismatch { actual :: Arrow, expected :: Arrow }
@@ -193,13 +192,10 @@ getLabel lbl = do
 withLabel :: [ValueType] -> Checker a -> Checker a
 withLabel result = withReaderT (\ctx -> ctx { labels = result : labels ctx })

-isMemArgValid :: Natural -> MemArg -> Checker ()
-isMemArgValid sizeInBytes MemArg { align } =
-    if 2 ^ align <= sizeInBytes
-    then return ()
-    else throwError AlignmentOverflow
+isMemArgValid :: Int -> MemArg -> Checker ()
+isMemArgValid sizeInBytes MemArg { align } = if 2 ^ align <= sizeInBytes then return () else throwError AlignmentOverflow

-checkMemoryInstr :: Natural -> MemArg -> Checker ()
+checkMemoryInstr :: Int -> MemArg -> Checker ()
 checkMemoryInstr size memarg = do
    isMemArgValid size memarg
    Ctx { mems } <- ask 
@@ -281,8 +277,6 @@ getInstrType _ (CallIndirect tableIdx sign) = do
    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
@@ -342,61 +336,6 @@ 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
@@ -439,25 +378,6 @@ 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
@@ -547,29 +467,20 @@ 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
@@ -593,71 +504,17 @@ 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 _ _ [] = []
@@ -718,7 +575,6 @@ 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
@@ -17,9 +17,9 @@ import qualified Data.List as List
 main :: IO ()
 main = do
  files <-
-    filter (List.isSuffixOf ".wast")
+    filter (not . List.isPrefixOf "simd") . filter (List.isSuffixOf ".wast")
      <$> Directory.listDirectory "tests/spec"
-  -- let files = ["align.wast"]
+  -- let files = ["binary-leb128.wast"]
  scriptTestCases <- (`mapM` files) $ \file -> do
    test <- LBS.readFile ("tests/spec/" ++ file)
    return $ testCase file $ do
@@ -56,14 +56,14 @@ library
    , happy:happy >=1.9.4 && < 1.21
  build-depends:
      array >=0.5 && < 0.6
-    , base >=4.11 && < 5
-    , bytestring >=0.10 && < 0.12
+    , base >=4.6 && < 5
+    , bytestring >=0.10 && < 0.13
    , cereal >=0.5 && < 0.6
-    , containers >=0.5 && < 0.7
-    , deepseq >=1.4 && < 1.5
+    , containers >=0.5 && < 0.8
+    , deepseq >=1.4 && < 1.6
    , ieee754 >=0.8 && < 0.9
    , mtl >=2.2.1 && < 2.4
-    , primitive >=0.7 && < 0.8
+    , primitive >=0.7 && < 0.10
    , text >=1.1 && < 3
    , transformers >=0.4 && < 0.7
    , utf8-string >=1.0 && < 1.1