msyds/haskell-wasm
1
0
Fork 0
forked from GitHub/haskell-wasm
Code Pull Requests Activity

more grammar fixes

Browse Source
This commit is contained in:
Ilya Rezvov
2021-03-04 22:04:56 -08:00
parent 89df0e43d6
commit 40291c35f0
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 }
instance Serialize ElemType where
put AnyFunc = putWord8 0x70
get = byteGuard 0x70 >> return AnyFunc
put FuncRef = putWord8 0x70
get = byteGuard 0x70 >> return FuncRef
instance Serialize Limit where
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 mod name min max = do
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
@@ -968,7 +968,7 @@ newtype Tbl = Tbl Natural deriving (Show, Eq)
table :: Natural -> Maybe Natural -> GenMod Tbl
table min max = do
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
src/Language/Wasm/Interpreter.hs
+1 -1
View File
@@ -279,7 +279,7 @@ makeHostModule st items = do
makeHostTables :: (Store, ModuleInstance) -> IO (Store, ModuleInstance)
makeHostTables (st, inst) = do
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 exps = Vector.fromList $ zipWith (\name i -> ExportInstance name (ExternTable i)) names [tableLen..]
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 nan }
<0> "nan:canonical" { constToken $ TFloatLit $ BinRep nan }
<0> "nan:arithmetic" { constToken $ TFloatLit $ BinRep nan }
<0> $sign? @nanhex { parseNanSigned }
<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") }
'f64' { Lexeme _ (TKeyword "f64") }
'mut' { Lexeme _ (TKeyword "mut") }
'anyfunc' { Lexeme _ (TKeyword "anyfunc") }
'funcref' { Lexeme _ (TKeyword "funcref") }
'type' { Lexeme _ (TKeyword "type") }
'unreachable' { Lexeme _ (TKeyword "unreachable") }
'nop' { Lexeme _ (TKeyword "nop") }
@@ -260,27 +260,27 @@ import Language.Wasm.Lexer (
'f64.gt' { Lexeme _ (TKeyword "f64.gt") }
'f64.le' { Lexeme _ (TKeyword "f64.le") }
'f64.ge' { Lexeme _ (TKeyword "f64.ge") }
'i32.wrap/i64' { Lexeme _ (TKeyword "i32.wrap/i64") }
'i32.trunc_s/f32' { Lexeme _ (TKeyword "i32.trunc_s/f32") }
'i32.trunc_u/f32' { Lexeme _ (TKeyword "i32.trunc_u/f32") }
'i32.trunc_s/f64' { Lexeme _ (TKeyword "i32.trunc_s/f64") }
'i32.trunc_u/f64' { Lexeme _ (TKeyword "i32.trunc_u/f64") }
'i64.extend_s/i32' { Lexeme _ (TKeyword "i64.extend_s/i32") }
'i64.extend_u/i32' { Lexeme _ (TKeyword "i64.extend_u/i32") }
'i64.trunc_s/f32' { Lexeme _ (TKeyword "i64.trunc_s/f32") }
'i64.trunc_u/f32' { Lexeme _ (TKeyword "i64.trunc_u/f32") }
'i64.trunc_s/f64' { Lexeme _ (TKeyword "i64.trunc_s/f64") }
'i64.trunc_u/f64' { Lexeme _ (TKeyword "i64.trunc_u/f64") }
'f32.convert_s/i32' { Lexeme _ (TKeyword "f32.convert_s/i32") }
'f32.convert_u/i32' { Lexeme _ (TKeyword "f32.convert_u/i32") }
'f32.convert_s/i64' { Lexeme _ (TKeyword "f32.convert_s/i64") }
'f32.convert_u/i64' { Lexeme _ (TKeyword "f32.convert_u/i64") }
'f32.demote/f64' { Lexeme _ (TKeyword "f32.demote/f64") }
'f64.convert_s/i32' { Lexeme _ (TKeyword "f64.convert_s/i32") }
'f64.convert_u/i32' { Lexeme _ (TKeyword "f64.convert_u/i32") }
'f64.convert_s/i64' { Lexeme _ (TKeyword "f64.convert_s/i64") }
'f64.convert_u/i64' { Lexeme _ (TKeyword "f64.convert_u/i64") }
'f64.promote/f32' { Lexeme _ (TKeyword "f64.promote/f32") }
'i32.wrap_i64' { Lexeme _ (TKeyword "i32.wrap_i64") }
'i32.trunc_f32_s' { Lexeme _ (TKeyword "i32.trunc_f32_s") }
'i32.trunc_f32_u' { Lexeme _ (TKeyword "i32.trunc_f32_u") }
'i32.trunc_f64_s' { Lexeme _ (TKeyword "i32.trunc_f64_s") }
'i32.trunc_f64_u' { Lexeme _ (TKeyword "i32.trunc_f64_u") }
'i64.extend_i32_s' { Lexeme _ (TKeyword "i64.extend_i32_s") }
'i64.extend_i32_u' { Lexeme _ (TKeyword "i64.extend_i32_u") }
'i64.trunc_f32_s' { Lexeme _ (TKeyword "i64.trunc_f32_s") }
'i64.trunc_f32_u' { Lexeme _ (TKeyword "i64.trunc_f32_u") }
'i64.trunc_f64_s' { Lexeme _ (TKeyword "i64.trunc_f64_s") }
'i64.trunc_f64_u' { Lexeme _ (TKeyword "i64.trunc_f64_u") }
'f32.convert_i32_s' { Lexeme _ (TKeyword "f32.convert_i32_s") }
'f32.convert_i32_u' { Lexeme _ (TKeyword "f32.convert_i32_u") }
'f32.convert_i64_s' { Lexeme _ (TKeyword "f32.convert_i64_s") }
'f32.convert_i64_u' { Lexeme _ (TKeyword "f32.convert_i64_u") }
'f32.demote_f64' { Lexeme _ (TKeyword "f32.demote_f64") }
'f64.convert_i32_s' { Lexeme _ (TKeyword "f64.convert_i32_s") }
'f64.convert_i32_u' { Lexeme _ (TKeyword "f64.convert_i32_u") }
'f64.convert_i64_s' { Lexeme _ (TKeyword "f64.convert_i64_s") }
'f64.convert_i64_u' { Lexeme _ (TKeyword "f64.convert_i64_u") }
'f64.promote_f32' { Lexeme _ (TKeyword "f64.promote_f32") }
'i32.reinterpret_f32' { Lexeme _ (TKeyword "i32.reinterpret_f32") }
'i64.reinterpret_f64' { Lexeme _ (TKeyword "i64.reinterpret_f64") }
'f32.reinterpret_i32' { Lexeme _ (TKeyword "f32.reinterpret_i32") }
@@ -538,27 +538,27 @@ plaininstr :: { PlainInstr }
| 'f64.gt' { FRelOp BS64 FGt }
| 'f64.le' { FRelOp BS64 FLe }
| 'f64.ge' { FRelOp BS64 FGe }
| 'i32.wrap/i64' { I32WrapI64 }
| 'i32.trunc_s/f32' { ITruncFS BS32 BS32 }
| 'i32.trunc_u/f32' { ITruncFU BS32 BS32 }
| 'i32.trunc_s/f64' { ITruncFS BS32 BS64 }
| 'i32.trunc_u/f64' { ITruncFU BS32 BS64 }
| 'i64.extend_s/i32' { I64ExtendSI32 }
| 'i64.extend_u/i32' { I64ExtendUI32 }
| 'i64.trunc_s/f32' { ITruncFS BS64 BS32 }
| 'i64.trunc_u/f32' { ITruncFU BS64 BS32 }
| 'i64.trunc_s/f64' { ITruncFS BS64 BS64 }
| 'i64.trunc_u/f64' { ITruncFU BS64 BS64 }
| 'f32.convert_s/i32' { FConvertIS BS32 BS32 }
| 'f32.convert_u/i32' { FConvertIU BS32 BS32 }
| 'f32.convert_s/i64' { FConvertIS BS32 BS64 }
| 'f32.convert_u/i64' { FConvertIU BS32 BS64 }
| 'f32.demote/f64' { F32DemoteF64 }
| 'f64.convert_s/i32' { FConvertIS BS64 BS32 }
| 'f64.convert_u/i32' { FConvertIU BS64 BS32 }
| 'f64.convert_s/i64' { FConvertIS BS64 BS64 }
| 'f64.convert_u/i64' { FConvertIU BS64 BS64 }
| 'f64.promote/f32' { F64PromoteF32 }
| 'i32.wrap_i64' { I32WrapI64 }
| 'i32.trunc_f32_s' { ITruncFS BS32 BS32 }
| 'i32.trunc_f32_u' { ITruncFU BS32 BS32 }
| 'i32.trunc_f64_s' { ITruncFS BS32 BS64 }
| 'i32.trunc_f64_u' { ITruncFU BS32 BS64 }
| 'i64.extend_i32_s' { I64ExtendSI32 }
| 'i64.extend_i32_u' { I64ExtendUI32 }
| 'i64.trunc_f32_s' { ITruncFS BS64 BS32 }
| 'i64.trunc_f32_u' { ITruncFU BS64 BS32 }
| 'i64.trunc_f64_s' { ITruncFS BS64 BS64 }
| 'i64.trunc_f64_u' { ITruncFU BS64 BS64 }
| 'f32.convert_i32_s' { FConvertIS BS32 BS32 }
| 'f32.convert_i32_u' { FConvertIU BS32 BS32 }
| 'f32.convert_i64_s' { FConvertIS BS32 BS64 }
| 'f32.convert_i64_u' { FConvertIU BS32 BS64 }
| 'f32.demote_f64' { F32DemoteF64 }
| 'f64.convert_i32_s' { FConvertIS BS64 BS32 }
| 'f64.convert_i32_u' { FConvertIU BS64 BS32 }
| 'f64.convert_i64_s' { FConvertIS BS64 BS64 }
| 'f64.convert_i64_u' { FConvertIU BS64 BS64 }
| 'f64.promote_f32' { F64PromoteF32 }
| 'i32.reinterpret_f32' { IReinterpretF BS32 }
| 'i64.reinterpret_f64' { IReinterpretF BS64 }
| 'f32.reinterpret_i32' { FReinterpretI BS32 }
@@ -646,10 +646,10 @@ raw_block :: { Maybe Ident -> Either String Instruction }
| '(' raw_block1 { $2 }
raw_block1 :: { Maybe Ident -> Either String Instruction }
: 'result' valtype ')' list(instruction) 'end' opt(ident) {
: 'result' list(valtype) ')' list(instruction) 'end' opt(ident) {
\ident ->
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"
}
| folded_instr1 list(instruction) 'end' opt(ident) {
@@ -675,10 +675,10 @@ raw_loop :: { Maybe Ident -> Either String Instruction }
| '(' raw_loop1 { $2 }
raw_loop1 :: { Maybe Ident -> Either String Instruction }
: 'result' valtype ')' list(instruction) 'end' opt(ident) {
: 'result' list(valtype) ')' list(instruction) 'end' opt(ident) {
\ident ->
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"
}
| 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 :: { Maybe Ident -> Either String [Instruction] }
: 'result' valtype ')' list(instruction) raw_else {
: 'result' list(valtype) ')' list(instruction) raw_else {
\ident ->
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"
}
| 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) }
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_loop :: { Maybe Ident -> Instruction }
@@ -784,14 +784,14 @@ folded_loop :: { Maybe Ident -> Instruction }
| raw_instr list(instruction) ')' { \ident -> LoopInstr ident [] ($1 ++ concat $2) }
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_if_result :: { Maybe Ident -> [Instruction] }
: 'result' valtype ')' '(' folded_then_else {
: 'result' list(valtype) ')' '(' folded_then_else {
\ident ->
let (pred, (trueBranch, falseBranch)) = $5 in
pred ++ [IfInstr ident [$2] trueBranch falseBranch]
pred ++ [IfInstr ident $2 trueBranch falseBranch]
}
| folded_then_else {
\ident ->
@@ -997,7 +997,7 @@ limits :: { Limit }
: u32 opt(u32) { Limit (fromIntegral $1) (fromIntegral `fmap` $2) }
elemtype :: { ElemType }
: 'anyfunc' { AnyFunc }
: 'funcref' { FuncRef }
tabletype :: { TableType }
: 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.MoreThanOneMemory = ["multiple memories"]
getFailureString Validate.MoreThanOneTable = ["multiple tables"]
getFailureString Validate.LocalIndexOutOfRange = ["unknown local"]
getFailureString Validate.MemoryIndexOutOfRange = ["unknown memory", "unknown memory 0"]
getFailureString Validate.TableIndexOutOfRange = ["unknown table", "unknown table 0"]
getFailureString (Validate.LocalIndexOutOfRange idx) = ["unknown local", "unknown local " <> TL.pack (show idx)]
getFailureString (Validate.MemoryIndexOutOfRange idx) = ["unknown memory", "unknown memory " <> TL.pack (show idx)]
getFailureString (Validate.TableIndexOutOfRange idx) = ["unknown table", "unknown table " <> TL.pack (show idx)]
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.TypeIndexOutOfRange = ["unknown type"]
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 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)
src/Language/Wasm/Validate.hs
+19 -19
View File
@@ -34,10 +34,10 @@ data ValidationError =
| MoreThanOneMemory
| MoreThanOneTable
| FunctionIndexOutOfRange
| TableIndexOutOfRange
| MemoryIndexOutOfRange
| LocalIndexOutOfRange
| GlobalIndexOutOfRange
| TableIndexOutOfRange Natural
| MemoryIndexOutOfRange Natural
| LocalIndexOutOfRange Natural
| GlobalIndexOutOfRange Natural
| LabelIndexOutOfRange
| TypeIndexOutOfRange
| ResultTypeDoesntMatch
@@ -183,7 +183,7 @@ checkMemoryInstr :: Int -> MemArg -> Checker ()
checkMemoryInstr size memarg = do
isMemArgValid size memarg
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 Unreachable = return $ Any ==> Any
@@ -228,7 +228,7 @@ getInstrType (Call fun) = do
getInstrType (CallIndirect sign) = do
Ctx { types, tables } <- ask
if length tables < 1
then throwError TableIndexOutOfRange
then throwError (TableIndexOutOfRange 0)
else do
Arrow from to <- maybeToEither TypeIndexOutOfRange $ asArrow <$> types !? sign
return $ (from ++ [Val I32]) ==> to
@@ -240,23 +240,23 @@ getInstrType Select = do
return $ [var, var, Val I32] ==> var
getInstrType (GetLocal local) = do
Ctx { locals } <- ask
t <- maybeToEither LocalIndexOutOfRange $ locals !? local
t <- maybeToEither (LocalIndexOutOfRange local) $ locals !? local
return $ empty ==> Val t
getInstrType (SetLocal local) = do
Ctx { locals } <- ask
t <- maybeToEither LocalIndexOutOfRange $ locals !? local
t <- maybeToEither (LocalIndexOutOfRange local) $ locals !? local
return $ Val t ==> empty
getInstrType (TeeLocal local) = do
Ctx { locals } <- ask
t <- maybeToEither LocalIndexOutOfRange $ locals !? local
t <- maybeToEither (LocalIndexOutOfRange local) $ locals !? local
return $ Val t ==> Val t
getInstrType (GetGlobal global) = do
Ctx { globals } <- ask
t <- maybeToEither GlobalIndexOutOfRange $ asType <$> globals !? global
t <- maybeToEither (GlobalIndexOutOfRange global) $ asType <$> globals !? global
return $ empty ==> t
getInstrType (SetGlobal global) = do
Ctx { globals } <- ask
t <- maybeToEither GlobalIndexOutOfRange $ asType <$> globals !? global
t <- maybeToEither (GlobalIndexOutOfRange global) $ asType <$> globals !? global
shouldBeMut $ globals !! fromIntegral global
return $ t ==> empty
getInstrType (I32Load memarg) = do
@@ -330,10 +330,10 @@ getInstrType (I64Store32 memarg) = do
return $ [I32, I64] ==> empty
getInstrType CurrentMemory = do
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
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 (I64Const _) = return $ empty ==> I64
getInstrType (F32Const _) = return $ empty ==> F32
@@ -414,7 +414,7 @@ isConstExpression ((F64Const _):rest) = isConstExpression rest
isConstExpression ((GetGlobal idx):rest) = do
Ctx {globals, importedGlobals} <- ask
if importedGlobals <= idx
then throwError GlobalIndexOutOfRange
then throwError (GlobalIndexOutOfRange idx)
else return ()
case globals !! fromIntegral idx of
Const _ -> isConstExpression rest
@@ -539,7 +539,7 @@ elemsShouldBeValid m@Module { elems, functions, tables, imports } =
let isTableIndexValid =
if tableIdx < (fromIntegral $ length tableImports + length tables)
then return ()
else Left TableIndexOutOfRange
else Left (TableIndexOutOfRange tableIdx)
in
let funImports = filter isFuncImport imports 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
if memIdx < (fromIntegral $ length memImports + length mems)
then check
else Left MemoryIndexOutOfRange
else Left (MemoryIndexOutOfRange memIdx)
startShouldBeValid :: Validator
startShouldBeValid Module { start = Nothing } = return ()
@@ -587,9 +587,9 @@ exportsShouldBeValid Module { exports, imports, functions, mems, tables, globals
isExportValid (Export _ (ExportFunc funIdx)) =
if fromIntegral funIdx < length funcImports + length functions then return () else Left FunctionIndexOutOfRange
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)) =
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)) =
if fromIntegral globalIdx < length globalImports + length globals
then (
@@ -601,7 +601,7 @@ exportsShouldBeValid Module { exports, imports, functions, mems, tables, globals
)
else return ()
)
else Left GlobalIndexOutOfRange
else Left (GlobalIndexOutOfRange globalIdx)
areExportNamesUnique :: ValidationResult
areExportNamesUnique =