GitHub/haskell-wasm
1
0
Fork 1
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Compare commits

merge into: GitHub/haskell-wasm:simd
Branches Tags
GitHub/haskell-wasm:master GitHub/haskell-wasm:simd GitHub/haskell-wasm:references-simd GitHub/haskell-wasm:spec-1.1.0 GitHub/haskell-wasm:update-tests GitHub/haskell-wasm:refactoring/builder-monad-2 GitHub/haskell-wasm:refactoring/builder-monad GitHub/haskell-wasm:type-enforced-ast GitHub/haskell-wasm:cli
..
pull from: GitHub/haskell-wasm:master
Branches Tags
GitHub/haskell-wasm:simd GitHub/haskell-wasm:master GitHub/haskell-wasm:references-simd GitHub/haskell-wasm:spec-1.1.0 GitHub/haskell-wasm:update-tests GitHub/haskell-wasm:refactoring/builder-monad-2 GitHub/haskell-wasm:refactoring/builder-monad GitHub/haskell-wasm:type-enforced-ast GitHub/haskell-wasm:cli

2 Commits
simd .. master

Author SHA1 Message Date
Ilya Rezvov 23aef00097 Merge pull request #25 from RyanGlScott/ghc-9.8-9.10 
Bump dependencies ranges to allow building with GHC 9.8 and 9.10
 2024-06-04 07:22:59 -06:00
Ryan Scott 2f830c022e Allow building with GHC 9.8 and 9.10 
This bumps the upper version bounds on `base`, `bytestring`, `primitive`, and
`text` to allow newer versions of each library that build with GHC 9.8 and
9.10.
 2024-06-03 07:00:39 -04:00
10 changed files with 474 additions and 2350 deletions
Expand all files Collapse all files
src/Language/Wasm/Binary.hs
-17
View File
@@ -1,7 +1,6 @@
{-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TypeApplications #-}
module Language.Wasm.Binary ( module Language.Wasm.Binary (
dumpModule, dumpModule,
@@ -17,8 +16,6 @@ import Data.Bits
import Data.Word (Word8, Word32, Word64) import Data.Word (Word8, Word32, Word64)
import Data.Int (Int8, Int32, Int64) import Data.Int (Int8, Int32, Int64)
import Data.Serialize import Data.Serialize
import Control.Monad (when)
import Data.Primitive.ByteArray as BA
import qualified Data.ByteString as BS import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as LBS import qualified Data.ByteString.Lazy as LBS
import qualified Data.Text.Lazy as TL import qualified Data.Text.Lazy as TL
@@ -224,7 +221,6 @@ instance Serialize ValueType where
put I64 = putWord8 0x7E put I64 = putWord8 0x7E
put F32 = putWord8 0x7D put F32 = putWord8 0x7D
put F64 = putWord8 0x7C put F64 = putWord8 0x7C
put V128 = putWord8 0x7B
get = do get = do
op <- getWord8 op <- getWord8
@@ -233,7 +229,6 @@ instance Serialize ValueType where
0x7E -> return I64 0x7E -> return I64
0x7D -> return F32 0x7D -> return F32
0x7C -> return F64 0x7C -> return F64
0x7B -> return V128
_ -> fail "unexpected byte in value type position" _ -> fail "unexpected byte in value type position"
instance Serialize FuncType where instance Serialize FuncType where
@@ -341,7 +336,6 @@ instance Serialize MemArg where
put MemArg { align, offset } = putULEB128 align >> putULEB128 offset put MemArg { align, offset } = putULEB128 align >> putULEB128 offset
get = do get = do
align <- getULEB128 32 align <- getULEB128 32
when (align >= 32) $ fail "malformed memop flags"
offset <- getULEB128 32 offset <- getULEB128 32
return $ MemArg { align, offset } return $ MemArg { align, offset }
@@ -464,10 +458,6 @@ instance Serialize (Instruction Natural) where
put (I64Const val) = putWord8 0x42 >> putSLEB128 (asInt64 val) put (I64Const val) = putWord8 0x42 >> putSLEB128 (asInt64 val)
put (F32Const val) = putWord8 0x43 >> putFloat32le val put (F32Const val) = putWord8 0x43 >> putFloat32le val
put (F64Const val) = putWord8 0x44 >> putFloat64le 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 I32Eqz = putWord8 0x45
put (IRelOp BS32 IEq) = putWord8 0x46 put (IRelOp BS32 IEq) = putWord8 0x46
put (IRelOp BS32 INe) = putWord8 0x47 put (IRelOp BS32 INe) = putWord8 0x47
@@ -813,13 +803,6 @@ instance Serialize (Instruction Natural) where
0x06 -> return $ ITruncSatFS BS64 BS64 0x06 -> return $ ITruncSatFS BS64 BS64
0x07 -> return $ ITruncSatFU BS64 BS64 0x07 -> return $ ITruncSatFU BS64 BS64
_ -> fail "Unknown byte value after misc instruction byte" _ -> 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) byte -> fail $ "Unknown byte value in place of instruction opcode: " ++ (show byte)
putExpression :: Expression -> Put putExpression :: Expression -> Put
src/Language/Wasm/Interpreter.hs
+12 -932
View File
File diff suppressed because it is too large Load Diff
src/Language/Wasm/Lexer.x
+18 -20
View File
@@ -39,13 +39,13 @@ $alpha = [$lower $upper]
$namepunct = [\! \# \$ \% \& \' \* \+ \- \. \/ \: \< \= \> \? \@ \∖ \^ \_ \` \| \~] $namepunct = [\! \# \$ \% \& \' \* \+ \- \. \/ \: \< \= \> \? \@ \∖ \^ \_ \` \| \~]
$idchar = [$digit $alpha $namepunct] $idchar = [$digit $alpha $namepunct]
$space = [\ \x09 \x0A \x0D] $space = [\ \x09 \x0A \x0D]
$linechar = [^ \x09 \x0A \x0D] $linechar = [^ \x09]
$sign = [\+ \-] $sign = [\+ \-]
$doublequote = \" $doublequote = \"
@keyword = $lower $idchar* @keyword = $lower $idchar*
@reserved = $idchar+ @reserved = $idchar+
@linecomment = ";;" $linechar* [\x0A \x0D] @linecomment = ";;" $linechar* \x0A
@startblockcomment = "(;" @startblockcomment = "(;"
@endblockcomment = ";)" @endblockcomment = ";)"
@num = $digit (\_? $digit+)* @num = $digit (\_? $digit+)*
@@ -80,10 +80,10 @@ tokens :-
<0> @id { tokenStr TId } <0> @id { tokenStr TId }
<0> "(" { constToken TOpenBracket } <0> "(" { constToken TOpenBracket }
<0> ")" { constToken TCloseBracket } <0> ")" { constToken TCloseBracket }
<0> $sign? @hexfloat { parseHexFloat }
<0> $sign? @num { parseDecimalSignedInt } <0> $sign? @num { parseDecimalSignedInt }
<0> $sign? "0x" @hexnum { parseHexalSignedInt } <0> $sign? "0x" @hexnum { parseHexalSignedInt }
<0> $sign? @float { parseDecFloat } <0> $sign? @float { parseDecFloat }
<0> $sign? @hexfloat { parseHexFloat }
<0, blockComment> @startblockcomment { startBlockComment } <0, blockComment> @startblockcomment { startBlockComment }
<blockComment> [.\n] ; <blockComment> [.\n] ;
<blockComment> @endblockcomment { endBlockComment } <blockComment> @endblockcomment { endBlockComment }
@@ -119,22 +119,22 @@ minusNaN = negate nan
inf = infinity inf = infinity
minusInf = -infinity minusInf = -infinity
parseSign :: (Num a) => LBS.ByteString -> ((a -> a), Int64, Maybe Bool) parseSign :: (Num a) => LBS.ByteString -> ((a -> a), Int64)
parseSign str = parseSign str =
let Just (ch, _) = LBSUtf8.decode str in let Just (ch, _) = LBSUtf8.decode str in
case ch of case ch of
'-' -> (negate, 1, Just True) '-' -> (negate, 1)
'+' -> (abs, 1, Just False) '+' -> (abs, 1)
otherwise -> (abs, 0, Nothing) otherwise -> (abs, 0)
{-# SPECIALIZE parseSign :: LBS.ByteString -> ((Integer -> Integer), Int64, Maybe Bool) #-} {-# SPECIALIZE parseSign :: LBS.ByteString -> ((Integer -> Integer), Int64) #-}
{-# SPECIALIZE parseSign :: LBS.ByteString -> ((Double -> Double), Int64, Maybe Bool) #-} {-# SPECIALIZE parseSign :: LBS.ByteString -> ((Double -> Double), Int64) #-}
parseHexalSignedInt :: AlexAction Lexeme parseHexalSignedInt :: AlexAction Lexeme
parseHexalSignedInt = token $ \(pos, _, s, _) len -> 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 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 :: AlexAction Lexeme
parseNanSigned = token $ \(pos, _, s, _) len -> parseNanSigned = token $ \(pos, _, s, _) len ->
@@ -148,9 +148,9 @@ parseNanSigned = token $ \(pos, _, s, _) len ->
parseDecimalSignedInt :: AlexAction Lexeme parseDecimalSignedInt :: AlexAction Lexeme
parseDecimalSignedInt = token $ \(pos, _, s, _) len -> 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 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 :: AlexAction Lexeme
parseDecFloat = token $ \(pos, _, s, _) len -> parseDecFloat = token $ \(pos, _, s, _) len ->
@@ -226,13 +226,11 @@ readHexFloat toFloat sz expLimit manitisaSize str = do
then ([True], 0, exp' + 1) then ([True], 0, exp' + 1)
else (rounded, 1, exp') else (rounded, 1, exp')
else (rounded, 0, exp') else (rounded, 0, exp')
e <- if exp'' > expLimit then Left "const out of range" if exp'' > expLimit || exp'' < (negate $ expLimit + manitisaSize) then Left "constant out of range" else return ()
else if exp'' < (negate $ expLimit + manitisaSize) then return $ negate $ expLimit + manitisaSize + 1 if exp'' >= (negate $ expLimit - 1)
else return exp'' then return $ toFloat $ sign .|. ((fromIntegral $ exp'' + expLimit) `shiftL` manitisaSize) .|. ((fromBits (tail bits') + a) `shiftL` (manitisaSize + 1 - length bits'))
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 else do
let shift = expLimit + manitisaSize - length bits' - abs e let shift = expLimit + manitisaSize - length bits' - abs exp''
if shift < 0 if shift < 0
then return $ toFloat sign then return $ toFloat sign
else return $ toFloat $ sign .|. ((fromBits bits' + a) `shiftL` shift) else return $ toFloat $ sign .|. ((fromBits bits' + a) `shiftL` shift)
@@ -366,7 +364,7 @@ data NaN
deriving (Show, Eq) deriving (Show, Eq)
data Token = TKeyword LBS.ByteString data Token = TKeyword LBS.ByteString
| TIntLit {- Natural -} (Maybe Bool) Integer | TIntLit Integer
| TFloatLit FloatRep | TFloatLit FloatRep
| TStringLit LBS.ByteString | TStringLit LBS.ByteString
| TId LBS.ByteString | TId LBS.ByteString
src/Language/Wasm/Parser.y
+18 -720
View File
@@ -38,8 +38,7 @@ module Language.Wasm.Parser (
Command(..), Command(..),
Action(..), Action(..),
Assertion(..), Assertion(..),
Meta(..), Meta(..)
ValuePattern(..)
) where ) where
import Language.Wasm.Structure ( import Language.Wasm.Structure (
@@ -55,8 +54,7 @@ import Language.Wasm.Structure (
ElemType(..), ElemType(..),
Limit(..), Limit(..),
GlobalType(..), GlobalType(..),
ValueType(..), ValueType(..)
SimdShape(..)
) )
import qualified Language.Wasm.Structure as S import qualified Language.Wasm.Structure as S
@@ -66,7 +64,6 @@ import qualified Data.Text.Lazy as TL
import qualified Data.Text.Lazy.Encoding as TLEncoding import qualified Data.Text.Lazy.Encoding as TLEncoding
import qualified Data.Text.Lazy.Read as TLRead 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 as LBS
import qualified Data.ByteString.Lazy.Char8 as LBSChar8 import qualified Data.ByteString.Lazy.Char8 as LBSChar8
import Data.Maybe (fromMaybe, fromJust, isNothing, catMaybes) import Data.Maybe (fromMaybe, fromJust, isNothing, catMaybes)
@@ -75,10 +72,10 @@ import Control.Monad (guard, foldM)
import Control.Monad.Except (throwError) import Control.Monad.Except (throwError)
import Numeric.Natural (Natural) import Numeric.Natural (Natural)
import Data.Word (Word8, Word16, Word32, Word64) import Data.Word (Word32, Word64)
import Data.Bits ((.|.)) import Data.Bits ((.|.))
import Numeric.IEEE (infinity, nan, maxFinite) import Numeric.IEEE (infinity, nan, maxFinite)
import Language.Wasm.FloatUtils (doubleToFloat, floatToWord, doubleToWord) import Language.Wasm.FloatUtils (doubleToFloat)
import Control.DeepSeq (NFData) import Control.DeepSeq (NFData)
import GHC.Generics (Generic) import GHC.Generics (Generic)
@@ -122,7 +119,6 @@ import Language.Wasm.Lexer (
'i64' { Lexeme _ (TKeyword "i64") } 'i64' { Lexeme _ (TKeyword "i64") }
'f32' { Lexeme _ (TKeyword "f32") } 'f32' { Lexeme _ (TKeyword "f32") }
'f64' { Lexeme _ (TKeyword "f64") } 'f64' { Lexeme _ (TKeyword "f64") }
'v128' { Lexeme _ (TKeyword "v128") }
'mut' { Lexeme _ (TKeyword "mut") } 'mut' { Lexeme _ (TKeyword "mut") }
'funcref' { Lexeme _ (TKeyword "funcref") } 'funcref' { Lexeme _ (TKeyword "funcref") }
'externref' { Lexeme _ (TKeyword "externref") } 'externref' { Lexeme _ (TKeyword "externref") }
@@ -151,23 +147,6 @@ import Language.Wasm.Lexer (
'i64.load' { Lexeme _ (TKeyword "i64.load") } 'i64.load' { Lexeme _ (TKeyword "i64.load") }
'f32.load' { Lexeme _ (TKeyword "f32.load") } 'f32.load' { Lexeme _ (TKeyword "f32.load") }
'f64.load' { Lexeme _ (TKeyword "f64.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_s' { Lexeme _ (TKeyword "i32.load8_s") }
'i32.load8_u' { Lexeme _ (TKeyword "i32.load8_u") } 'i32.load8_u' { Lexeme _ (TKeyword "i32.load8_u") }
'i32.load16_s' { Lexeme _ (TKeyword "i32.load16_s") } 'i32.load16_s' { Lexeme _ (TKeyword "i32.load16_s") }
@@ -182,11 +161,6 @@ import Language.Wasm.Lexer (
'i64.store' { Lexeme _ (TKeyword "i64.store") } 'i64.store' { Lexeme _ (TKeyword "i64.store") }
'f32.store' { Lexeme _ (TKeyword "f32.store") } 'f32.store' { Lexeme _ (TKeyword "f32.store") }
'f64.store' { Lexeme _ (TKeyword "f64.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.store8' { Lexeme _ (TKeyword "i32.store8") }
'i32.store16' { Lexeme _ (TKeyword "i32.store16") } 'i32.store16' { Lexeme _ (TKeyword "i32.store16") }
'i64.store8' { Lexeme _ (TKeyword "i64.store8") } 'i64.store8' { Lexeme _ (TKeyword "i64.store8") }
@@ -210,7 +184,6 @@ import Language.Wasm.Lexer (
'i64.const' { Lexeme _ (TKeyword "i64.const") } 'i64.const' { Lexeme _ (TKeyword "i64.const") }
'f32.const' { Lexeme _ (TKeyword "f32.const") } 'f32.const' { Lexeme _ (TKeyword "f32.const") }
'f64.const' { Lexeme _ (TKeyword "f64.const") } 'f64.const' { Lexeme _ (TKeyword "f64.const") }
'v128.const' { Lexeme _ (TKeyword "v128.const") }
'i32.clz' { Lexeme _ (TKeyword "i32.clz") } 'i32.clz' { Lexeme _ (TKeyword "i32.clz") }
'i32.ctz' { Lexeme _ (TKeyword "i32.ctz") } 'i32.ctz' { Lexeme _ (TKeyword "i32.ctz") }
'i32.popcnt' { Lexeme _ (TKeyword "i32.popcnt") } 'i32.popcnt' { Lexeme _ (TKeyword "i32.popcnt") }
@@ -337,16 +310,6 @@ import Language.Wasm.Lexer (
'f32.convert_i32_u' { Lexeme _ (TKeyword "f32.convert_i32_u") } 'f32.convert_i32_u' { Lexeme _ (TKeyword "f32.convert_i32_u") }
'f32.convert_i64_s' { Lexeme _ (TKeyword "f32.convert_i64_s") } 'f32.convert_i64_s' { Lexeme _ (TKeyword "f32.convert_i64_s") }
'f32.convert_i64_u' { Lexeme _ (TKeyword "f32.convert_i64_u") } '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") } 'f32.demote_f64' { Lexeme _ (TKeyword "f32.demote_f64") }
'f64.convert_i32_s' { Lexeme _ (TKeyword "f64.convert_i32_s") } 'f64.convert_i32_s' { Lexeme _ (TKeyword "f64.convert_i32_s") }
'f64.convert_i32_u' { Lexeme _ (TKeyword "f64.convert_i32_u") } 'f64.convert_i32_u' { Lexeme _ (TKeyword "f64.convert_i32_u") }
@@ -357,12 +320,6 @@ import Language.Wasm.Lexer (
'i64.reinterpret_f64' { Lexeme _ (TKeyword "i64.reinterpret_f64") } 'i64.reinterpret_f64' { Lexeme _ (TKeyword "i64.reinterpret_f64") }
'f32.reinterpret_i32' { Lexeme _ (TKeyword "f32.reinterpret_i32") } 'f32.reinterpret_i32' { Lexeme _ (TKeyword "f32.reinterpret_i32") }
'f64.reinterpret_i64' { Lexeme _ (TKeyword "f64.reinterpret_i64") } '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") } 'block' { Lexeme _ (TKeyword "block") }
'loop' { Lexeme _ (TKeyword "loop") } 'loop' { Lexeme _ (TKeyword "loop") }
'if' { Lexeme _ (TKeyword "if") } 'if' { Lexeme _ (TKeyword "if") }
@@ -382,214 +339,6 @@ import Language.Wasm.Lexer (
'offset' { Lexeme _ (TKeyword "offset") } 'offset' { Lexeme _ (TKeyword "offset") }
'start' { Lexeme _ (TKeyword "start") } 'start' { Lexeme _ (TKeyword "start") }
'module' { Lexeme _ (TKeyword "module") } '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 -- script extension
'binary' { Lexeme _ (TKeyword "binary") } 'binary' { Lexeme _ (TKeyword "binary") }
'quote' { Lexeme _ (TKeyword "quote") } 'quote' { Lexeme _ (TKeyword "quote") }
@@ -609,9 +358,7 @@ import Language.Wasm.Lexer (
'output' { Lexeme _ (TKeyword "output") } 'output' { Lexeme _ (TKeyword "output") }
-- script extension end -- script extension end
id { Lexeme _ (TId $$) } id { Lexeme _ (TId $$) }
signed_pos { Lexeme _ (TIntLit (Just False) $$) } int { Lexeme _ (TIntLit $$) }
signed_neg { Lexeme _ (TIntLit (Just True) $$) }
nat { Lexeme _ (TIntLit Nothing $$) }
f64 { Lexeme _ (TFloatLit $$) } f64 { Lexeme _ (TFloatLit $$) }
offset { Lexeme _ (TKeyword (asOffset -> Just $$)) } offset { Lexeme _ (TKeyword (asOffset -> Just $$)) }
align { Lexeme _ (TKeyword (asAlign -> Just $$)) } align { Lexeme _ (TKeyword (asAlign -> Just $$)) }
@@ -638,33 +385,13 @@ valtype :: { ValueType }
| 'i64' { I64 } | 'i64' { I64 }
| 'f32' { F32 } | 'f32' { F32 }
| 'f64' { F64 } | 'f64' { F64 }
| 'v128' { V128 }
| 'funcref' { Func } | 'funcref' { Func }
| 'externref' { Extern } | 'externref' { Extern }
int :: {Integer}
: signed_neg { $1 }
| signed_pos { $1 }
| nat { $1 }
index :: { Index } index :: { Index }
: u32 { Index $1 } : u32 { Index $1 }
| ident { Named $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 } int32 :: { Integer }
: int {% : int {%
if $1 >= -(2^31) && $1 < 2^32 if $1 >= -(2^31) && $1 < 2^32
@@ -687,20 +414,7 @@ int64 :: { Integer }
} }
float32 :: { FloatRep } float32 :: { FloatRep }
: signed_neg {% : int {%
-- 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 let maxInt = 340282356779733623858607532500980858880 in
if $1 <= maxInt && $1 >= -maxInt if $1 <= maxInt && $1 >= -maxInt
then return $ BinRep $ fromIntegral $1 then return $ BinRep $ fromIntegral $1
@@ -709,20 +423,7 @@ float32 :: { FloatRep }
| f64 { $1 } | f64 { $1 }
float64 :: { FloatRep } float64 :: { FloatRep }
: signed_neg {% : int {%
-- 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 let maxInt = round (maxFinite :: Double) in
if $1 <= maxInt && $1 >= -maxInt if $1 <= maxInt && $1 >= -maxInt
then fmap BinRep $ doubleFromInteger $1 then fmap BinRep $ doubleFromInteger $1
@@ -730,37 +431,6 @@ float64 :: { FloatRep }
} }
| f64 { $1 } | 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 } plaininstr :: { PlainInstr }
-- control instructions -- control instructions
: 'unreachable' { Unreachable } : 'unreachable' { Unreachable }
@@ -787,23 +457,6 @@ plaininstr :: { PlainInstr }
| 'i64.load' memarg8 { I64Load $2 } | 'i64.load' memarg8 { I64Load $2 }
| 'f32.load' memarg4 { F32Load $2 } | 'f32.load' memarg4 { F32Load $2 }
| 'f64.load' memarg8 { F64Load $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_s' memarg1 { I32Load8S $2 }
| 'i32.load8_u' memarg1 { I32Load8U $2 } | 'i32.load8_u' memarg1 { I32Load8U $2 }
| 'i32.load16_s' memarg2 { I32Load16S $2 } | 'i32.load16_s' memarg2 { I32Load16S $2 }
@@ -818,11 +471,6 @@ plaininstr :: { PlainInstr }
| 'i64.store' memarg8 { I64Store $2 } | 'i64.store' memarg8 { I64Store $2 }
| 'f32.store' memarg4 { F32Store $2 } | 'f32.store' memarg4 { F32Store $2 }
| 'f64.store' memarg8 { F64Store $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.store8' memarg1 { I32Store8 $2 }
| 'i32.store16' memarg2 { I32Store16 $2 } | 'i32.store16' memarg2 { I32Store16 $2 }
| 'i64.store8' memarg1 { I64Store8 $2 } | 'i64.store8' memarg1 { I64Store8 $2 }
@@ -852,7 +500,6 @@ plaininstr :: { PlainInstr }
| 'i64.const' int64 { I64Const $2 } | 'i64.const' int64 { I64Const $2 }
| 'f32.const' float32 { F32Const $2 } | 'f32.const' float32 { F32Const $2 }
| 'f64.const' float64 { F64Const $2 } | 'f64.const' float64 { F64Const $2 }
| 'v128.const' v128_const { V128Const $2 }
| 'i32.clz' { IUnOp BS32 IClz } | 'i32.clz' { IUnOp BS32 IClz }
| 'i32.ctz' { IUnOp BS32 ICtz } | 'i32.ctz' { IUnOp BS32 ICtz }
| 'i32.popcnt' { IUnOp BS32 IPopcnt } | 'i32.popcnt' { IUnOp BS32 IPopcnt }
@@ -979,16 +626,6 @@ plaininstr :: { PlainInstr }
| 'f32.convert_i32_u' { FConvertIU BS32 BS32 } | 'f32.convert_i32_u' { FConvertIU BS32 BS32 }
| 'f32.convert_i64_s' { FConvertIS BS32 BS64 } | 'f32.convert_i64_s' { FConvertIS BS32 BS64 }
| 'f32.convert_i64_u' { FConvertIU 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 } | 'f32.demote_f64' { F32DemoteF64 }
| 'f64.convert_i32_s' { FConvertIS BS64 BS32 } | 'f64.convert_i32_s' { FConvertIS BS64 BS32 }
| 'f64.convert_i32_u' { FConvertIU BS64 BS32 } | 'f64.convert_i32_u' { FConvertIU BS64 BS32 }
@@ -999,219 +636,6 @@ plaininstr :: { PlainInstr }
| 'i64.reinterpret_f64' { IReinterpretF BS64 } | 'i64.reinterpret_f64' { IReinterpretF BS64 }
| 'f32.reinterpret_i32' { FReinterpretI BS32 } | 'f32.reinterpret_i32' { FReinterpretI BS32 }
| 'f64.reinterpret_i64' { FReinterpretI BS64 } | '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) typeuse(next)
: '(' typeuse1(folded_instr_list(next), instruction_list(next)) { : '(' typeuse1(folded_instr_list(next), instruction_list(next)) {
@@ -1278,9 +702,6 @@ memarg4 :: { MemArg }
memarg8 :: { MemArg } memarg8 :: { MemArg }
: opt(offset) opt(align) {% parseMemArg 8 $1 $2 } : opt(offset) opt(align) {% parseMemArg 8 $1 $2 }
memarg16 :: { MemArg }
: opt(offset) opt(align) {% parseMemArg 16 $1 $2 }
select_type_or_instructions(terminator) select_type_or_instructions(terminator)
: '(' select_type_or_instructions1(terminator) { $2 } : '(' select_type_or_instructions1(terminator) { $2 }
| instruction_list(terminator) { | instruction_list(terminator) {
@@ -1664,13 +1085,13 @@ module1 :: { ModuleDef }
action1 :: { Action } action1 :: { Action }
: 'invoke' opt(ident) string list(folded_instr) ')' {% : 'invoke' opt(ident) string list(folded_instr) ')' {%
fmap (Invoke $2 $3) $ (mapM (constInstructionToValue . head) $4) fmap (Invoke $2 $3) $ (mapM (mapM constInstructionToValue) $4)
} }
| 'get' opt(ident) string ')' { Get $2 $3 } | 'get' opt(ident) string ')' { Get $2 $3 }
assertion1 :: { (Maybe AlexPosn, Assertion) } assertion1 :: { (Maybe AlexPosn, Assertion) }
: 'assert_return' '(' action1 list(folded_instr) ')' {% : 'assert_return' '(' action1 list(folded_instr) ')' {%
fmap ((\a -> ($1, a)) . AssertReturn $3) $ (mapM (constInstructionToValue . head) $4) fmap ((\a -> ($1, a)) . AssertReturn $3) $ (mapM (mapM constInstructionToValue) $4)
} }
| 'assert_return_canonical_nan' '(' action1 ')' { ($1, AssertReturnCanonicalNaN $3) } | 'assert_return_canonical_nan' '(' action1 ')' { ($1, AssertReturnCanonicalNaN $3) }
| 'assert_return_arithmetic_nan' '(' action1 ')' { ($1, AssertReturnArithmeticNaN $3) } | 'assert_return_arithmetic_nan' '(' action1 ')' { ($1, AssertReturnArithmeticNaN $3) }
@@ -1811,15 +1232,6 @@ type MemoryIndex = Index
type ElemIndex = Index type ElemIndex = Index
type DataIndex = Index type DataIndex = Index
data V128Rep =
I8x16Const [Integer]
| I16x8Const [Integer]
| I32x4Const [Integer]
| I64x2Const [Integer]
| F32x4Const [FloatRep]
| F64x2Const [FloatRep]
deriving (Show, Eq)
data PlainInstr = data PlainInstr =
-- Control instructions -- Control instructions
Unreachable Unreachable
@@ -1849,23 +1261,6 @@ data PlainInstr =
| I64Load MemArg | I64Load MemArg
| F32Load MemArg | F32Load MemArg
| F64Load 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 | I32Load8S MemArg
| I32Load8U MemArg | I32Load8U MemArg
| I32Load16S MemArg | I32Load16S MemArg
@@ -1880,11 +1275,6 @@ data PlainInstr =
| I64Store MemArg | I64Store MemArg
| F32Store MemArg | F32Store MemArg
| F64Store MemArg | F64Store MemArg
| V128Store MemArg
| V128Store8Lane MemArg Natural
| V128Store16Lane MemArg Natural
| V128Store32Lane MemArg Natural
| V128Store64Lane MemArg Natural
| I32Store8 MemArg | I32Store8 MemArg
| I32Store16 MemArg | I32Store16 MemArg
| I64Store8 MemArg | I64Store8 MemArg
@@ -1910,7 +1300,6 @@ data PlainInstr =
| I64Const Integer | I64Const Integer
| F32Const FloatRep | F32Const FloatRep
| F64Const FloatRep | F64Const FloatRep
| V128Const V128Rep
| IUnOp BitSize IUnOp | IUnOp BitSize IUnOp
| IBinOp BitSize IBinOp | IBinOp BitSize IBinOp
| I32Eqz | I32Eqz
@@ -1932,23 +1321,6 @@ data PlainInstr =
| F64PromoteF32 | F64PromoteF32
| IReinterpretF BitSize | IReinterpretF BitSize
| FReinterpretI 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) deriving (Show, Eq)
data TypeDef = TypeDef (Maybe Ident) FuncType deriving (Show, Eq) data TypeDef = TypeDef (Maybe Ident) FuncType deriving (Show, Eq)
@@ -2122,22 +1494,15 @@ data Command
| Meta Meta | Meta Meta
deriving (Show, Eq) deriving (Show, Eq)
data ValuePattern =
ExactValue (S.Instruction Natural)
| CanonicalNan
| ArithmeticNan
| VectorPat SimdShape [ValuePattern]
deriving (Show, Eq)
data Action data Action
= Invoke (Maybe Ident) TL.Text [ValuePattern] = Invoke (Maybe Ident) TL.Text [S.Expression]
| Get (Maybe Ident) TL.Text | Get (Maybe Ident) TL.Text
deriving (Show, Eq) deriving (Show, Eq)
type FailureString = TL.Text type FailureString = TL.Text
data Assertion data Assertion
= AssertReturn Action [ValuePattern] = AssertReturn Action [S.Expression]
| AssertReturnCanonicalNaN Action | AssertReturnCanonicalNaN Action
| AssertReturnArithmeticNaN Action | AssertReturnArithmeticNaN Action
| AssertTrap (Either Action ModuleDef) FailureString | AssertTrap (Either Action ModuleDef) FailureString
@@ -2162,41 +1527,13 @@ data FunCtx = FunCtx {
ctxParams :: [ParamType] ctxParams :: [ParamType]
} deriving (Eq, Show) } deriving (Eq, Show)
v128RepToBytes :: V128Rep -> Either String ByteArray.ByteArray constInstructionToValue :: Instruction -> Either String (S.Instruction Natural)
v128RepToBytes (I8x16Const bytes) = constInstructionToValue (PlainInstr (I32Const v)) = return $ S.I32Const $ integerToWord32 v
return $ ByteArray.byteArrayFromListN 16 $ (fromIntegral :: Integer -> Word8) <$> bytes constInstructionToValue (PlainInstr (F32Const v)) = S.F32Const <$> asFloat v
v128RepToBytes (I16x8Const words) = constInstructionToValue (PlainInstr (I64Const v)) = return $ S.I64Const $ integerToWord64 v
return $ ByteArray.byteArrayFromListN 8 $ (fromIntegral :: Integer -> Word16) <$> words constInstructionToValue (PlainInstr (F64Const v)) = S.F64Const <$> asDouble v
v128RepToBytes (I32x4Const dwords) = constInstructionToValue (PlainInstr (RefNull et)) = return $ S.RefNull et
return $ ByteArray.byteArrayFromListN 4 $ integerToWord32 <$> dwords constInstructionToValue (PlainInstr (RefExtern n)) = return $ S.RefExtern n
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" constInstructionToValue _ = Left "Only const instructions supported as arguments for actions"
funcIndexToExpr :: [FuncIndex] -> [[Instruction]] funcIndexToExpr :: [FuncIndex] -> [[Instruction]]
@@ -2417,23 +1754,6 @@ desugarize fields = do
synInstrToStruct _ (PlainInstr (I64Load memArg)) = return $ S.I64Load memArg synInstrToStruct _ (PlainInstr (I64Load memArg)) = return $ S.I64Load memArg
synInstrToStruct _ (PlainInstr (F32Load memArg)) = return $ S.F32Load memArg synInstrToStruct _ (PlainInstr (F32Load memArg)) = return $ S.F32Load memArg
synInstrToStruct _ (PlainInstr (F64Load memArg)) = return $ S.F64Load 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 (I32Load8S memArg)) = return $ S.I32Load8S memArg
synInstrToStruct _ (PlainInstr (I32Load8U memArg)) = return $ S.I32Load8U memArg synInstrToStruct _ (PlainInstr (I32Load8U memArg)) = return $ S.I32Load8U memArg
synInstrToStruct _ (PlainInstr (I32Load16S memArg)) = return $ S.I32Load16S memArg synInstrToStruct _ (PlainInstr (I32Load16S memArg)) = return $ S.I32Load16S memArg
@@ -2448,11 +1768,6 @@ desugarize fields = do
synInstrToStruct _ (PlainInstr (I64Store memArg)) = return $ S.I64Store memArg synInstrToStruct _ (PlainInstr (I64Store memArg)) = return $ S.I64Store memArg
synInstrToStruct _ (PlainInstr (F32Store memArg)) = return $ S.F32Store memArg synInstrToStruct _ (PlainInstr (F32Store memArg)) = return $ S.F32Store memArg
synInstrToStruct _ (PlainInstr (F64Store memArg)) = return $ S.F64Store 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 (I32Store8 memArg)) = return $ S.I32Store8 memArg
synInstrToStruct _ (PlainInstr (I32Store16 memArg)) = return $ S.I32Store16 memArg synInstrToStruct _ (PlainInstr (I32Store16 memArg)) = return $ S.I32Store16 memArg
synInstrToStruct _ (PlainInstr (I64Store8 memArg)) = return $ S.I64Store8 memArg synInstrToStruct _ (PlainInstr (I64Store8 memArg)) = return $ S.I64Store8 memArg
@@ -2520,7 +1835,6 @@ desugarize fields = do
synInstrToStruct _ (PlainInstr (F64Const (NanRep Canonical))) = synInstrToStruct _ (PlainInstr (F64Const (NanRep Canonical))) =
Left "canonical nan constant allowed only in script" Left "canonical nan constant allowed only in script"
synInstrToStruct _ (PlainInstr (F64Const rep)) = S.F64Const <$> asDouble rep 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 (IUnOp sz op)) = return $ S.IUnOp sz op
synInstrToStruct _ (PlainInstr (IBinOp sz op)) = return $ S.IBinOp sz op synInstrToStruct _ (PlainInstr (IBinOp sz op)) = return $ S.IBinOp sz op
synInstrToStruct _ (PlainInstr I32Eqz) = return $ S.I32Eqz synInstrToStruct _ (PlainInstr I32Eqz) = return $ S.I32Eqz
@@ -2542,22 +1856,6 @@ desugarize fields = do
synInstrToStruct _ (PlainInstr F64PromoteF32) = return $ S.F64PromoteF32 synInstrToStruct _ (PlainInstr F64PromoteF32) = return $ S.F64PromoteF32
synInstrToStruct _ (PlainInstr (IReinterpretF sz)) = return $ S.IReinterpretF sz synInstrToStruct _ (PlainInstr (IReinterpretF sz)) = return $ S.IReinterpretF sz
synInstrToStruct _ (PlainInstr (FReinterpretI sz)) = return $ S.FReinterpretI 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 synInstrToStruct ctx@FunCtx { ctxMod = Module { types } } BlockInstr {label, blockType, body} = do
let ctx' = ctx { ctxLabels = label : ctxLabels ctx } let ctx' = ctx { ctxLabels = label : ctxLabels ctx }
bt <- case blockType of bt <- case blockType of
src/Language/Wasm/Script.hs
+15 -46
View File
@@ -11,7 +11,6 @@ import qualified Data.Text.Lazy.Encoding as TLEncoding
import qualified Control.Monad.State as State import qualified Control.Monad.State as State
import Control.Monad.IO.Class (liftIO) import Control.Monad.IO.Class (liftIO)
import Numeric.IEEE (identicalIEEE) import Numeric.IEEE (identicalIEEE)
import qualified Data.Primitive.ByteArray as ByteArray
import qualified Control.DeepSeq as DeepSeq import qualified Control.DeepSeq as DeepSeq
import Data.Maybe (fromJust, isNothing) import Data.Maybe (fromJust, isNothing)
import Debug.Trace (trace) 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.Parser as Parser
import qualified Language.Wasm.Lexer as Lexer import qualified Language.Wasm.Lexer as Lexer
import qualified Language.Wasm.Binary as Binary 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 () type OnAssertFail = String -> Assertion -> IO ()
@@ -78,8 +74,8 @@ runScript onAssertFail script = do
hostGlobals = do hostGlobals = do
let globI32 = Interpreter.makeConstGlobal $ Interpreter.VI32 666 let globI32 = Interpreter.makeConstGlobal $ Interpreter.VI32 666
let globI64 = Interpreter.makeConstGlobal $ Interpreter.VI64 666 let globI64 = Interpreter.makeConstGlobal $ Interpreter.VI64 666
let globF32 = Interpreter.makeConstGlobal $ Interpreter.VF32 666.6 let globF32 = Interpreter.makeConstGlobal $ Interpreter.VF32 666
let globF64 = Interpreter.makeConstGlobal $ Interpreter.VF64 666.6 let globF64 = Interpreter.makeConstGlobal $ Interpreter.VF64 666
return ( return (
Interpreter.HostGlobal globI32, Interpreter.HostGlobal globI32,
Interpreter.HostGlobal globI64, Interpreter.HostGlobal globI64,
@@ -123,23 +119,16 @@ runScript onAssertFail script = do
getModule st (Just (Ident i)) = Map.lookup i (modules st) getModule st (Just (Ident i)) = Map.lookup i (modules st)
getModule st Nothing = lastModule st getModule st Nothing = lastModule st
asArg :: Parser.ValuePattern -> Interpreter.Value asArg :: Struct.Expression -> Interpreter.Value
asArg (Parser.ExactValue (Struct.I32Const v)) = Interpreter.VI32 v asArg [Struct.I32Const v] = Interpreter.VI32 v
asArg (Parser.ExactValue (Struct.F32Const v)) = Interpreter.VF32 v asArg [Struct.F32Const v] = Interpreter.VF32 v
asArg (Parser.ExactValue (Struct.I64Const v)) = Interpreter.VI64 v asArg [Struct.I64Const v] = Interpreter.VI64 v
asArg (Parser.ExactValue (Struct.F64Const v)) = Interpreter.VF64 v asArg [Struct.F64Const v] = Interpreter.VF64 v
asArg (Parser.ExactValue (Struct.V128Const v)) = Interpreter.VV128 v asArg [Struct.RefNull Struct.FuncRef] = Interpreter.RF Nothing
asArg (Parser.ExactValue (Struct.RefNull Struct.FuncRef)) = Interpreter.RF Nothing asArg [Struct.RefNull Struct.ExternRef] = Interpreter.RE Nothing
asArg (Parser.ExactValue (Struct.RefNull Struct.ExternRef))= Interpreter.RE Nothing asArg [Struct.RefExtern v] = Interpreter.RE (Just v)
asArg (Parser.ExactValue (Struct.RefExtern v)) = Interpreter.RE (Just v)
asArg expr = error $ "Only const instructions supported as arguments for actions: " ++ show expr 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 :: ScriptState -> Action -> IO (Maybe [Interpreter.Value])
runAction st (Invoke ident name args) = do runAction st (Invoke ident name args) = do
case getModule st ident of case getModule st ident of
@@ -153,31 +142,12 @@ runScript onAssertFail script = do
isValueEqual :: Interpreter.Value -> Interpreter.Value -> Bool isValueEqual :: Interpreter.Value -> Interpreter.Value -> Bool
isValueEqual (Interpreter.VI32 v1) (Interpreter.VI32 v2) = v1 == v2 isValueEqual (Interpreter.VI32 v1) (Interpreter.VI32 v2) = v1 == v2
isValueEqual (Interpreter.VI64 v1) (Interpreter.VI64 v2) = v1 == v2 isValueEqual (Interpreter.VI64 v1) (Interpreter.VI64 v2) = v1 == v2
isValueEqual (Interpreter.VF32 v1) (Interpreter.VF32 v2) = identicalIEEE v1 v2 isValueEqual (Interpreter.VF32 v1) (Interpreter.VF32 v2) = (isNaN v1 && isNaN v2) || identicalIEEE v1 v2
isValueEqual (Interpreter.VF64 v1) (Interpreter.VF64 v2) = identicalIEEE v1 v2 isValueEqual (Interpreter.VF64 v1) (Interpreter.VF64 v2) = (isNaN v1 && isNaN 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.RF f1) (Interpreter.RF f2) = f1 == f2
isValueEqual (Interpreter.RE e1) (Interpreter.RE e2) = e1 == e2 isValueEqual (Interpreter.RE e1) (Interpreter.RE e2) = e1 == e2
isValueEqual _ _ = False 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 -> Assertion -> AssertM ()
isNaNReturned action assert = do isNaNReturned action assert = do
result <- runActionInAssert action 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.FunctionIndexOutOfRange idx) = ["unknown function", "unknown function " <> TL.pack (show idx)]
getFailureString (Validate.GlobalIndexOutOfRange idx) = ["unknown global", "unknown global " <> TL.pack (show idx)] getFailureString (Validate.GlobalIndexOutOfRange idx) = ["unknown global", "unknown global " <> TL.pack (show idx)]
getFailureString Validate.LabelIndexOutOfRange = ["unknown label"] getFailureString Validate.LabelIndexOutOfRange = ["unknown label"]
getFailureString Validate.LaneIndexOutOfRange = ["invalid lane index"]
getFailureString Validate.TypeIndexOutOfRange = ["unknown type"] getFailureString Validate.TypeIndexOutOfRange = ["unknown type"]
getFailureString Validate.MinMoreThanMaxInMemoryLimit = ["size minimum must not be greater than maximum"] getFailureString Validate.MinMoreThanMaxInMemoryLimit = ["size minimum must not be greater than maximum"]
getFailureString Validate.MemoryLimitExceeded = ["memory size must be at most 65536 pages (4GiB)"] getFailureString Validate.MemoryLimitExceeded = ["memory size must be at most 65536 pages (4GiB)"]
@@ -247,10 +216,10 @@ runScript onAssertFail script = do
result <- runActionInAssert action result <- runActionInAssert action
case result of case result of
Just result -> do 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 () then return ()
else printFailedAssert ("Expected " ++ show (map showArg expected) ++ ", but action returned " ++ show result) assert else printFailedAssert ("Expected " ++ show (map asArg expected) ++ ", but action returned " ++ show result) assert
Nothing -> printFailedAssert ("Expected " ++ show (map showArg expected) ++ ", but action returned Trap") assert Nothing -> printFailedAssert ("Expected " ++ show (map asArg expected) ++ ", but action returned Trap") assert
runAssert assert@(AssertReturnCanonicalNaN action) = isNaNReturned action assert runAssert assert@(AssertReturnCanonicalNaN action) = isNaNReturned action assert
runAssert assert@(AssertReturnArithmeticNaN action) = isNaNReturned action assert runAssert assert@(AssertReturnArithmeticNaN action) = isNaNReturned action assert
runAssert assert@(AssertInvalid moduleDef failureString) = runAssert assert@(AssertInvalid moduleDef failureString) =
src/Language/Wasm/Structure.hs
+2 -62
View File
@@ -33,7 +33,6 @@ module Language.Wasm.Structure (
FuncType(..), FuncType(..),
ValueType(..), ValueType(..),
BlockType(..), BlockType(..),
SimdShape(..),
ParamsType, ParamsType,
ResultType, ResultType,
LocalsType, LocalsType,
@@ -54,15 +53,12 @@ module Language.Wasm.Structure (
import Numeric.Natural (Natural) import Numeric.Natural (Natural)
import Data.Word (Word32, Word64) import Data.Word (Word32, Word64)
import qualified Data.Primitive.ByteArray as ByteArray
import qualified Data.ByteString.Lazy as LBS import qualified Data.ByteString.Lazy as LBS
import qualified Data.Text.Lazy as TL import qualified Data.Text.Lazy as TL
import Control.DeepSeq (NFData) import Control.DeepSeq (NFData)
import GHC.Generics (Generic) import GHC.Generics (Generic)
data SimdShape = I8x16 | I16x8 | I32x4 | I64x2 | F32x4 | F64x2 | I128x1 deriving (Show, Eq, Generic, NFData) data BitSize = BS32 | BS64 deriving (Show, Eq, Generic, NFData)
data BitSize = BS32 | BS64 | BS128 SimdShape deriving (Show, Eq, Generic, NFData)
data IUnOp = data IUnOp =
IClz IClz
@@ -71,27 +67,17 @@ data IUnOp =
| IExtend8S | IExtend8S
| IExtend16S | IExtend16S
| IExtend32S | IExtend32S
| INot
| IAbs
| INeg
| IExtAddPairwise {- Signed -} Bool
deriving (Show, Eq, Generic, NFData) deriving (Show, Eq, Generic, NFData)
data IBinOp = data IBinOp =
IAdd IAdd
| ISub | ISub
| IAddSatS
| ISubSatS
| IAddSatU
| ISubSatU
| IAvgrU
| IMul | IMul
| IDivU | IDivU
| IDivS | IDivS
| IRemU | IRemU
| IRemS | IRemS
| IAnd | IAnd
| IAndNot
| IOr | IOr
| IXor | IXor
| IShl | IShl
@@ -99,18 +85,13 @@ data IBinOp =
| IShrS | IShrS
| IRotl | IRotl
| IRotr | IRotr
| IMinU
| IMinS
| IMaxU
| IMaxS
| IExtMul {- Signed -} Bool {- High -} Bool
deriving (Show, Eq, Generic, NFData) deriving (Show, Eq, Generic, NFData)
data IRelOp = IEq | INe | ILtU | ILtS | IGtU | IGtS | ILeU | ILeS | IGeU | IGeS 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 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) data FRelOp = FEq | FNe | FLt | FGt | FLe | FGe deriving (Show, Eq, Generic, NFData)
@@ -131,7 +112,6 @@ data ValueType =
| I64 | I64
| F32 | F32
| F64 | F64
| V128
| Func | Func
| Extern | Extern
deriving (Show, Eq, Generic, NFData) deriving (Show, Eq, Generic, NFData)
@@ -179,23 +159,6 @@ data Instruction index =
| I64Load MemArg | I64Load MemArg
| F32Load MemArg | F32Load MemArg
| F64Load 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 | I32Load8S MemArg
| I32Load8U MemArg | I32Load8U MemArg
| I32Load16S MemArg | I32Load16S MemArg
@@ -210,11 +173,6 @@ data Instruction index =
| I64Store MemArg | I64Store MemArg
| F32Store MemArg | F32Store MemArg
| F64Store MemArg | F64Store MemArg
| V128Store MemArg
| V128Store8Lane MemArg Natural
| V128Store16Lane MemArg Natural
| V128Store32Lane MemArg Natural
| V128Store64Lane MemArg Natural
| I32Store8 MemArg | I32Store8 MemArg
| I32Store16 MemArg | I32Store16 MemArg
| I64Store8 MemArg | I64Store8 MemArg
@@ -240,7 +198,6 @@ data Instruction index =
| I64Const Word64 | I64Const Word64
| F32Const Float | F32Const Float
| F64Const Double | F64Const Double
| V128Const ByteArray.ByteArray
| IUnOp BitSize IUnOp | IUnOp BitSize IUnOp
| IBinOp BitSize IBinOp | IBinOp BitSize IBinOp
| I32Eqz | I32Eqz
@@ -262,23 +219,6 @@ data Instruction index =
| F64PromoteF32 | F64PromoteF32
| IReinterpretF BitSize | IReinterpretF BitSize
| FReinterpretI 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) deriving (Show, Eq, Generic, NFData)
type Expression = [Instruction Natural] type Expression = [Instruction Natural]
src/Language/Wasm/Validate.hs
+3 -147
View File
@@ -40,7 +40,6 @@ data ValidationError =
| ElemIndexOutOfRange Natural | ElemIndexOutOfRange Natural
| DataIndexOutOfRange Natural | DataIndexOutOfRange Natural
| LabelIndexOutOfRange | LabelIndexOutOfRange
| LaneIndexOutOfRange
| TypeIndexOutOfRange | TypeIndexOutOfRange
| ResultTypeDoesntMatch | ResultTypeDoesntMatch
| TypeMismatch { actual :: Arrow, expected :: Arrow } | TypeMismatch { actual :: Arrow, expected :: Arrow }
@@ -193,13 +192,10 @@ getLabel lbl = do
withLabel :: [ValueType] -> Checker a -> Checker a withLabel :: [ValueType] -> Checker a -> Checker a
withLabel result = withReaderT (\ctx -> ctx { labels = result : labels ctx }) withLabel result = withReaderT (\ctx -> ctx { labels = result : labels ctx })
isMemArgValid :: Natural -> MemArg -> Checker () isMemArgValid :: Int -> MemArg -> Checker ()
isMemArgValid sizeInBytes MemArg { align } = isMemArgValid sizeInBytes MemArg { align } = if 2 ^ align <= sizeInBytes then return () else throwError AlignmentOverflow
if 2 ^ align <= sizeInBytes
then return ()
else throwError AlignmentOverflow
checkMemoryInstr :: Natural -> MemArg -> Checker () checkMemoryInstr :: Int -> MemArg -> Checker ()
checkMemoryInstr size memarg = do checkMemoryInstr size memarg = do
isMemArgValid size memarg isMemArgValid size memarg
Ctx { mems } <- ask Ctx { mems } <- ask
@@ -281,8 +277,6 @@ getInstrType _ (CallIndirect tableIdx sign) = do
if length tables <= fromIntegral tableIdx if length tables <= fromIntegral tableIdx
then throwError (TableIndexOutOfRange tableIdx) then throwError (TableIndexOutOfRange tableIdx)
else do else do
let TableType _ elemType = tables !! fromIntegral tableIdx
when (elemType /= FuncRef) $ throwError (RefTypeMismatch FuncRef ExternRef)
Arrow from to <- maybeToEither TypeIndexOutOfRange $ asArrow <$> types !? sign Arrow from to <- maybeToEither TypeIndexOutOfRange $ asArrow <$> types !? sign
return $ (from ++ [Val I32]) ==> to return $ (from ++ [Val I32]) ==> to
getInstrType _ Drop = do getInstrType _ Drop = do
@@ -342,61 +336,6 @@ getInstrType _ (F32Load memarg) = do
getInstrType _ (F64Load memarg) = do getInstrType _ (F64Load memarg) = do
checkMemoryInstr 8 memarg checkMemoryInstr 8 memarg
return $ I32 ==> F64 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 getInstrType _ (I32Load8S memarg) = do
checkMemoryInstr 1 memarg checkMemoryInstr 1 memarg
return $ I32 ==> I32 return $ I32 ==> I32
@@ -439,25 +378,6 @@ getInstrType _ (F32Store memarg) = do
getInstrType _ (F64Store memarg) = do getInstrType _ (F64Store memarg) = do
checkMemoryInstr 8 memarg checkMemoryInstr 8 memarg
return $ [I32, F64] ==> empty 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 getInstrType _ (I32Store8 memarg) = do
checkMemoryInstr 1 memarg checkMemoryInstr 1 memarg
return $ [I32, I32] ==> empty return $ [I32, I32] ==> empty
@@ -547,29 +467,20 @@ getInstrType _ (I32Const _) = return $ empty ==> I32
getInstrType _ (I64Const _) = return $ empty ==> I64 getInstrType _ (I64Const _) = return $ empty ==> I64
getInstrType _ (F32Const _) = return $ empty ==> F32 getInstrType _ (F32Const _) = return $ empty ==> F32
getInstrType _ (F64Const _) = return $ empty ==> F64 getInstrType _ (F64Const _) = return $ empty ==> F64
getInstrType _ (V128Const _) = return $ empty ==> V128
getInstrType _ (IUnOp BS32 _) = return $ I32 ==> I32 getInstrType _ (IUnOp BS32 _) = return $ I32 ==> I32
getInstrType _ (IUnOp BS64 _) = return $ I64 ==> I64 getInstrType _ (IUnOp BS64 _) = return $ I64 ==> I64
getInstrType _ (IUnOp (BS128 _) _) = return $ V128 ==> V128
getInstrType _ (IBinOp BS32 _) = return $ [I32, I32] ==> I32 getInstrType _ (IBinOp BS32 _) = return $ [I32, I32] ==> I32
getInstrType _ (IBinOp BS64 _) = return $ [I64, I64] ==> I64 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 _ I32Eqz = return $ I32 ==> I32
getInstrType _ I64Eqz = return $ I64 ==> I32 getInstrType _ I64Eqz = return $ I64 ==> I32
getInstrType _ (IRelOp BS32 _) = return $ [I32, I32] ==> I32 getInstrType _ (IRelOp BS32 _) = return $ [I32, I32] ==> I32
getInstrType _ (IRelOp BS64 _) = return $ [I64, I64] ==> I32 getInstrType _ (IRelOp BS64 _) = return $ [I64, I64] ==> I32
getInstrType _ (IRelOp (BS128 _) _) = return $ [V128, V128] ==> V128
getInstrType _ (FUnOp BS32 _) = return $ F32 ==> F32 getInstrType _ (FUnOp BS32 _) = return $ F32 ==> F32
getInstrType _ (FUnOp BS64 _) = return $ F64 ==> F64 getInstrType _ (FUnOp BS64 _) = return $ F64 ==> F64
getInstrType _ (FUnOp (BS128 _) _) = return $ V128 ==> V128
getInstrType _ (FBinOp BS32 _) = return $ [F32, F32] ==> F32 getInstrType _ (FBinOp BS32 _) = return $ [F32, F32] ==> F32
getInstrType _ (FBinOp BS64 _) = return $ [F64, F64] ==> F64 getInstrType _ (FBinOp BS64 _) = return $ [F64, F64] ==> F64
getInstrType _ (FBinOp (BS128 _) _) = return $ [V128, V128] ==> V128
getInstrType _ (FRelOp BS32 _) = return $ [F32, F32] ==> I32 getInstrType _ (FRelOp BS32 _) = return $ [F32, F32] ==> I32
getInstrType _ (FRelOp BS64 _) = return $ [F64, F64] ==> I32 getInstrType _ (FRelOp BS64 _) = return $ [F64, F64] ==> I32
getInstrType _ (FRelOp (BS128 _) _) = return $ [V128, V128] ==> V128
getInstrType _ I32WrapI64 = return $ I64 ==> I32 getInstrType _ I32WrapI64 = return $ I64 ==> I32
getInstrType _ (ITruncFU BS32 BS32) = return $ F32 ==> I32 getInstrType _ (ITruncFU BS32 BS32) = return $ F32 ==> I32
getInstrType _ (ITruncFU BS32 BS64) = return $ F64 ==> 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 BS32 BS64) = return $ I64 ==> F32
getInstrType _ (FConvertIU BS64 BS32) = return $ I32 ==> F64 getInstrType _ (FConvertIU BS64 BS32) = return $ I32 ==> F64
getInstrType _ (FConvertIU BS64 BS64) = return $ I64 ==> 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 BS32) = return $ I32 ==> F32
getInstrType _ (FConvertIS BS32 BS64) = return $ I64 ==> F32 getInstrType _ (FConvertIS BS32 BS64) = return $ I64 ==> F32
getInstrType _ (FConvertIS BS64 BS32) = return $ I32 ==> F64 getInstrType _ (FConvertIS BS64 BS32) = return $ I32 ==> F64
getInstrType _ (FConvertIS BS64 BS64) = return $ I64 ==> F64 getInstrType _ (FConvertIS BS64 BS64) = return $ I64 ==> F64
getInstrType _ (FConvertIS (BS128 _) (BS128 _)) = return $ V128 ==> V128
getInstrType _ F32DemoteF64 = return $ F64 ==> F32 getInstrType _ F32DemoteF64 = return $ F64 ==> F32
getInstrType _ F64PromoteF32 = return $ F32 ==> F64 getInstrType _ F64PromoteF32 = return $ F32 ==> F64
getInstrType _ (IReinterpretF BS32) = return $ F32 ==> I32 getInstrType _ (IReinterpretF BS32) = return $ F32 ==> I32
getInstrType _ (IReinterpretF BS64) = return $ F64 ==> I64 getInstrType _ (IReinterpretF BS64) = return $ F64 ==> I64
getInstrType _ (FReinterpretI BS32) = return $ I32 ==> F32 getInstrType _ (FReinterpretI BS32) = return $ I32 ==> F32
getInstrType _ (FReinterpretI BS64) = return $ I64 ==> F64 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 :: (Eq a) => a -> a -> [a] -> [a]
replace _ _ [] = [] replace _ _ [] = []
@@ -718,7 +575,6 @@ isConstExpression ((I32Const _):rest) = isConstExpression rest
isConstExpression ((I64Const _):rest) = isConstExpression rest isConstExpression ((I64Const _):rest) = isConstExpression rest
isConstExpression ((F32Const _):rest) = isConstExpression rest isConstExpression ((F32Const _):rest) = isConstExpression rest
isConstExpression ((F64Const _):rest) = isConstExpression rest isConstExpression ((F64Const _):rest) = isConstExpression rest
isConstExpression ((V128Const _):rest) = isConstExpression rest
isConstExpression ((RefNull _):rest) = isConstExpression rest isConstExpression ((RefNull _):rest) = isConstExpression rest
isConstExpression ((RefFunc _):rest) = isConstExpression rest isConstExpression ((RefFunc _):rest) = isConstExpression rest
isConstExpression ((GetGlobal idx):rest) = do isConstExpression ((GetGlobal idx):rest) = do
tests/Test.hs
+2 -2
View File
@@ -17,9 +17,9 @@ import qualified Data.List as List
main :: IO () main :: IO ()
main = do main = do
files <- files <-
filter (List.isSuffixOf ".wast") filter (not . List.isPrefixOf "simd") . filter (List.isSuffixOf ".wast")
<$> Directory.listDirectory "tests/spec" <$> Directory.listDirectory "tests/spec"
-- let files = ["align.wast"] -- let files = ["binary-leb128.wast"]
scriptTestCases <- (`mapM` files) $ \file -> do scriptTestCases <- (`mapM` files) $ \file -> do
test <- LBS.readFile ("tests/spec/" ++ file) test <- LBS.readFile ("tests/spec/" ++ file)
return $ testCase file $ do return $ testCase file $ do
tests/spec
+1 -1
Submodule tests/spec updated: 68c6f83f33...b25bf82371
wasm.cabal
+5 -5
View File
@@ -56,14 +56,14 @@ library
, happy:happy >=1.9.4 && < 1.21 , happy:happy >=1.9.4 && < 1.21
build-depends: build-depends:
array >=0.5 && < 0.6 array >=0.5 && < 0.6
, base >=4.11 && < 5 , base >=4.6 && < 5
, bytestring >=0.10 && < 0.12 , bytestring >=0.10 && < 0.13
, cereal >=0.5 && < 0.6 , cereal >=0.5 && < 0.6
, containers >=0.5 && < 0.7 , containers >=0.5 && < 0.8
, deepseq >=1.4 && < 1.5 , deepseq >=1.4 && < 1.6
, ieee754 >=0.8 && < 0.9 , ieee754 >=0.8 && < 0.9
, mtl >=2.2.1 && < 2.4 , mtl >=2.2.1 && < 2.4
, primitive >=0.7 && < 0.8 , primitive >=0.7 && < 0.10
, text >=1.1 && < 3 , text >=1.1 && < 3
, transformers >=0.4 && < 0.7 , transformers >=0.4 && < 0.7
, utf8-string >=1.0 && < 1.1 , utf8-string >=1.0 && < 1.1