forked from GitHub/haskell-wasm
extract load instructions to generic function
This commit is contained in:
Ilya Rezvov
@@ -31,12 +31,13 @@ import Data.Vector.Storable.Mutable (IOVector)
|
||||
import qualified Data.Vector as Vector
|
||||
import qualified Data.Vector.Storable.Mutable as IOVector
|
||||
import Data.IORef (IORef, newIORef, readIORef, writeIORef)
|
||||
import Data.Word (Word8, Word32, Word64)
|
||||
import Data.Word (Word8, Word16, Word32, Word64)
|
||||
import Data.Int (Int32, Int64)
|
||||
import Numeric.Natural (Natural)
|
||||
import qualified Control.Monad as Monad
|
||||
import Data.Monoid ((<>))
|
||||
import Data.Bits (
|
||||
Bits,
|
||||
(.|.),
|
||||
(.&.),
|
||||
xor,
|
||||
@@ -629,6 +630,19 @@ eval budget store FunctionInstance { funcType, moduleInstance, code = Function {
|
||||
case res of
|
||||
Done ctx' -> go ctx' rest
|
||||
command -> return command
|
||||
|
||||
makeLoadInstr :: (Bits i, Integral i) => EvalCtx -> Natural -> Int -> ([Value] -> i -> EvalResult) -> IO EvalResult
|
||||
makeLoadInstr ctx@EvalCtx{ stack = (VI32 v:rest) } offset byteWidth cont = do
|
||||
let MemoryInstance { memory = memoryRef } = memInstances store ! (memaddrs moduleInstance ! 0)
|
||||
memory <- readIORef memoryRef
|
||||
let addr = fromIntegral v + fromIntegral offset
|
||||
let readByte idx = do
|
||||
byte <- IOVector.read memory $ addr + idx
|
||||
return $ fromIntegral byte `shiftL` (idx * 8)
|
||||
if addr + byteWidth > IOVector.length memory
|
||||
then return Trap
|
||||
else cont rest . sum <$> mapM readByte [0..byteWidth-1]
|
||||
makeLoadInstr _ _ _ _ = error "Incorrect value on top of stack for memory instruction"
|
||||
|
||||
step :: EvalCtx -> Instruction -> IO EvalResult
|
||||
step _ Unreachable = return Trap
|
||||
@@ -732,167 +746,44 @@ eval budget store FunctionInstance { funcType, moduleInstance, code = Function {
|
||||
GIConst _ v -> error "Attempt of mutation of constant global"
|
||||
GIMut _ ref -> writeIORef ref v
|
||||
return $ Done ctx { stack = rest }
|
||||
step ctx@EvalCtx{ stack = (VI32 v:rest) } (I32Load MemArg { offset }) = do
|
||||
let MemoryInstance { memory = memoryRef } = memInstances store ! (memaddrs moduleInstance ! 0)
|
||||
memory <- readIORef memoryRef
|
||||
let addr = fromIntegral v + fromIntegral offset
|
||||
let readByte idx = do
|
||||
byte <- IOVector.read memory $ addr + idx
|
||||
return $ fromIntegral byte `shiftL` (idx * 8)
|
||||
if addr + 4 > IOVector.length memory
|
||||
then return Trap
|
||||
else do
|
||||
val <- sum <$> mapM readByte [0..3]
|
||||
return $ Done ctx { stack = VI32 val : rest }
|
||||
step ctx@EvalCtx{ stack = (VI32 v:rest) } (I64Load MemArg { offset }) = do
|
||||
let MemoryInstance { memory = memoryRef } = memInstances store ! (memaddrs moduleInstance ! 0)
|
||||
memory <- readIORef memoryRef
|
||||
let addr = fromIntegral v + fromIntegral offset
|
||||
let readByte idx = do
|
||||
byte <- IOVector.read memory $ addr + idx
|
||||
return $ fromIntegral byte `shiftL` (idx * 8)
|
||||
if addr + 8 > IOVector.length memory
|
||||
then return Trap
|
||||
else do
|
||||
val <- sum <$> mapM readByte [0..7]
|
||||
return $ Done ctx { stack = VI64 val : rest }
|
||||
step ctx@EvalCtx{ stack = (VI32 v:rest) } (F32Load MemArg { offset }) = do
|
||||
let MemoryInstance { memory = memoryRef } = memInstances store ! (memaddrs moduleInstance ! 0)
|
||||
memory <- readIORef memoryRef
|
||||
let addr = fromIntegral v + fromIntegral offset
|
||||
let readByte idx = do
|
||||
byte <- IOVector.read memory $ addr + idx
|
||||
return $ fromIntegral byte `shiftL` (idx * 8)
|
||||
if addr + 4 > IOVector.length memory
|
||||
then return Trap
|
||||
else do
|
||||
val <- wordToFloat . sum <$> mapM readByte [0..3]
|
||||
return $ Done ctx { stack = VF32 val : rest }
|
||||
step ctx@EvalCtx{ stack = (VI32 v:rest) } (F64Load MemArg { offset }) = do
|
||||
let MemoryInstance { memory = memoryRef } = memInstances store ! (memaddrs moduleInstance ! 0)
|
||||
memory <- readIORef memoryRef
|
||||
let addr = fromIntegral v + fromIntegral offset
|
||||
let readByte idx = do
|
||||
byte <- IOVector.read memory $ addr + idx
|
||||
return $ fromIntegral byte `shiftL` (idx * 8)
|
||||
if addr + 8 > IOVector.length memory
|
||||
then return Trap
|
||||
else do
|
||||
val <- wordToDouble . sum <$> mapM readByte [0..7]
|
||||
return $ Done ctx { stack = VF64 val : rest }
|
||||
step ctx@EvalCtx{ stack = (VI32 v:rest) } (I32Load8U MemArg { offset }) = do
|
||||
let MemoryInstance { memory = memoryRef } = memInstances store ! (memaddrs moduleInstance ! 0)
|
||||
memory <- readIORef memoryRef
|
||||
let addr = fromIntegral v + fromIntegral offset
|
||||
if addr + 1 > IOVector.length memory
|
||||
then return Trap
|
||||
else do
|
||||
byte <- IOVector.read memory addr
|
||||
return $ Done ctx { stack = VI32 (fromIntegral byte) : rest }
|
||||
step ctx@EvalCtx{ stack = (VI32 v:rest) } (I32Load8S MemArg { offset }) = do
|
||||
let MemoryInstance { memory = memoryRef } = memInstances store ! (memaddrs moduleInstance ! 0)
|
||||
memory <- readIORef memoryRef
|
||||
let addr = fromIntegral v + fromIntegral offset
|
||||
if addr + 4 > IOVector.length memory
|
||||
then return Trap
|
||||
else do
|
||||
byte <- IOVector.read memory addr
|
||||
let val = asWord32 $ if byte >= 128 then -1 * fromIntegral (0xFF - byte + 1) else fromIntegral byte
|
||||
return $ Done ctx { stack = VI32 val : rest }
|
||||
step ctx@EvalCtx{ stack = (VI32 v:rest) } (I32Load16U MemArg { offset }) = do
|
||||
let MemoryInstance { memory = memoryRef } = memInstances store ! (memaddrs moduleInstance ! 0)
|
||||
memory <- readIORef memoryRef
|
||||
let addr = fromIntegral v + fromIntegral offset
|
||||
let readByte idx = do
|
||||
byte <- IOVector.read memory $ addr + idx
|
||||
return $ fromIntegral byte `shiftL` (idx * 8)
|
||||
if addr + 2 > IOVector.length memory
|
||||
then return Trap
|
||||
else do
|
||||
val <- sum <$> mapM readByte [0..1]
|
||||
return $ Done ctx { stack = VI32 val : rest }
|
||||
step ctx@EvalCtx{ stack = (VI32 v:rest) } (I32Load16S MemArg { offset }) = do
|
||||
let MemoryInstance { memory = memoryRef } = memInstances store ! (memaddrs moduleInstance ! 0)
|
||||
memory <- readIORef memoryRef
|
||||
let addr = fromIntegral v + fromIntegral offset
|
||||
let readByte idx = do
|
||||
byte <- IOVector.read memory $ addr + idx
|
||||
return $ (fromIntegral byte :: Word32) `shiftL` (idx * 8)
|
||||
if addr + 2 > IOVector.length memory
|
||||
then return Trap
|
||||
else do
|
||||
val <- sum <$> mapM readByte [0..1]
|
||||
let signed = asWord32 $ if val >= 2 ^ 15 then -1 * fromIntegral (0xFFFF - val + 1) else fromIntegral val
|
||||
return $ Done ctx { stack = VI32 signed : rest }
|
||||
step ctx@EvalCtx{ stack = (VI32 v:rest) } (I64Load8U MemArg { offset }) = do
|
||||
let MemoryInstance { memory = memoryRef } = memInstances store ! (memaddrs moduleInstance ! 0)
|
||||
memory <- readIORef memoryRef
|
||||
let addr = fromIntegral v + fromIntegral offset
|
||||
if addr + 1 > IOVector.length memory
|
||||
then return Trap
|
||||
else do
|
||||
byte <- IOVector.read memory addr
|
||||
return $ Done ctx { stack = VI64 (fromIntegral byte) : rest }
|
||||
step ctx@EvalCtx{ stack = (VI32 v:rest) } (I64Load8S MemArg { offset }) = do
|
||||
let MemoryInstance { memory = memoryRef } = memInstances store ! (memaddrs moduleInstance ! 0)
|
||||
memory <- readIORef memoryRef
|
||||
let addr = fromIntegral v + fromIntegral offset
|
||||
if addr + 1 > IOVector.length memory
|
||||
then return Trap
|
||||
else do
|
||||
byte <- IOVector.read memory addr
|
||||
let val = asWord64 $ if byte >= 128 then -1 * fromIntegral (0xFF - byte + 1) else fromIntegral byte
|
||||
return $ Done ctx { stack = VI64 val : rest }
|
||||
step ctx@EvalCtx{ stack = (VI32 v:rest) } (I64Load16U MemArg { offset }) = do
|
||||
let MemoryInstance { memory = memoryRef } = memInstances store ! (memaddrs moduleInstance ! 0)
|
||||
memory <- readIORef memoryRef
|
||||
let addr = fromIntegral v + fromIntegral offset
|
||||
let readByte idx = do
|
||||
byte <- IOVector.read memory $ addr + idx
|
||||
return $ fromIntegral byte `shiftL` (idx * 8)
|
||||
if addr + 2 > IOVector.length memory
|
||||
then return Trap
|
||||
else do
|
||||
val <- sum <$> mapM readByte [0..1]
|
||||
return $ Done ctx { stack = VI64 val : rest }
|
||||
step ctx@EvalCtx{ stack = (VI32 v:rest) } (I64Load16S MemArg { offset }) = do
|
||||
let MemoryInstance { memory = memoryRef } = memInstances store ! (memaddrs moduleInstance ! 0)
|
||||
memory <- readIORef memoryRef
|
||||
let addr = fromIntegral v + fromIntegral offset
|
||||
let readByte idx = do
|
||||
byte <- IOVector.read memory $ addr + idx
|
||||
return $ (fromIntegral byte :: Word32) `shiftL` (idx * 8)
|
||||
if addr + 2 > IOVector.length memory
|
||||
then return Trap
|
||||
else do
|
||||
val <- sum <$> mapM readByte [0..1]
|
||||
let signed = asWord64 $ if val >= 2 ^ 15 then -1 * fromIntegral (0xFFFF - val + 1) else fromIntegral val
|
||||
return $ Done ctx { stack = VI64 signed : rest }
|
||||
step ctx@EvalCtx{ stack = (VI32 v:rest) } (I64Load32U MemArg { offset }) = do
|
||||
let MemoryInstance { memory = memoryRef } = memInstances store ! (memaddrs moduleInstance ! 0)
|
||||
memory <- readIORef memoryRef
|
||||
let addr = fromIntegral v + fromIntegral offset
|
||||
let readByte idx = do
|
||||
byte <- IOVector.read memory $ addr + idx
|
||||
return $ fromIntegral byte `shiftL` (idx * 8)
|
||||
if addr + 4 > IOVector.length memory
|
||||
then return Trap
|
||||
else do
|
||||
val <- sum <$> mapM readByte [0..3]
|
||||
return $ Done ctx { stack = VI64 val : rest }
|
||||
step ctx@EvalCtx{ stack = (VI32 v:rest) } (I64Load32S MemArg { offset }) = do
|
||||
let MemoryInstance { memory = memoryRef } = memInstances store ! (memaddrs moduleInstance ! 0)
|
||||
memory <- readIORef memoryRef
|
||||
let addr = fromIntegral v + fromIntegral offset
|
||||
let readByte idx = do
|
||||
byte <- IOVector.read memory $ addr + idx
|
||||
return $ (fromIntegral byte :: Word32) `shiftL` (idx * 8)
|
||||
if addr + 4 > IOVector.length memory
|
||||
then return Trap
|
||||
else do
|
||||
val <- sum <$> mapM readByte [0..3]
|
||||
let signed = asWord64 $ fromIntegral $ asInt32 val
|
||||
return $ Done ctx { stack = VI64 signed : rest }
|
||||
step ctx (I32Load MemArg { offset }) =
|
||||
makeLoadInstr ctx offset 4 $ (\rest val -> Done ctx { stack = VI32 val : rest })
|
||||
step ctx (I64Load MemArg { offset }) =
|
||||
makeLoadInstr ctx offset 8 $ (\rest val -> Done ctx { stack = VI64 val : rest })
|
||||
step ctx (F32Load MemArg { offset }) =
|
||||
makeLoadInstr ctx offset 4 $ (\rest val -> Done ctx { stack = VF32 (wordToFloat val) : rest })
|
||||
step ctx (F64Load MemArg { offset }) =
|
||||
makeLoadInstr ctx offset 8 $ (\rest val -> Done ctx { stack = VF64 (wordToDouble val) : rest })
|
||||
step ctx (I32Load8U MemArg { offset }) =
|
||||
makeLoadInstr ctx offset 1 $ (\rest val -> Done ctx { stack = VI32 val : rest })
|
||||
step ctx (I32Load8S MemArg { offset }) =
|
||||
makeLoadInstr ctx offset 1 $ (\rest byte ->
|
||||
let val = asWord32 $ if (byte :: Word8) >= 128 then -1 * fromIntegral (0xFF - byte + 1) else fromIntegral byte in
|
||||
Done ctx { stack = VI32 val : rest })
|
||||
step ctx (I32Load16U MemArg { offset }) = do
|
||||
makeLoadInstr ctx offset 2 $ (\rest val -> Done ctx { stack = VI32 val : rest })
|
||||
step ctx (I32Load16S MemArg { offset }) =
|
||||
makeLoadInstr ctx offset 2 $ (\rest val ->
|
||||
let signed = asWord32 $ if (val :: Word16) >= 2 ^ 15 then -1 * fromIntegral (0xFFFF - val + 1) else fromIntegral val in
|
||||
Done ctx { stack = VI32 signed : rest })
|
||||
step ctx (I64Load8U MemArg { offset }) =
|
||||
makeLoadInstr ctx offset 1 $ (\rest val -> Done ctx { stack = VI64 val : rest })
|
||||
step ctx (I64Load8S MemArg { offset }) =
|
||||
makeLoadInstr ctx offset 1 $ (\rest byte ->
|
||||
let val = asWord64 $ if (byte :: Word8) >= 128 then -1 * fromIntegral (0xFF - byte + 1) else fromIntegral byte in
|
||||
Done ctx { stack = VI64 val : rest })
|
||||
step ctx (I64Load16U MemArg { offset }) =
|
||||
makeLoadInstr ctx offset 2 $ (\rest val -> Done ctx { stack = VI64 val : rest })
|
||||
step ctx (I64Load16S MemArg { offset }) =
|
||||
makeLoadInstr ctx offset 2 $ (\rest val ->
|
||||
let signed = asWord64 $ if (val :: Word16) >= 2 ^ 15 then -1 * fromIntegral (0xFFFF - val + 1) else fromIntegral val in
|
||||
Done ctx { stack = VI64 signed : rest })
|
||||
step ctx (I64Load32U MemArg { offset }) =
|
||||
makeLoadInstr ctx offset 4 $ (\rest val -> Done ctx { stack = VI64 val : rest })
|
||||
step ctx (I64Load32S MemArg { offset }) =
|
||||
makeLoadInstr ctx offset 4 $ (\rest val ->
|
||||
let signed = asWord64 $ fromIntegral $ asInt32 val in
|
||||
Done ctx { stack = VI64 signed : rest })
|
||||
step ctx@EvalCtx{ stack = (VI32 v:VI32 va:rest) } (I32Store MemArg { offset }) = do
|
||||
let MemoryInstance { memory = memoryRef } = memInstances store ! (memaddrs moduleInstance ! 0)
|
||||
memory <- readIORef memoryRef
|
||||
|
||||
+18
-33
@@ -627,7 +627,7 @@ memarg8 :: { MemArg }
|
||||
|
||||
instruction :: { [Instruction] }
|
||||
: raw_instr { $1 }
|
||||
| foldedinstr { $1 }
|
||||
| folded_instr { $1 }
|
||||
|
||||
raw_instr :: { [Instruction] }
|
||||
: plaininstr { [PlainInstr $1] }
|
||||
@@ -658,7 +658,7 @@ raw_block1 :: { Maybe Ident -> Either String Instruction }
|
||||
then Right $ BlockInstr ident [$2] (concat $4)
|
||||
else Left "Block labels have to match"
|
||||
}
|
||||
| foldedinstr1 list(instruction) 'end' opt(ident) {
|
||||
| folded_instr1 list(instruction) 'end' opt(ident) {
|
||||
\ident ->
|
||||
if ident == $4 || isNothing $4
|
||||
then Right $ BlockInstr ident [] ($1 ++ concat $2)
|
||||
@@ -687,7 +687,7 @@ raw_loop1 :: { Maybe Ident -> Either String Instruction }
|
||||
then Right $ LoopInstr ident [$2] (concat $4)
|
||||
else Left "Loop labels have to match"
|
||||
}
|
||||
| foldedinstr1 list(instruction) 'end' opt(ident) {
|
||||
| folded_instr1 list(instruction) 'end' opt(ident) {
|
||||
\ident ->
|
||||
if ident == $4 || isNothing $4
|
||||
then Right $ LoopInstr ident [] ($1 ++ concat $2)
|
||||
@@ -716,7 +716,7 @@ raw_if_result1 :: { Maybe Ident -> Either String [Instruction] }
|
||||
then Right [IfInstr ident [$2] (concat $4) $ fst $5]
|
||||
else Left "If labels have to match"
|
||||
}
|
||||
| foldedinstr1 list(instruction) raw_else {
|
||||
| folded_instr1 list(instruction) raw_else {
|
||||
\ident ->
|
||||
if ident == (snd $3) || isNothing (snd $3)
|
||||
then Right [IfInstr ident [] ($1 ++ concat $2) $ fst $3]
|
||||
@@ -763,13 +763,13 @@ raw_call_indirect_return_functype1 :: { (Maybe FuncType, [Instruction]) }
|
||||
let ft = fromMaybe emptyFuncType $ fst $4 in
|
||||
(Just $ ft { results = $2 ++ results ft }, snd $4)
|
||||
}
|
||||
| foldedinstr1 { (Nothing, $1) }
|
||||
| folded_instr1 { (Nothing, $1) }
|
||||
|
||||
foldedinstr :: { [Instruction] }
|
||||
: '(' foldedinstr1 { $2 }
|
||||
folded_instr :: { [Instruction] }
|
||||
: '(' folded_instr1 { $2 }
|
||||
|
||||
foldedinstr1 :: { [Instruction] }
|
||||
: plaininstr list(foldedinstr) ')' { concat $2 ++ [PlainInstr $1] }
|
||||
folded_instr1 :: { [Instruction] }
|
||||
: plaininstr list(folded_instr) ')' { concat $2 ++ [PlainInstr $1] }
|
||||
| 'call_indirect' folded_call_indirect { $2 }
|
||||
| 'block' opt(ident) folded_block { [$3 $2] }
|
||||
| 'loop' opt(ident) folded_loop { [$3 $2] }
|
||||
@@ -782,7 +782,7 @@ folded_block :: { Maybe Ident -> Instruction }
|
||||
|
||||
folded_block1 :: { Maybe Ident -> Instruction }
|
||||
: 'result' valtype ')' list(instruction) ')' { \ident -> BlockInstr ident [$2] (concat $4) }
|
||||
| foldedinstr1 list(instruction) ')' { \ident -> BlockInstr ident [] ($1 ++ concat $2) }
|
||||
| folded_instr1 list(instruction) ')' { \ident -> BlockInstr ident [] ($1 ++ concat $2) }
|
||||
|
||||
folded_loop :: { Maybe Ident -> Instruction }
|
||||
: ')' { \ident -> LoopInstr ident [] [] }
|
||||
@@ -791,7 +791,7 @@ folded_loop :: { Maybe Ident -> Instruction }
|
||||
|
||||
folded_loop1 :: { Maybe Ident -> Instruction }
|
||||
: 'result' valtype ')' list(instruction) ')' { \ident -> LoopInstr ident [$2] (concat $4) }
|
||||
| foldedinstr1 list(instruction) ')' { \ident -> LoopInstr ident [] ($1 ++ concat $2) }
|
||||
| folded_instr1 list(instruction) ')' { \ident -> LoopInstr ident [] ($1 ++ concat $2) }
|
||||
|
||||
folded_if_result :: { Maybe Ident -> [Instruction] }
|
||||
: 'result' valtype ')' '(' folded_then_else {
|
||||
@@ -807,7 +807,7 @@ folded_if_result :: { Maybe Ident -> [Instruction] }
|
||||
|
||||
folded_then_else :: { ([Instruction], ([Instruction], [Instruction])) }
|
||||
: 'then' list(instruction) ')' folded_else { ([], (concat $2, $4)) }
|
||||
| foldedinstr1 '(' folded_then_else {
|
||||
| folded_instr1 '(' folded_then_else {
|
||||
let (pred, branches) = $3 in
|
||||
($1 ++ pred, branches)
|
||||
}
|
||||
@@ -848,7 +848,7 @@ folded_call_indirect_return_functype1 :: { (Maybe FuncType, [Instruction]) }
|
||||
let ft = fromMaybe emptyFuncType $ fst $4 in
|
||||
(Just $ ft { results = $2 ++ results ft }, snd $4)
|
||||
}
|
||||
| foldedinstr1 list(foldedinstr) ')' { (Nothing, $1 ++ concat $2) }
|
||||
| folded_instr1 list(folded_instr) ')' { (Nothing, $1 ++ concat $2) }
|
||||
|
||||
importdesc :: { ImportDesc }
|
||||
: 'func' opt(ident) typeuse ')' { ImportFunc $2 $3 }
|
||||
@@ -925,7 +925,7 @@ locals_body :: { ([LocalType], [Instruction]) }
|
||||
locals_body1 :: { ([LocalType], [Instruction]) }
|
||||
: 'local' list(valtype) ')' locals_body { (map (LocalType Nothing) $2 ++ fst $4, snd $4) }
|
||||
| 'local' ident valtype ')' locals_body { (LocalType (Just $2) $3 : fst $5, snd $5) }
|
||||
| foldedinstr1 list(instruction) ')' { ([], $1 ++ concat $2) }
|
||||
| folded_instr1 list(instruction) ')' { ([], $1 ++ concat $2) }
|
||||
|
||||
-- FUNCTION END --
|
||||
|
||||
@@ -1036,8 +1036,8 @@ start :: { StartFunction }
|
||||
-- but collection of testcases omits 'offset' in this position
|
||||
-- I am going to support both options for now, but maybe it has to be updated in future.
|
||||
offsetexpr :: { [Instruction] }
|
||||
: 'offset' list(foldedinstr) ')' { concat $2 }
|
||||
| foldedinstr1 { $1 }
|
||||
: 'offset' list(folded_instr) ')' { concat $2 }
|
||||
| folded_instr1 { $1 }
|
||||
|
||||
elemsegment :: { ElemSegment }
|
||||
: 'elem' opt(index) '(' offsetexpr list(index) ')' { ElemSegment (fromMaybe (Index 0) $2) $4 $5 }
|
||||
@@ -1094,11 +1094,11 @@ module1 :: { ModuleDef }
|
||||
| modulefield1 list(modulefield) {% RawModDef Nothing `fmap` (desugarize $ $1 ++ concat $2) }
|
||||
|
||||
action1 :: { Action }
|
||||
: 'invoke' opt(ident) string list(foldedinstr) ')' { Invoke $2 $3 (map (map constInstructionToValue) $4) }
|
||||
: 'invoke' opt(ident) string list(folded_instr) ')' { Invoke $2 $3 (map (map constInstructionToValue) $4) }
|
||||
| 'get' opt(ident) string ')' { Get $2 $3 }
|
||||
|
||||
assertion1 :: { Assertion }
|
||||
: 'assert_return' '(' action1 list(foldedinstr) ')' { AssertReturn $3 (map (map constInstructionToValue) $4) }
|
||||
: 'assert_return' '(' action1 list(folded_instr) ')' { AssertReturn $3 (map (map constInstructionToValue) $4) }
|
||||
| 'assert_return_canonical_nan' '(' action1 ')' { AssertReturnCanonicalNaN $3 }
|
||||
| 'assert_return_arithmetic_nan' '(' action1 ')' { AssertReturnArithmeticNaN $3 }
|
||||
| 'assert_trap' '(' assertion_trap string ')' { AssertTrap $3 $4 }
|
||||
@@ -1152,9 +1152,6 @@ matchIdents Nothing _ = True
|
||||
matchIdents _ Nothing = True
|
||||
matchIdents a b = a == b
|
||||
|
||||
asFloat32 :: Double -> Float
|
||||
asFloat32 v = doubleToFloat v
|
||||
|
||||
asOffset :: LBS.ByteString -> Maybe Natural
|
||||
asOffset str = do
|
||||
num <- TL.stripPrefix "offset=" $ TLEncoding.decodeUtf8 str
|
||||
@@ -1176,18 +1173,6 @@ parseMemArg defAlign optOffset optAlign = do
|
||||
then Left "u32 is out of boundaries"
|
||||
else return $ MemArg offset align
|
||||
|
||||
-- TODO: check name conditions.
|
||||
-- Presuming the source text is itself encoded correctly,
|
||||
-- strings that do not contain any uses of hexadecimal byte escapes are always valid names.
|
||||
asName :: LBS.ByteString -> Maybe TL.Text
|
||||
asName = Just . TLEncoding.decodeUtf8
|
||||
|
||||
asString :: LBS.ByteString -> Maybe TL.Text
|
||||
asString bs =
|
||||
case TLEncoding.decodeUtf8' bs of
|
||||
Right t -> Just t
|
||||
Left err -> Nothing
|
||||
|
||||
eitherToMaybe :: Either left right -> Maybe right
|
||||
eitherToMaybe = either (const Nothing) Just
|
||||
|
||||
|
||||
Reference in New Issue
Block a user