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

extract load instructions to generic function

Browse Source
This commit is contained in:
Ilya Rezvov
2018-04-24 19:08:31 -07:00
parent 9d14c233c5
commit a619e1b742
2 changed files with 71 additions and 195 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Language/Wasm/Interpreter.hs
+53 -162
View File
@@ -31,12 +31,13 @@ import Data.Vector.Storable.Mutable (IOVector)
import qualified Data.Vector as Vector import qualified Data.Vector as Vector
import qualified Data.Vector.Storable.Mutable as IOVector import qualified Data.Vector.Storable.Mutable as IOVector
import Data.IORef (IORef, newIORef, readIORef, writeIORef) 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 Data.Int (Int32, Int64)
import Numeric.Natural (Natural) import Numeric.Natural (Natural)
import qualified Control.Monad as Monad import qualified Control.Monad as Monad
import Data.Monoid ((<>)) import Data.Monoid ((<>))
import Data.Bits ( import Data.Bits (
Bits,
(.|.), (.|.),
(.&.), (.&.),
xor, xor,
@@ -630,6 +631,19 @@ eval budget store FunctionInstance { funcType, moduleInstance, code = Function {
Done ctx' -> go ctx' rest Done ctx' -> go ctx' rest
command -> return command 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 :: EvalCtx -> Instruction -> IO EvalResult
step _ Unreachable = return Trap step _ Unreachable = return Trap
step ctx Nop = return $ Done ctx step ctx Nop = return $ Done ctx
@@ -732,167 +746,44 @@ eval budget store FunctionInstance { funcType, moduleInstance, code = Function {
GIConst _ v -> error "Attempt of mutation of constant global" GIConst _ v -> error "Attempt of mutation of constant global"
GIMut _ ref -> writeIORef ref v GIMut _ ref -> writeIORef ref v
return $ Done ctx { stack = rest } return $ Done ctx { stack = rest }
step ctx@EvalCtx{ stack = (VI32 v:rest) } (I32Load MemArg { offset }) = do step ctx (I32Load MemArg { offset }) =
let MemoryInstance { memory = memoryRef } = memInstances store ! (memaddrs moduleInstance ! 0) makeLoadInstr ctx offset 4 $ (\rest val -> Done ctx { stack = VI32 val : rest })
memory <- readIORef memoryRef step ctx (I64Load MemArg { offset }) =
let addr = fromIntegral v + fromIntegral offset makeLoadInstr ctx offset 8 $ (\rest val -> Done ctx { stack = VI64 val : rest })
let readByte idx = do step ctx (F32Load MemArg { offset }) =
byte <- IOVector.read memory $ addr + idx makeLoadInstr ctx offset 4 $ (\rest val -> Done ctx { stack = VF32 (wordToFloat val) : rest })
return $ fromIntegral byte `shiftL` (idx * 8) step ctx (F64Load MemArg { offset }) =
if addr + 4 > IOVector.length memory makeLoadInstr ctx offset 8 $ (\rest val -> Done ctx { stack = VF64 (wordToDouble val) : rest })
then return Trap step ctx (I32Load8U MemArg { offset }) =
else do makeLoadInstr ctx offset 1 $ (\rest val -> Done ctx { stack = VI32 val : rest })
val <- sum <$> mapM readByte [0..3] step ctx (I32Load8S MemArg { offset }) =
return $ Done ctx { stack = VI32 val : rest } makeLoadInstr ctx offset 1 $ (\rest byte ->
step ctx@EvalCtx{ stack = (VI32 v:rest) } (I64Load MemArg { offset }) = do let val = asWord32 $ if (byte :: Word8) >= 128 then -1 * fromIntegral (0xFF - byte + 1) else fromIntegral byte in
let MemoryInstance { memory = memoryRef } = memInstances store ! (memaddrs moduleInstance ! 0) Done ctx { stack = VI32 val : rest })
memory <- readIORef memoryRef step ctx (I32Load16U MemArg { offset }) = do
let addr = fromIntegral v + fromIntegral offset makeLoadInstr ctx offset 2 $ (\rest val -> Done ctx { stack = VI32 val : rest })
let readByte idx = do step ctx (I32Load16S MemArg { offset }) =
byte <- IOVector.read memory $ addr + idx makeLoadInstr ctx offset 2 $ (\rest val ->
return $ fromIntegral byte `shiftL` (idx * 8) let signed = asWord32 $ if (val :: Word16) >= 2 ^ 15 then -1 * fromIntegral (0xFFFF - val + 1) else fromIntegral val in
if addr + 8 > IOVector.length memory Done ctx { stack = VI32 signed : rest })
then return Trap step ctx (I64Load8U MemArg { offset }) =
else do makeLoadInstr ctx offset 1 $ (\rest val -> Done ctx { stack = VI64 val : rest })
val <- sum <$> mapM readByte [0..7] step ctx (I64Load8S MemArg { offset }) =
return $ Done ctx { stack = VI64 val : rest } makeLoadInstr ctx offset 1 $ (\rest byte ->
step ctx@EvalCtx{ stack = (VI32 v:rest) } (F32Load MemArg { offset }) = do let val = asWord64 $ if (byte :: Word8) >= 128 then -1 * fromIntegral (0xFF - byte + 1) else fromIntegral byte in
let MemoryInstance { memory = memoryRef } = memInstances store ! (memaddrs moduleInstance ! 0) Done ctx { stack = VI64 val : rest })
memory <- readIORef memoryRef step ctx (I64Load16U MemArg { offset }) =
let addr = fromIntegral v + fromIntegral offset makeLoadInstr ctx offset 2 $ (\rest val -> Done ctx { stack = VI64 val : rest })
let readByte idx = do step ctx (I64Load16S MemArg { offset }) =
byte <- IOVector.read memory $ addr + idx makeLoadInstr ctx offset 2 $ (\rest val ->
return $ fromIntegral byte `shiftL` (idx * 8) let signed = asWord64 $ if (val :: Word16) >= 2 ^ 15 then -1 * fromIntegral (0xFFFF - val + 1) else fromIntegral val in
if addr + 4 > IOVector.length memory Done ctx { stack = VI64 signed : rest })
then return Trap step ctx (I64Load32U MemArg { offset }) =
else do makeLoadInstr ctx offset 4 $ (\rest val -> Done ctx { stack = VI64 val : rest })
val <- wordToFloat . sum <$> mapM readByte [0..3] step ctx (I64Load32S MemArg { offset }) =
return $ Done ctx { stack = VF32 val : rest } makeLoadInstr ctx offset 4 $ (\rest val ->
step ctx@EvalCtx{ stack = (VI32 v:rest) } (F64Load MemArg { offset }) = do let signed = asWord64 $ fromIntegral $ asInt32 val in
let MemoryInstance { memory = memoryRef } = memInstances store ! (memaddrs moduleInstance ! 0) Done ctx { stack = VI64 signed : rest })
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@EvalCtx{ stack = (VI32 v:VI32 va:rest) } (I32Store MemArg { offset }) = do step ctx@EvalCtx{ stack = (VI32 v:VI32 va:rest) } (I32Store MemArg { offset }) = do
let MemoryInstance { memory = memoryRef } = memInstances store ! (memaddrs moduleInstance ! 0) let MemoryInstance { memory = memoryRef } = memInstances store ! (memaddrs moduleInstance ! 0)
memory <- readIORef memoryRef memory <- readIORef memoryRef
src/Language/Wasm/Parser.y
+18 -33
View File
@@ -627,7 +627,7 @@ memarg8 :: { MemArg }
instruction :: { [Instruction] } instruction :: { [Instruction] }
: raw_instr { $1 } : raw_instr { $1 }
| foldedinstr { $1 } | folded_instr { $1 }
raw_instr :: { [Instruction] } raw_instr :: { [Instruction] }
: plaininstr { [PlainInstr $1] } : plaininstr { [PlainInstr $1] }
@@ -658,7 +658,7 @@ raw_block1 :: { Maybe Ident -> Either String Instruction }
then Right $ BlockInstr ident [$2] (concat $4) then Right $ BlockInstr ident [$2] (concat $4)
else Left "Block labels have to match" else Left "Block labels have to match"
} }
| foldedinstr1 list(instruction) 'end' opt(ident) { | folded_instr1 list(instruction) 'end' opt(ident) {
\ident -> \ident ->
if ident == $4 || isNothing $4 if ident == $4 || isNothing $4
then Right $ BlockInstr ident [] ($1 ++ concat $2) 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) then Right $ LoopInstr ident [$2] (concat $4)
else Left "Loop labels have to match" else Left "Loop labels have to match"
} }
| foldedinstr1 list(instruction) 'end' opt(ident) { | folded_instr1 list(instruction) 'end' opt(ident) {
\ident -> \ident ->
if ident == $4 || isNothing $4 if ident == $4 || isNothing $4
then Right $ LoopInstr ident [] ($1 ++ concat $2) 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] then Right [IfInstr ident [$2] (concat $4) $ fst $5]
else Left "If labels have to match" else Left "If labels have to match"
} }
| foldedinstr1 list(instruction) raw_else { | folded_instr1 list(instruction) raw_else {
\ident -> \ident ->
if ident == (snd $3) || isNothing (snd $3) if ident == (snd $3) || isNothing (snd $3)
then Right [IfInstr ident [] ($1 ++ concat $2) $ fst $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 let ft = fromMaybe emptyFuncType $ fst $4 in
(Just $ ft { results = $2 ++ results ft }, snd $4) (Just $ ft { results = $2 ++ results ft }, snd $4)
} }
| foldedinstr1 { (Nothing, $1) } | folded_instr1 { (Nothing, $1) }
foldedinstr :: { [Instruction] } folded_instr :: { [Instruction] }
: '(' foldedinstr1 { $2 } : '(' folded_instr1 { $2 }
foldedinstr1 :: { [Instruction] } folded_instr1 :: { [Instruction] }
: plaininstr list(foldedinstr) ')' { concat $2 ++ [PlainInstr $1] } : plaininstr list(folded_instr) ')' { concat $2 ++ [PlainInstr $1] }
| 'call_indirect' folded_call_indirect { $2 } | 'call_indirect' folded_call_indirect { $2 }
| 'block' opt(ident) folded_block { [$3 $2] } | 'block' opt(ident) folded_block { [$3 $2] }
| 'loop' opt(ident) folded_loop { [$3 $2] } | 'loop' opt(ident) folded_loop { [$3 $2] }
@@ -782,7 +782,7 @@ folded_block :: { Maybe Ident -> Instruction }
folded_block1 :: { Maybe Ident -> Instruction } folded_block1 :: { Maybe Ident -> Instruction }
: 'result' valtype ')' list(instruction) ')' { \ident -> BlockInstr ident [$2] (concat $4) } : '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 } folded_loop :: { Maybe Ident -> Instruction }
: ')' { \ident -> LoopInstr ident [] [] } : ')' { \ident -> LoopInstr ident [] [] }
@@ -791,7 +791,7 @@ folded_loop :: { Maybe Ident -> Instruction }
folded_loop1 :: { Maybe Ident -> Instruction } folded_loop1 :: { Maybe Ident -> Instruction }
: 'result' valtype ')' list(instruction) ')' { \ident -> LoopInstr ident [$2] (concat $4) } : '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] } folded_if_result :: { Maybe Ident -> [Instruction] }
: 'result' valtype ')' '(' folded_then_else { : 'result' valtype ')' '(' folded_then_else {
@@ -807,7 +807,7 @@ folded_if_result :: { Maybe Ident -> [Instruction] }
folded_then_else :: { ([Instruction], ([Instruction], [Instruction])) } folded_then_else :: { ([Instruction], ([Instruction], [Instruction])) }
: 'then' list(instruction) ')' folded_else { ([], (concat $2, $4)) } : 'then' list(instruction) ')' folded_else { ([], (concat $2, $4)) }
| foldedinstr1 '(' folded_then_else { | folded_instr1 '(' folded_then_else {
let (pred, branches) = $3 in let (pred, branches) = $3 in
($1 ++ pred, branches) ($1 ++ pred, branches)
} }
@@ -848,7 +848,7 @@ folded_call_indirect_return_functype1 :: { (Maybe FuncType, [Instruction]) }
let ft = fromMaybe emptyFuncType $ fst $4 in let ft = fromMaybe emptyFuncType $ fst $4 in
(Just $ ft { results = $2 ++ results ft }, snd $4) (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 } importdesc :: { ImportDesc }
: 'func' opt(ident) typeuse ')' { ImportFunc $2 $3 } : 'func' opt(ident) typeuse ')' { ImportFunc $2 $3 }
@@ -925,7 +925,7 @@ locals_body :: { ([LocalType], [Instruction]) }
locals_body1 :: { ([LocalType], [Instruction]) } locals_body1 :: { ([LocalType], [Instruction]) }
: 'local' list(valtype) ')' locals_body { (map (LocalType Nothing) $2 ++ fst $4, snd $4) } : '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) } | '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 -- -- FUNCTION END --
@@ -1036,8 +1036,8 @@ start :: { StartFunction }
-- but collection of testcases omits 'offset' in this position -- 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. -- I am going to support both options for now, but maybe it has to be updated in future.
offsetexpr :: { [Instruction] } offsetexpr :: { [Instruction] }
: 'offset' list(foldedinstr) ')' { concat $2 } : 'offset' list(folded_instr) ')' { concat $2 }
| foldedinstr1 { $1 } | folded_instr1 { $1 }
elemsegment :: { ElemSegment } elemsegment :: { ElemSegment }
: 'elem' opt(index) '(' offsetexpr list(index) ')' { ElemSegment (fromMaybe (Index 0) $2) $4 $5 } : '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) } | modulefield1 list(modulefield) {% RawModDef Nothing `fmap` (desugarize $ $1 ++ concat $2) }
action1 :: { Action } 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 } | 'get' opt(ident) string ')' { Get $2 $3 }
assertion1 :: { Assertion } 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_canonical_nan' '(' action1 ')' { AssertReturnCanonicalNaN $3 }
| 'assert_return_arithmetic_nan' '(' action1 ')' { AssertReturnArithmeticNaN $3 } | 'assert_return_arithmetic_nan' '(' action1 ')' { AssertReturnArithmeticNaN $3 }
| 'assert_trap' '(' assertion_trap string ')' { AssertTrap $3 $4 } | 'assert_trap' '(' assertion_trap string ')' { AssertTrap $3 $4 }
@@ -1152,9 +1152,6 @@ matchIdents Nothing _ = True
matchIdents _ Nothing = True matchIdents _ Nothing = True
matchIdents a b = a == b matchIdents a b = a == b
asFloat32 :: Double -> Float
asFloat32 v = doubleToFloat v
asOffset :: LBS.ByteString -> Maybe Natural asOffset :: LBS.ByteString -> Maybe Natural
asOffset str = do asOffset str = do
num <- TL.stripPrefix "offset=" $ TLEncoding.decodeUtf8 str num <- TL.stripPrefix "offset=" $ TLEncoding.decodeUtf8 str
@@ -1176,18 +1173,6 @@ parseMemArg defAlign optOffset optAlign = do
then Left "u32 is out of boundaries" then Left "u32 is out of boundaries"
else return $ MemArg offset align 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 left right -> Maybe right
eitherToMaybe = either (const Nothing) Just eitherToMaybe = either (const Nothing) Just