make serializer work correct

This commit is contained in:
Ilya Rezvov
2018-02-19 14:30:06 -08:00
parent 809d5bbf38
commit 8dc40aa699
5 changed files with 54 additions and 4 deletions
+1
View File
@@ -1 +1,2 @@
.stack-work .stack-work
tests/runnable/*
+9 -2
View File
@@ -1,7 +1,8 @@
{-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE NamedFieldPuns #-}
module Language.Wasm.Binary ( module Language.Wasm.Binary (
dumpModule,
dumpModuleLazy
) where ) where
import Language.Wasm.Structure import Language.Wasm.Structure
@@ -542,7 +543,7 @@ instance Serialize Module where
putSection TypeSection $ putVec $ types mod putSection TypeSection $ putVec $ types mod
putSection ImportSection $ putVec $ imports mod putSection ImportSection $ putVec $ imports mod
putSection FunctionSection $ putVec $ map funcType $ functions mod putSection FunctionSection $ putVec $ map (Index . funcType) $ functions mod
putSection TableSection $ putVec $ tables mod putSection TableSection $ putVec $ tables mod
putSection MemorySection $ putVec $ mems mod putSection MemorySection $ putVec $ mems mod
putSection GlobalSection $ putVec $ globals mod putSection GlobalSection $ putVec $ globals mod
@@ -555,3 +556,9 @@ instance Serialize Module where
putSection DataSection $ putVec $ datas mod putSection DataSection $ putVec $ datas mod
get = undefined get = undefined
dumpModule :: Module -> BS.ByteString
dumpModule = encode
dumpModuleLazy :: Module -> LBS.ByteString
dumpModuleLazy = encodeLazy
+9
View File
@@ -12,6 +12,7 @@ import qualified Data.ByteString.Lazy as LBS
import qualified Language.Wasm.Lexer as Lexer import qualified Language.Wasm.Lexer as Lexer
import qualified Language.Wasm.Parser as Parser import qualified Language.Wasm.Parser as Parser
import qualified Language.Wasm.Structure as Structure import qualified Language.Wasm.Structure as Structure
import qualified Language.Wasm.Binary as Binary
import qualified Debug.Trace as Debug import qualified Debug.Trace as Debug
@@ -19,9 +20,17 @@ isRight :: (Show b) => Either a b -> Bool
isRight (Right x) = x `seq` True isRight (Right x) = x `seq` True
isRight _ = False isRight _ = False
compile :: String -> IO ()
compile file = do
content <- LBS.readFile $ "tests/samples/" ++ file
let Right mod = Parser.parseModule <$> Lexer.scanner content
LBS.writeFile ("tests/runnable/" ++ file) $ Binary.dumpModuleLazy mod
-- to run: python -m SimpleHTTPServer 8081 && open http://localhost:8081/tests/runnable
main :: IO () main :: IO ()
main = do main = do
files <- Directory.listDirectory "tests/samples" files <- Directory.listDirectory "tests/samples"
compile "fact.wast"
testCases <- (`mapM` files) $ \file -> do testCases <- (`mapM` files) $ \file -> do
content <- LBS.readFile $ "tests/samples/" ++ file content <- LBS.readFile $ "tests/samples/" ++ file
let result = Parser.parseModule <$> Lexer.scanner content let result = Parser.parseModule <$> Lexer.scanner content
+11
View File
@@ -0,0 +1,11 @@
<script>
fetch('fact.wast').then(response =>
response.arrayBuffer()
).then(bytes =>
WebAssembly.instantiate(bytes, {})
).then(results => {
console.log('result', results)
const fact = results.instance.exports['fac-iter-named-32']
console.log(fact, fact(5))
});
</script>
+22
View File
@@ -65,6 +65,28 @@
(get_local $res) (get_local $res)
) )
;; Iterative factorial named
(func (export "fac-iter-named-32") (param $n i32) (result i32)
(local $i i32)
(local $res i32)
(set_local $i (get_local $n))
(set_local $res (i32.const 1))
(block $done
(loop $loop
(if
(i32.eq (get_local $i) (i32.const 0))
(then (br $done))
(else
(set_local $res (i32.mul (get_local $i) (get_local $res)))
(set_local $i (i32.sub (get_local $i) (i32.const 1)))
)
)
(br $loop)
)
)
(get_local $res)
)
;; Optimized factorial. ;; Optimized factorial.
(func (export "fac-opt") (param i64) (result i64) (func (export "fac-opt") (param i64) (result i64)
(local i64) (local i64)