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

more grammar fixes

Browse Source
This commit is contained in:
Ilya Rezvov
2021-03-16 21:49:02 -07:00
parent 4f0926ca3f
commit 6131babc8e
8 changed files with 84 additions and 83 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Language/Wasm/Binary.hs
+2 -2
View File
@@ -217,8 +217,8 @@ instance Serialize FuncType where
return $ FuncType { params, results } return $ FuncType { params, results }
instance Serialize ElemType where instance Serialize ElemType where
put AnyFunc = putWord8 0x70 put FuncRef = putWord8 0x70
get = byteGuard 0x70 >> return AnyFunc get = byteGuard 0x70 >> return FuncRef
instance Serialize Limit where instance Serialize Limit where
put (Limit min Nothing) = putWord8 0x00 >> putULEB128 min put (Limit min Nothing) = putWord8 0x00 >> putULEB128 min
src/Language/Wasm/Builder.hs
+2 -2
View File
@@ -858,7 +858,7 @@ importMemory mod name min max = do
importTable :: TL.Text -> TL.Text -> Natural -> Maybe Natural -> GenMod Tbl importTable :: TL.Text -> TL.Text -> Natural -> Maybe Natural -> GenMod Tbl
importTable mod name min max = do importTable mod name min max = do
modify $ \(st@GenModState { target = m }) -> st { modify $ \(st@GenModState { target = m }) -> st {
target = m { imports = imports m ++ [Import mod name $ ImportTable $ TableType (Limit min max) AnyFunc] } target = m { imports = imports m ++ [Import mod name $ ImportTable $ TableType (Limit min max) FuncRef] }
} }
return $ Tbl 0 return $ Tbl 0
@@ -968,7 +968,7 @@ newtype Tbl = Tbl Natural deriving (Show, Eq)
table :: Natural -> Maybe Natural -> GenMod Tbl table :: Natural -> Maybe Natural -> GenMod Tbl
table min max = do table min max = do
modify $ \(st@GenModState { target = m }) -> st { modify $ \(st@GenModState { target = m }) -> st {
target = m { tables = tables m ++ [Table $ TableType (Limit min max) AnyFunc] } target = m { tables = tables m ++ [Table $ TableType (Limit min max) FuncRef] }
} }
return $ Tbl 0 return $ Tbl 0
src/Language/Wasm/Interpreter.hs
+1 -1
View File
@@ -279,7 +279,7 @@ makeHostModule st items = do
makeHostTables :: (Store, ModuleInstance) -> IO (Store, ModuleInstance) makeHostTables :: (Store, ModuleInstance) -> IO (Store, ModuleInstance)
makeHostTables (st, inst) = do makeHostTables (st, inst) = do
let tableLen = Vector.length $ tableInstances st let tableLen = Vector.length $ tableInstances st
let (names, tables) = unzip [(name, Table (TableType lim AnyFunc)) | (name, (HostTable lim)) <- items] let (names, tables) = unzip [(name, Table (TableType lim FuncRef)) | (name, (HostTable lim)) <- items]
let instances = allocTables tables let instances = allocTables tables
let exps = Vector.fromList $ zipWith (\name i -> ExportInstance name (ExternTable i)) names [tableLen..] let exps = Vector.fromList $ zipWith (\name i -> ExportInstance name (ExternTable i)) names [tableLen..]
let inst' = inst { let inst' = inst {
src/Language/Wasm/Lexer.x
+1
View File
@@ -63,6 +63,7 @@ tokens :-
<0> "+nan" { constToken $ TFloatLit $ BinRep (abs nan) } <0> "+nan" { constToken $ TFloatLit $ BinRep (abs nan) }
<0> "-nan" { constToken $ TFloatLit $ BinRep nan } <0> "-nan" { constToken $ TFloatLit $ BinRep nan }
<0> "nan:canonical" { constToken $ TFloatLit $ BinRep nan } <0> "nan:canonical" { constToken $ TFloatLit $ BinRep nan }
<0> "nan:arithmetic" { constToken $ TFloatLit $ BinRep nan }
<0> $sign? @nanhex { parseNanSigned } <0> $sign? @nanhex { parseNanSigned }
<0> "inf" { constToken $ TFloatLit $ BinRep inf } <0> "inf" { constToken $ TFloatLit $ BinRep inf }
<0> "+inf" { constToken $ TFloatLit $ BinRep inf } <0> "+inf" { constToken $ TFloatLit $ BinRep inf }
src/Language/Wasm/Parser.y
+54 -54
View File
@@ -116,7 +116,7 @@ import Language.Wasm.Lexer (
'f32' { Lexeme _ (TKeyword "f32") } 'f32' { Lexeme _ (TKeyword "f32") }
'f64' { Lexeme _ (TKeyword "f64") } 'f64' { Lexeme _ (TKeyword "f64") }
'mut' { Lexeme _ (TKeyword "mut") } 'mut' { Lexeme _ (TKeyword "mut") }
'anyfunc' { Lexeme _ (TKeyword "anyfunc") } 'funcref' { Lexeme _ (TKeyword "funcref") }
'type' { Lexeme _ (TKeyword "type") } 'type' { Lexeme _ (TKeyword "type") }
'unreachable' { Lexeme _ (TKeyword "unreachable") } 'unreachable' { Lexeme _ (TKeyword "unreachable") }
'nop' { Lexeme _ (TKeyword "nop") } 'nop' { Lexeme _ (TKeyword "nop") }
@@ -260,27 +260,27 @@ import Language.Wasm.Lexer (
'f64.gt' { Lexeme _ (TKeyword "f64.gt") } 'f64.gt' { Lexeme _ (TKeyword "f64.gt") }
'f64.le' { Lexeme _ (TKeyword "f64.le") } 'f64.le' { Lexeme _ (TKeyword "f64.le") }
'f64.ge' { Lexeme _ (TKeyword "f64.ge") } 'f64.ge' { Lexeme _ (TKeyword "f64.ge") }
'i32.wrap/i64' { Lexeme _ (TKeyword "i32.wrap/i64") } 'i32.wrap_i64' { Lexeme _ (TKeyword "i32.wrap_i64") }
'i32.trunc_s/f32' { Lexeme _ (TKeyword "i32.trunc_s/f32") } 'i32.trunc_f32_s' { Lexeme _ (TKeyword "i32.trunc_f32_s") }
'i32.trunc_u/f32' { Lexeme _ (TKeyword "i32.trunc_u/f32") } 'i32.trunc_f32_u' { Lexeme _ (TKeyword "i32.trunc_f32_u") }
'i32.trunc_s/f64' { Lexeme _ (TKeyword "i32.trunc_s/f64") } 'i32.trunc_f64_s' { Lexeme _ (TKeyword "i32.trunc_f64_s") }
'i32.trunc_u/f64' { Lexeme _ (TKeyword "i32.trunc_u/f64") } 'i32.trunc_f64_u' { Lexeme _ (TKeyword "i32.trunc_f64_u") }
'i64.extend_s/i32' { Lexeme _ (TKeyword "i64.extend_s/i32") } 'i64.extend_i32_s' { Lexeme _ (TKeyword "i64.extend_i32_s") }
'i64.extend_u/i32' { Lexeme _ (TKeyword "i64.extend_u/i32") } 'i64.extend_i32_u' { Lexeme _ (TKeyword "i64.extend_i32_u") }
'i64.trunc_s/f32' { Lexeme _ (TKeyword "i64.trunc_s/f32") } 'i64.trunc_f32_s' { Lexeme _ (TKeyword "i64.trunc_f32_s") }
'i64.trunc_u/f32' { Lexeme _ (TKeyword "i64.trunc_u/f32") } 'i64.trunc_f32_u' { Lexeme _ (TKeyword "i64.trunc_f32_u") }
'i64.trunc_s/f64' { Lexeme _ (TKeyword "i64.trunc_s/f64") } 'i64.trunc_f64_s' { Lexeme _ (TKeyword "i64.trunc_f64_s") }
'i64.trunc_u/f64' { Lexeme _ (TKeyword "i64.trunc_u/f64") } 'i64.trunc_f64_u' { Lexeme _ (TKeyword "i64.trunc_f64_u") }
'f32.convert_s/i32' { Lexeme _ (TKeyword "f32.convert_s/i32") } 'f32.convert_i32_s' { Lexeme _ (TKeyword "f32.convert_i32_s") }
'f32.convert_u/i32' { Lexeme _ (TKeyword "f32.convert_u/i32") } 'f32.convert_i32_u' { Lexeme _ (TKeyword "f32.convert_i32_u") }
'f32.convert_s/i64' { Lexeme _ (TKeyword "f32.convert_s/i64") } 'f32.convert_i64_s' { Lexeme _ (TKeyword "f32.convert_i64_s") }
'f32.convert_u/i64' { Lexeme _ (TKeyword "f32.convert_u/i64") } 'f32.convert_i64_u' { Lexeme _ (TKeyword "f32.convert_i64_u") }
'f32.demote/f64' { Lexeme _ (TKeyword "f32.demote/f64") } 'f32.demote_f64' { Lexeme _ (TKeyword "f32.demote_f64") }
'f64.convert_s/i32' { Lexeme _ (TKeyword "f64.convert_s/i32") } 'f64.convert_i32_s' { Lexeme _ (TKeyword "f64.convert_i32_s") }
'f64.convert_u/i32' { Lexeme _ (TKeyword "f64.convert_u/i32") } 'f64.convert_i32_u' { Lexeme _ (TKeyword "f64.convert_i32_u") }
'f64.convert_s/i64' { Lexeme _ (TKeyword "f64.convert_s/i64") } 'f64.convert_i64_s' { Lexeme _ (TKeyword "f64.convert_i64_s") }
'f64.convert_u/i64' { Lexeme _ (TKeyword "f64.convert_u/i64") } 'f64.convert_i64_u' { Lexeme _ (TKeyword "f64.convert_i64_u") }
'f64.promote/f32' { Lexeme _ (TKeyword "f64.promote/f32") } 'f64.promote_f32' { Lexeme _ (TKeyword "f64.promote_f32") }
'i32.reinterpret_f32' { Lexeme _ (TKeyword "i32.reinterpret_f32") } 'i32.reinterpret_f32' { Lexeme _ (TKeyword "i32.reinterpret_f32") }
'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") }
@@ -538,27 +538,27 @@ plaininstr :: { PlainInstr }
| 'f64.gt' { FRelOp BS64 FGt } | 'f64.gt' { FRelOp BS64 FGt }
| 'f64.le' { FRelOp BS64 FLe } | 'f64.le' { FRelOp BS64 FLe }
| 'f64.ge' { FRelOp BS64 FGe } | 'f64.ge' { FRelOp BS64 FGe }
| 'i32.wrap/i64' { I32WrapI64 } | 'i32.wrap_i64' { I32WrapI64 }
| 'i32.trunc_s/f32' { ITruncFS BS32 BS32 } | 'i32.trunc_f32_s' { ITruncFS BS32 BS32 }
| 'i32.trunc_u/f32' { ITruncFU BS32 BS32 } | 'i32.trunc_f32_u' { ITruncFU BS32 BS32 }
| 'i32.trunc_s/f64' { ITruncFS BS32 BS64 } | 'i32.trunc_f64_s' { ITruncFS BS32 BS64 }
| 'i32.trunc_u/f64' { ITruncFU BS32 BS64 } | 'i32.trunc_f64_u' { ITruncFU BS32 BS64 }
| 'i64.extend_s/i32' { I64ExtendSI32 } | 'i64.extend_i32_s' { I64ExtendSI32 }
| 'i64.extend_u/i32' { I64ExtendUI32 } | 'i64.extend_i32_u' { I64ExtendUI32 }
| 'i64.trunc_s/f32' { ITruncFS BS64 BS32 } | 'i64.trunc_f32_s' { ITruncFS BS64 BS32 }
| 'i64.trunc_u/f32' { ITruncFU BS64 BS32 } | 'i64.trunc_f32_u' { ITruncFU BS64 BS32 }
| 'i64.trunc_s/f64' { ITruncFS BS64 BS64 } | 'i64.trunc_f64_s' { ITruncFS BS64 BS64 }
| 'i64.trunc_u/f64' { ITruncFU BS64 BS64 } | 'i64.trunc_f64_u' { ITruncFU BS64 BS64 }
| 'f32.convert_s/i32' { FConvertIS BS32 BS32 } | 'f32.convert_i32_s' { FConvertIS BS32 BS32 }
| 'f32.convert_u/i32' { FConvertIU BS32 BS32 } | 'f32.convert_i32_u' { FConvertIU BS32 BS32 }
| 'f32.convert_s/i64' { FConvertIS BS32 BS64 } | 'f32.convert_i64_s' { FConvertIS BS32 BS64 }
| 'f32.convert_u/i64' { FConvertIU BS32 BS64 } | 'f32.convert_i64_u' { FConvertIU BS32 BS64 }
| 'f32.demote/f64' { F32DemoteF64 } | 'f32.demote_f64' { F32DemoteF64 }
| 'f64.convert_s/i32' { FConvertIS BS64 BS32 } | 'f64.convert_i32_s' { FConvertIS BS64 BS32 }
| 'f64.convert_u/i32' { FConvertIU BS64 BS32 } | 'f64.convert_i32_u' { FConvertIU BS64 BS32 }
| 'f64.convert_s/i64' { FConvertIS BS64 BS64 } | 'f64.convert_i64_s' { FConvertIS BS64 BS64 }
| 'f64.convert_u/i64' { FConvertIU BS64 BS64 } | 'f64.convert_i64_u' { FConvertIU BS64 BS64 }
| 'f64.promote/f32' { F64PromoteF32 } | 'f64.promote_f32' { F64PromoteF32 }
| 'i32.reinterpret_f32' { IReinterpretF BS32 } | 'i32.reinterpret_f32' { IReinterpretF BS32 }
| 'i64.reinterpret_f64' { IReinterpretF BS64 } | 'i64.reinterpret_f64' { IReinterpretF BS64 }
| 'f32.reinterpret_i32' { FReinterpretI BS32 } | 'f32.reinterpret_i32' { FReinterpretI BS32 }
@@ -646,10 +646,10 @@ raw_block :: { Maybe Ident -> Either String Instruction }
| '(' raw_block1 { $2 } | '(' raw_block1 { $2 }
raw_block1 :: { Maybe Ident -> Either String Instruction } raw_block1 :: { Maybe Ident -> Either String Instruction }
: 'result' valtype ')' list(instruction) 'end' opt(ident) { : 'result' list(valtype) ')' list(instruction) 'end' opt(ident) {
\ident -> \ident ->
if ident == $6 || isNothing $6 if ident == $6 || isNothing $6
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"
} }
| folded_instr1 list(instruction) 'end' opt(ident) { | folded_instr1 list(instruction) 'end' opt(ident) {
@@ -675,10 +675,10 @@ raw_loop :: { Maybe Ident -> Either String Instruction }
| '(' raw_loop1 { $2 } | '(' raw_loop1 { $2 }
raw_loop1 :: { Maybe Ident -> Either String Instruction } raw_loop1 :: { Maybe Ident -> Either String Instruction }
: 'result' valtype ')' list(instruction) 'end' opt(ident) { : 'result' list(valtype) ')' list(instruction) 'end' opt(ident) {
\ident -> \ident ->
if ident == $6 || isNothing $6 if ident == $6 || isNothing $6
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"
} }
| folded_instr1 list(instruction) 'end' opt(ident) { | folded_instr1 list(instruction) 'end' opt(ident) {
@@ -704,10 +704,10 @@ raw_if_result :: { Maybe Ident -> Either String [Instruction] }
| '(' raw_if_result1 { $2 } | '(' raw_if_result1 { $2 }
raw_if_result1 :: { Maybe Ident -> Either String [Instruction] } raw_if_result1 :: { Maybe Ident -> Either String [Instruction] }
: 'result' valtype ')' list(instruction) raw_else { : 'result' list(valtype) ')' list(instruction) raw_else {
\ident -> \ident ->
if ident == (snd $5) || isNothing (snd $5) if ident == (snd $5) || isNothing (snd $5)
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"
} }
| folded_instr1 list(instruction) raw_else { | folded_instr1 list(instruction) raw_else {
@@ -775,7 +775,7 @@ folded_block :: { Maybe Ident -> Instruction }
| raw_instr list(instruction) ')' { \ident -> BlockInstr ident [] ($1 ++ concat $2) } | raw_instr list(instruction) ')' { \ident -> BlockInstr ident [] ($1 ++ concat $2) }
folded_block1 :: { Maybe Ident -> Instruction } folded_block1 :: { Maybe Ident -> Instruction }
: 'result' valtype ')' list(instruction) ')' { \ident -> BlockInstr ident [$2] (concat $4) } : 'result' list(valtype) ')' list(instruction) ')' { \ident -> BlockInstr ident $2 (concat $4) }
| folded_instr1 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 }
@@ -784,14 +784,14 @@ folded_loop :: { Maybe Ident -> Instruction }
| raw_instr list(instruction) ')' { \ident -> LoopInstr ident [] ($1 ++ concat $2) } | raw_instr list(instruction) ')' { \ident -> LoopInstr ident [] ($1 ++ concat $2) }
folded_loop1 :: { Maybe Ident -> Instruction } folded_loop1 :: { Maybe Ident -> Instruction }
: 'result' valtype ')' list(instruction) ')' { \ident -> LoopInstr ident [$2] (concat $4) } : 'result' list(valtype) ')' list(instruction) ')' { \ident -> LoopInstr ident $2 (concat $4) }
| folded_instr1 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' list(valtype) ')' '(' folded_then_else {
\ident -> \ident ->
let (pred, (trueBranch, falseBranch)) = $5 in let (pred, (trueBranch, falseBranch)) = $5 in
pred ++ [IfInstr ident [$2] trueBranch falseBranch] pred ++ [IfInstr ident $2 trueBranch falseBranch]
} }
| folded_then_else { | folded_then_else {
\ident -> \ident ->
@@ -997,7 +997,7 @@ limits :: { Limit }
: u32 opt(u32) { Limit (fromIntegral $1) (fromIntegral `fmap` $2) } : u32 opt(u32) { Limit (fromIntegral $1) (fromIntegral `fmap` $2) }
elemtype :: { ElemType } elemtype :: { ElemType }
: 'anyfunc' { AnyFunc } : 'funcref' { FuncRef }
tabletype :: { TableType } tabletype :: { TableType }
: limits elemtype { TableType $1 $2 } : limits elemtype { TableType $1 $2 }
src/Language/Wasm/Script.hs
+4 -4
View File
@@ -161,11 +161,11 @@ runScript onAssertFail script = do
getFailureString Validate.ResultTypeDoesntMatch = ["type mismatch"] getFailureString Validate.ResultTypeDoesntMatch = ["type mismatch"]
getFailureString Validate.MoreThanOneMemory = ["multiple memories"] getFailureString Validate.MoreThanOneMemory = ["multiple memories"]
getFailureString Validate.MoreThanOneTable = ["multiple tables"] getFailureString Validate.MoreThanOneTable = ["multiple tables"]
getFailureString Validate.LocalIndexOutOfRange = ["unknown local"] getFailureString (Validate.LocalIndexOutOfRange idx) = ["unknown local", "unknown local " <> TL.pack (show idx)]
getFailureString Validate.MemoryIndexOutOfRange = ["unknown memory", "unknown memory 0"] getFailureString (Validate.MemoryIndexOutOfRange idx) = ["unknown memory", "unknown memory " <> TL.pack (show idx)]
getFailureString Validate.TableIndexOutOfRange = ["unknown table", "unknown table 0"] getFailureString (Validate.TableIndexOutOfRange idx) = ["unknown table", "unknown table " <> TL.pack (show idx)]
getFailureString Validate.FunctionIndexOutOfRange = ["unknown function", "unknown function 0"] getFailureString Validate.FunctionIndexOutOfRange = ["unknown function", "unknown function 0"]
getFailureString Validate.GlobalIndexOutOfRange = ["unknown global"] getFailureString (Validate.GlobalIndexOutOfRange idx) = ["unknown global", "unknown global " <> TL.pack (show idx)]
getFailureString Validate.LabelIndexOutOfRange = ["unknown label"] getFailureString Validate.LabelIndexOutOfRange = ["unknown label"]
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"]
src/Language/Wasm/Structure.hs
+1 -1
View File
@@ -192,7 +192,7 @@ data Function = Function {
data Limit = Limit Natural (Maybe Natural) deriving (Show, Eq, Generic, NFData) data Limit = Limit Natural (Maybe Natural) deriving (Show, Eq, Generic, NFData)
data ElemType = AnyFunc deriving (Show, Eq, Generic, NFData) data ElemType = FuncRef deriving (Show, Eq, Generic, NFData)
data TableType = TableType Limit ElemType deriving (Show, Eq, Generic, NFData) data TableType = TableType Limit ElemType deriving (Show, Eq, Generic, NFData)
src/Language/Wasm/Validate.hs
+19 -19
View File
@@ -34,10 +34,10 @@ data ValidationError =
| MoreThanOneMemory | MoreThanOneMemory
| MoreThanOneTable | MoreThanOneTable
| FunctionIndexOutOfRange | FunctionIndexOutOfRange
| TableIndexOutOfRange | TableIndexOutOfRange Natural
| MemoryIndexOutOfRange | MemoryIndexOutOfRange Natural
| LocalIndexOutOfRange | LocalIndexOutOfRange Natural
| GlobalIndexOutOfRange | GlobalIndexOutOfRange Natural
| LabelIndexOutOfRange | LabelIndexOutOfRange
| TypeIndexOutOfRange | TypeIndexOutOfRange
| ResultTypeDoesntMatch | ResultTypeDoesntMatch
@@ -183,7 +183,7 @@ checkMemoryInstr :: Int -> MemArg -> Checker ()
checkMemoryInstr size memarg = do checkMemoryInstr size memarg = do
isMemArgValid size memarg isMemArgValid size memarg
Ctx { mems } <- ask Ctx { mems } <- ask
if length mems < 1 then throwError MemoryIndexOutOfRange else return () if length mems < 1 then throwError (MemoryIndexOutOfRange 0) else return ()
getInstrType :: Instruction Natural -> Checker Arrow getInstrType :: Instruction Natural -> Checker Arrow
getInstrType Unreachable = return $ Any ==> Any getInstrType Unreachable = return $ Any ==> Any
@@ -228,7 +228,7 @@ getInstrType (Call fun) = do
getInstrType (CallIndirect sign) = do getInstrType (CallIndirect sign) = do
Ctx { types, tables } <- ask Ctx { types, tables } <- ask
if length tables < 1 if length tables < 1
then throwError TableIndexOutOfRange then throwError (TableIndexOutOfRange 0)
else do else do
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
@@ -240,23 +240,23 @@ getInstrType Select = do
return $ [var, var, Val I32] ==> var return $ [var, var, Val I32] ==> var
getInstrType (GetLocal local) = do getInstrType (GetLocal local) = do
Ctx { locals } <- ask Ctx { locals } <- ask
t <- maybeToEither LocalIndexOutOfRange $ locals !? local t <- maybeToEither (LocalIndexOutOfRange local) $ locals !? local
return $ empty ==> Val t return $ empty ==> Val t
getInstrType (SetLocal local) = do getInstrType (SetLocal local) = do
Ctx { locals } <- ask Ctx { locals } <- ask
t <- maybeToEither LocalIndexOutOfRange $ locals !? local t <- maybeToEither (LocalIndexOutOfRange local) $ locals !? local
return $ Val t ==> empty return $ Val t ==> empty
getInstrType (TeeLocal local) = do getInstrType (TeeLocal local) = do
Ctx { locals } <- ask Ctx { locals } <- ask
t <- maybeToEither LocalIndexOutOfRange $ locals !? local t <- maybeToEither (LocalIndexOutOfRange local) $ locals !? local
return $ Val t ==> Val t return $ Val t ==> Val t
getInstrType (GetGlobal global) = do getInstrType (GetGlobal global) = do
Ctx { globals } <- ask Ctx { globals } <- ask
t <- maybeToEither GlobalIndexOutOfRange $ asType <$> globals !? global t <- maybeToEither (GlobalIndexOutOfRange global) $ asType <$> globals !? global
return $ empty ==> t return $ empty ==> t
getInstrType (SetGlobal global) = do getInstrType (SetGlobal global) = do
Ctx { globals } <- ask Ctx { globals } <- ask
t <- maybeToEither GlobalIndexOutOfRange $ asType <$> globals !? global t <- maybeToEither (GlobalIndexOutOfRange global) $ asType <$> globals !? global
shouldBeMut $ globals !! fromIntegral global shouldBeMut $ globals !! fromIntegral global
return $ t ==> empty return $ t ==> empty
getInstrType (I32Load memarg) = do getInstrType (I32Load memarg) = do
@@ -330,10 +330,10 @@ getInstrType (I64Store32 memarg) = do
return $ [I32, I64] ==> empty return $ [I32, I64] ==> empty
getInstrType CurrentMemory = do getInstrType CurrentMemory = do
Ctx { mems } <- ask Ctx { mems } <- ask
if length mems < 1 then throwError MemoryIndexOutOfRange else return $ empty ==> I32 if length mems < 1 then throwError (MemoryIndexOutOfRange 0) else return $ empty ==> I32
getInstrType GrowMemory = do getInstrType GrowMemory = do
Ctx { mems } <- ask Ctx { mems } <- ask
if length mems < 1 then throwError MemoryIndexOutOfRange else return $ I32 ==> I32 if length mems < 1 then throwError (MemoryIndexOutOfRange 0) else return $ I32 ==> I32
getInstrType (I32Const _) = return $ empty ==> I32 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
@@ -414,7 +414,7 @@ isConstExpression ((F64Const _):rest) = isConstExpression rest
isConstExpression ((GetGlobal idx):rest) = do isConstExpression ((GetGlobal idx):rest) = do
Ctx {globals, importedGlobals} <- ask Ctx {globals, importedGlobals} <- ask
if importedGlobals <= idx if importedGlobals <= idx
then throwError GlobalIndexOutOfRange then throwError (GlobalIndexOutOfRange idx)
else return () else return ()
case globals !! fromIntegral idx of case globals !! fromIntegral idx of
Const _ -> isConstExpression rest Const _ -> isConstExpression rest
@@ -539,7 +539,7 @@ elemsShouldBeValid m@Module { elems, functions, tables, imports } =
let isTableIndexValid = let isTableIndexValid =
if tableIdx < (fromIntegral $ length tableImports + length tables) if tableIdx < (fromIntegral $ length tableImports + length tables)
then return () then return ()
else Left TableIndexOutOfRange else Left (TableIndexOutOfRange tableIdx)
in in
let funImports = filter isFuncImport imports in let funImports = filter isFuncImport imports in
let funsLength = fromIntegral $ length functions + length funImports in let funsLength = fromIntegral $ length functions + length funImports in
@@ -563,7 +563,7 @@ datasShouldBeValid m@Module { datas, mems, imports } =
let memImports = filter isMemImport imports in let memImports = filter isMemImport imports in
if memIdx < (fromIntegral $ length memImports + length mems) if memIdx < (fromIntegral $ length memImports + length mems)
then check then check
else Left MemoryIndexOutOfRange else Left (MemoryIndexOutOfRange memIdx)
startShouldBeValid :: Validator startShouldBeValid :: Validator
startShouldBeValid Module { start = Nothing } = return () startShouldBeValid Module { start = Nothing } = return ()
@@ -587,9 +587,9 @@ exportsShouldBeValid Module { exports, imports, functions, mems, tables, globals
isExportValid (Export _ (ExportFunc funIdx)) = isExportValid (Export _ (ExportFunc funIdx)) =
if fromIntegral funIdx < length funcImports + length functions then return () else Left FunctionIndexOutOfRange if fromIntegral funIdx < length funcImports + length functions then return () else Left FunctionIndexOutOfRange
isExportValid (Export _ (ExportTable tableIdx)) = isExportValid (Export _ (ExportTable tableIdx)) =
if fromIntegral tableIdx < length tableImports + length tables then return () else Left TableIndexOutOfRange if fromIntegral tableIdx < length tableImports + length tables then return () else Left (TableIndexOutOfRange tableIdx)
isExportValid (Export _ (ExportMemory memIdx)) = isExportValid (Export _ (ExportMemory memIdx)) =
if fromIntegral memIdx < length memImports + length mems then return () else Left MemoryIndexOutOfRange if fromIntegral memIdx < length memImports + length mems then return () else Left (MemoryIndexOutOfRange memIdx)
isExportValid (Export _ (ExportGlobal globalIdx)) = isExportValid (Export _ (ExportGlobal globalIdx)) =
if fromIntegral globalIdx < length globalImports + length globals if fromIntegral globalIdx < length globalImports + length globals
then ( then (
@@ -601,7 +601,7 @@ exportsShouldBeValid Module { exports, imports, functions, mems, tables, globals
) )
else return () else return ()
) )
else Left GlobalIndexOutOfRange else Left (GlobalIndexOutOfRange globalIdx)
areExportNamesUnique :: ValidationResult areExportNamesUnique :: ValidationResult
areExportNamesUnique = areExportNamesUnique =