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

parse plain control instructions

Browse Source
This commit is contained in:
Ilya Rezvov
2018-01-20 11:19:37 -08:00
parent 0379522b55
commit 84b4e21df5
1 changed files with 64 additions and 2 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Language/Wasm/Parser.y
+64 -2
View File
@@ -43,13 +43,22 @@ import Language.Wasm.Lexer (
'f64' { TKeyword "f64" } 'f64' { TKeyword "f64" }
'mut' { TKeyword "mut" } 'mut' { TKeyword "mut" }
'anyfunc' { TKeyword "anyfunc" } 'anyfunc' { TKeyword "anyfunc" }
'type' { TKeyword "type" }
'unreachable' { TKeyword "unreachable" }
'nop' { TKeyword "nop" }
'br' { TKeyword "br" }
'br_if' { TKeyword "br_if" }
'br_table' { TKeyword "br_table" }
'return' { TKeyword "return" }
'call' { TKeyword "call" }
'call_indirect' { TKeyword "call_indirect" }
id { TId $$ } id { TId $$ }
u32 { TIntLit (asUInt32 -> Just $$) } u32 { TIntLit (asUInt32 -> Just $$) }
%% %%
functype :: { FuncType } functype :: { FuncType }
: '(' 'func' paramtypes resulttypes ')' { FunctType $3 $4 } : '(' 'func' paramtypes resulttypes ')' { FuncType $3 $4 }
paramtypes :: { [ParamType] } paramtypes :: { [ParamType] }
: list(paramtype) { concat $1 } : list(paramtype) { concat $1 }
@@ -87,6 +96,33 @@ globaltype :: { GlobalType }
: valtype { Const $1 } : valtype { Const $1 }
| '(' 'mut' valtype ')' { Mut $3 } | '(' 'mut' valtype ')' { Mut $3 }
labelidx :: { LabelIndex }
: u32 { $1 }
funcidx :: { FuncIndex }
: u32 { $1 }
typeidx :: { TypeIndex }
: u32 { $1 }
plaininstr :: { PlainInstr }
: 'unreachable' { Unreachable }
| 'nop' { Nop }
| 'br' labelidx { Br $2 }
| 'br_if' labelidx { BrIf $2 }
| 'br_table' rev_list1(labelidx) { BrTable (reverse $ tail $2) (head $2) }
| 'return' { Return }
| 'call' funcidx { Call $2 }
| 'call_indirect' typeuse { CallIndirect $2 }
typedef :: { TypeDef }
: '(' 'type' opt(ident) functype ')' { TypeDef $3 $4 }
typeuse :: { TypeUse }
: '(' 'type' typeidx ')' { IndexedTypeUse $3 Nothing }
| '(' 'type' typeidx paramtypes resulttypes ')' { IndexedTypeUse $3 (Just $ FuncType $4 $5) }
| paramtypes resulttypes { AnonimousTypeUse $ FuncType $1 $2 }
-- utils -- utils
rev_list(p) rev_list(p)
@@ -103,6 +139,10 @@ list(p)
list1(p) list1(p)
: rev_list1(p) { reverse $1 } : rev_list1(p) { reverse $1 }
opt(p)
: p { Just $1 }
| { Nothing }
{ {
asUInt32 :: Integer -> Maybe Natural asUInt32 :: Integer -> Maybe Natural
@@ -117,7 +157,7 @@ data ValueType =
| F64 | F64
deriving (Show, Eq) deriving (Show, Eq)
data FuncType = FunctType { data FuncType = FuncType {
params :: [ParamType], params :: [ParamType],
results :: [ValueType] results :: [ValueType]
} deriving (Show, Eq) } deriving (Show, Eq)
@@ -137,6 +177,28 @@ data ElemType = AnyFunc deriving (Show, Eq)
data TableType = TableType Limit ElemType deriving (Show, Eq) data TableType = TableType Limit ElemType deriving (Show, Eq)
type LabelIndex = Natural
type FuncIndex = Natural
type TypeIndex = Natural
data PlainInstr =
Unreachable
| Nop
| Br LabelIndex
| BrIf LabelIndex
| BrTable [LabelIndex] LabelIndex
| Return
| Call FuncIndex
| CallIndirect TypeUse
deriving (Show, Eq)
data TypeDef = TypeDef (Maybe Ident) FuncType deriving (Show, Eq)
data TypeUse =
IndexedTypeUse TypeIndex (Maybe FuncType)
| AnonimousTypeUse FuncType
deriving (Show, Eq)
happyError tokens = error $ "Error occuried: " ++ show tokens happyError tokens = error $ "Error occuried: " ++ show tokens
} }