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

support inline imports in function definitions

Browse Source
This commit is contained in:
Ilya Rezvov
2018-01-22 13:05:00 -08:00
parent 058962a831
commit fb58259ab2
2 changed files with 73 additions and 108 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Language/Wasm/Parser.y
+45 -21
View File
@@ -14,6 +14,7 @@ import qualified Data.Text.Lazy.Read as TLRead
import qualified Data.ByteString.Lazy as LBS
import Data.Maybe (fromMaybe)
import Data.List (foldl')
import Numeric.Natural (Natural)
@@ -497,19 +498,20 @@ plaininstr :: { PlainInstr }
| 'f64.reinterpret/i64' { F64ReinterpretI64 }
typedef :: { TypeDef }
: '(' 'type' opt(ident) functype ')' { TypeDef $3 $4 }
: 'type' opt(ident) functype ')' { TypeDef $2 $3 }
-- TODO: it does not properly handle call_indirect instruction use. it expects to be last expression before common ')'
typeuse :: { TypeUse }
: '(' typeuse1 { $2 }
| {- empty -} { AnonimousTypeUse $ FuncType [] [] }
typeuse1 :: { TypeUse }
: 'type' typeidx typedtypeuse { IndexedTypeUse $2 $3 }
: 'type' typeidx ')' typedtypeuse { IndexedTypeUse $2 $4 }
| paramsresultstypeuse { AnonimousTypeUse $1 }
typedtypeuse :: { Maybe FuncType }
: ')' { Nothing }
| '(' paramsresultstypeuse { Just $2 }
: '(' paramsresultstypeuse { Just $2 }
| {- empty -} { Nothing }
paramsresultstypeuse :: { FuncType }
: paramsresultstypeuse '(' paramsresulttypeuse { mergeFuncType $1 $3 }
@@ -561,10 +563,10 @@ importdesc :: { ImportDesc }
| '(' 'global' opt(ident) globaltype ')' { ImportGlobal $3 $4 }
import :: { Import }
: '(' 'import' name name importdesc ')' { Import $3 $4 $5 }
| '(' 'func' opt(ident) '(' 'import' name name ')' typeuse ')' { Import $6 $7 $ ImportFunc $3 $9 }
| '(' 'global' opt(ident) '(' 'import' name name ')' globaltype ')' { Import $6 $7 $ ImportGlobal $3 $9 }
| '(' 'memory' opt(ident) '(' 'import' name name ')' limits ')' { Import $6 $7 $ ImportMemory $3 $9 }
: 'import' name name importdesc ')' { Import $2 $3 $4 }
--| '(' 'func' opt(ident) '(' 'import' name name ')' typeuse ')' { Import $6 $7 $ ImportFunc $3 $9 }
--| '(' 'global' opt(ident) '(' 'import' name name ')' globaltype ')' { Import $6 $7 $ ImportGlobal $3 $9 }
--| '(' 'memory' opt(ident) '(' 'import' name name ')' limits ')' { Import $6 $7 $ ImportMemory $3 $9 }
localtypes :: { [LocalType] }
: list(localtype) { concat $1 }
@@ -574,8 +576,16 @@ localtype :: { [LocalType] }
| '(' 'local' list(valtype) ')' { map (LocalType Nothing) $3 }
-- FUNCTION --
function :: { Function }
: '(' 'func' opt(ident) typeuse_locals_body { Function $3 (t3fst $4) (t3snd $4) (t3thd $4) }
function :: { [ModuleField] }
: 'func' opt(ident) import_typeuse_locals_body { [appendIdent $2 $3] }
import_typeuse_locals_body :: { ModuleField }
: '(' import_typeuse_locals_body1 { $2 }
| ')' { MFFunc $ Function Nothing (AnonimousTypeUse $ FuncType [] []) [] [] }
import_typeuse_locals_body1 :: { ModuleField }
: 'import' name name ')' typeuse ')' { MFImport $ Import $2 $3 $ ImportFunc Nothing $5 }
| typeuse_locals_body1 { MFFunc $ Function Nothing (t3fst $1) (t3snd $1) (t3thd $1) }
typeuse_locals_body :: { (TypeUse, [LocalType], [Instruction]) }
: '(' typeuse_locals_body1 { $2 }
@@ -610,13 +620,13 @@ locals_body1 :: { ([LocalType], [Instruction]) }
-- FUNCTION END --
global :: { Global }
: '(' 'global' opt(ident) globaltype list(foldedinstr) ')' { Global $3 $4 (concat $5) }
: 'global' opt(ident) globaltype list(foldedinstr) ')' { Global $2 $3 (concat $4) }
memory :: { Memory }
: '(' 'memory' opt(ident) limits ')' { Memory $3 $4 }
: 'memory' opt(ident) limits ')' { Memory $2 $3 }
table :: { Table }
: '(' 'table' opt(ident) tabletype ')' { Table $3 $4 }
: 'table' opt(ident) tabletype ')' { Table $2 $3 }
exportdesc :: { ExportDesc }
: '(' 'func' funcidx ')' { ExportFunc $3 }
@@ -625,10 +635,10 @@ exportdesc :: { ExportDesc }
| '(' 'global' globalidx ')' { ExportGlobal $3 }
export :: { Export }
: '(' 'export' name exportdesc ')' { Export $3 $4 }
: 'export' name exportdesc ')' { Export $2 $3 }
start :: { StartFunction }
: '(' 'start' funcidx ')' { StartFunction $3 }
: 'start' funcidx ')' { StartFunction $2 }
-- TODO: Spec from 09 Jan 2018 declares 'offset' keyword as mandatory,
-- but collection of testcases omits 'offset' in this position
@@ -638,15 +648,14 @@ offsetexpr :: { [Instruction] }
| foldedinstr { $1 }
elemsegment :: { ElemSegment }
: '(' 'elem' opt(tableidx) offsetexpr list(funcidx) ')' { ElemSegment (fromMaybe (Index 0) $3) $4 $5 }
: 'elem' opt(tableidx) offsetexpr list(funcidx) ')' { ElemSegment (fromMaybe (Index 0) $2) $3 $4 }
datasegment :: { DataSegment }
: '(' 'data' opt(memidx) offsetexpr list(string) ')' { DataSegment (fromMaybe (Index 0) $3) $4 (TL.concat $5) }
: 'data' opt(memidx) offsetexpr list(string) ')' { DataSegment (fromMaybe (Index 0) $2) $3 (TL.concat $4) }
modulefield :: { ModuleField }
modulefield1_single :: { ModuleField }
: typedef { MFType $1 }
| import { MFImport $1 }
| function { MFFunc $1 }
| table { MFTable $1 }
| memory { MFMem $1 }
| global { MFGlobal $1 }
@@ -655,9 +664,19 @@ modulefield :: { ModuleField }
| elemsegment { MFElem $1 }
| datasegment { MFData $1 }
modulefield1_multi :: { [ModuleField] }
: function { $1 }
modulefield1 :: { [ModuleField] }
: modulefield1_single { [$1] }
| modulefield1_multi { $1 }
modulefield :: { [ModuleField] }
: '(' modulefield1 { $2 }
modulefields :: { Module }
: modulefields modulefield { appendModuleField $2 $1 }
| { emptyModule }
: modulefields modulefield { foldl' (flip appendModuleField) $1 $2 }
| {- empty -} { emptyModule }
mod :: { Module }
: '(' 'module' modulefields ')' { reverseModuleFields $3 }
@@ -694,6 +713,11 @@ t3snd (_, a, _) = a
t3thd :: (a, b, c) -> c
t3thd (_, _, a) = a
appendIdent :: Maybe Ident -> ModuleField -> ModuleField
appendIdent i (MFFunc fun) = MFFunc $ fun { ident = i }
appendIdent i (MFImport (Import sm name (ImportFunc _ typeUse))) = MFImport $ Import sm name $ ImportFunc i typeUse
appendIdent _ mf = mf
prependFuncParams :: [ParamType] -> FuncType -> FuncType
prependFuncParams prep (FuncType params results) = FuncType (prep ++ params) results
tests/samples/mod.wast
+28 -87
View File
@@ -1,93 +1,34 @@
(module
;; Auxiliary definition
(type $sig (func))
(func $dummy)
(func $foo (result i32) (i32.const 0))
;; Syntax
(func f
(i32.const 0)
(i32.const -2147483648)
(i32.const 4294967295)
(i32.const -0x80000000)
(i32.const 0xffffffff)
(func)
(func (import "extern_mod" "external_func") (param i32 i32) (result i64))
(func (import "extern_mod" "external_func") (type $sig) (param i32 i32) (result i64))
(func (import "extern_mod" "external_func") (type $sig))
(func $add (param $x i32) (param $y i32) (result i32) (i32.add (i32.const 20) (i32.const 22)))
(func (export "f"))
(func $f)
(func $h (export "g"))
(i64.const 0)
(i64.const -9223372036854775808)
(i64.const 18446744073709551615)
(i64.const -0x8000000000000000)
(i64.const 0xffffffffffffffff)
)
(func (local))
(func (local) (local))
(func (local i32))
(func (local $x i32))
(func (local i32 f64 i64))
(func (local i32) (local f64))
(func (local i32 f32) (local $x i64) (local) (local i32 f64))
(func $add (param $x f32) (param $y f32) (result f32) (f32.add (get_local $x) (get_local $y)))
(func $sub (param $x f32) (param $y f32) (result f32) (f32.sub (get_local $x) (get_local $y)))
(func $mul (param $x f32) (param $y f32) (result f32) (f32.mul (get_local $x) (get_local $y)))
(func $div (param $x f32) (param $y f32) (result f32) (f32.div (get_local $x) (get_local $y)))
(func $sqrt (param $x f32) (result f32) (f32.sqrt (get_local $x)))
(func $min (param $x f32) (param $y f32) (result f32) (f32.min (get_local $x) (get_local $y)))
(func $max (param $x f32) (param $y f32) (result f32) (f32.max (get_local $x) (get_local $y)))
(func $ceil (param $x f32) (result f32) (f32.ceil (get_local $x)))
(func $floor (param $x f32) (result f32) (f32.floor (get_local $x)))
(func $trunc (param $x f32) (result f32) (f32.trunc (get_local $x)))
(func $nearest (param $x f32) (result f32) (f32.nearest (get_local $x)))
(func $abs (param $x f32) (result f32) (f32.abs (get_local $x)))
(func $neg (param $x f32) (result f32) (f32.neg (get_local $x)))
(func $copysign (param $x f32) (param $y f32) (result f32) (f32.copysign (get_local $x) (get_local $y)))
(func (param))
(func (param) (param))
(func (param i32))
(func (param $x i32))
(func (param i32 f64 i64))
(func (param i32) (param f64))
(func (param i32 f32) (param $x i64) (param) (param i32 f64))
(func f (param x i64) (result i64)
(if_else (i64.eq (get_local 0) (i64.const 0))
(i64.const 1)
(i64.mul (get_local 0) (call 0 (i64.sub (get_local 0) (i64.const 1))))
)
)
(func $fac-rec (param $n i64) (result i64)
(if_else (i64.eq (get_local $n) (i64.const 0))
(i64.const 1)
(i64.mul
(get_local $n)
(call $fac-rec (i64.sub (get_local $n) (i64.const 1)))
)
)
)
(func f (param a i64) (result i64)
(set_local 1 (get_local 0))
(set_local 2 (i64.const 1))
(block
(loop
(if_else
(i64.eq (get_local 1) (i64.const 0))
(br 1)
(block
(set_local 2 (i64.mul (get_local 1) (get_local 2)))
(set_local 1 (i64.sub (get_local 1) (i64.const 1)))
)
)
(br 0)
)
)
(return (get_local 2))
)
;; foo
(func f (param i64) (result i64)
(set_local 1 (get_local 0))
(set_local 2 (i64.const 1))
(block
(loop
(if_else
(i64.eq (get_local 1) (i64.const 0))
(br 1)
(block
(set_local 2 (i64.mul (get_local 1) (get_local 2)))
(set_local 1 (i64.sub (get_local 1) (i64.const 1)))
)
)
(br 0)
)
)
(return (get_local 2))
)
)
(func (result i32) (unreachable))
)