load modules in wasm script commands

src/Language/Wasm/Interpreter.hs

@@ -5,6 +5,8 @@
 
 module Language.Wasm.Interpreter (
     Value(..),
+    Store,
+    ModuleInstance,
     instantiate,
     invoke,
     invokeExport,

src/Language/Wasm/Parser.y

@@ -29,7 +29,14 @@ module Language.Wasm.Parser (
     Index(..),
     Ident(..),
     ParamType(..),
-    FuncType(..)
+    FuncType(..),
+    -- script
+    Script,
+    ModuleDef(..),
+    Command(..),
+    Action(..),
+    Assertion(..),
+    Meta(..)
 ) where
 
 import Language.Wasm.Structure (
@@ -323,7 +330,7 @@ name :: { TL.Text }
     : string { $1 }
 
 ident :: { Ident }
-    : id { Ident (TL.toStrict (TLEncoding.decodeUtf8 $1)) }
+    : id { Ident (TLEncoding.decodeUtf8 $1) }
 
 valtype :: { ValueType }
     : 'i32' { I32 }
@@ -1017,8 +1024,8 @@ command1 :: { Command }
     | meta1 { Meta $1 }
 
 module1 :: { ModuleDef }
-    : 'module' opt(ident) 'binary' list(string) ')' { BinaryModDef $2 $4 }
+    : 'module' opt(ident) 'binary' list(string) ')' { BinaryModDef $2 (TLEncoding.encodeUtf8 $ TL.concat $4) }
-    | 'module' opt(ident) 'quote' list(string) ')' { TextModDef $2 $4 }
+    | 'module' opt(ident) 'quote' list(string) ')' { TextModDef $2 (TL.concat $4) }
     | 'module' opt(ident) list(modulefield) ')' { RawModDef $2 (desugarize $ concat $3) }
     | modulefield1 list(modulefield) { RawModDef Nothing (desugarize $ $1 ++ concat $2) }
 
@@ -1141,7 +1148,7 @@ data ParamType = ParamType {
         paramType :: ValueType
     } deriving (Show, Eq)
 
-newtype Ident = Ident T.Text deriving (Show, Eq)
+newtype Ident = Ident TL.Text deriving (Show, Eq)
 
 data Index = Named Ident | Index Natural deriving (Show, Eq)
 
@@ -1366,8 +1373,8 @@ type Expression = [Instruction]
 
 data ModuleDef
     = RawModDef (Maybe Ident) S.Module
-    | TextModDef (Maybe Ident) [TL.Text]
+    | TextModDef (Maybe Ident) TL.Text
-    | BinaryModDef (Maybe Ident) [TL.Text]
+    | BinaryModDef (Maybe Ident) LBS.ByteString
     deriving (Show, Eq)
 
 data Command

src/Language/Wasm/Script.hs

@@ -0,0 +1,70 @@
+module Language.Wasm.Script (
+    runScript,
+    OnAssertFail
+) where
+
+import qualified Data.Map as Map
+import qualified Data.Text.Lazy as TL
+import qualified Data.Text.Lazy.Encoding as TLEncoding
+
+import Language.Wasm.Parser (
+        Ident(..),
+        Script,
+        ModuleDef(..),
+        Command(..),
+        Action(..),
+        Assertion(..),
+        Meta(..)
+    )
+
+import qualified Language.Wasm.Interpreter as Interpreter
+import qualified Language.Wasm.Validate as Validate
+import qualified Language.Wasm.Structure as Struct
+import qualified Language.Wasm.Parser as Parser
+import qualified Language.Wasm.Lexer as Lexer
+import qualified Language.Wasm.Binary as Binary
+
+type OnAssertFail = Assertion -> IO ()
+
+data ScriptState = ScriptState {
+    store :: Interpreter.Store,
+    lastModule :: Maybe Interpreter.ModuleInstance,
+    modules :: Map.Map TL.Text Interpreter.ModuleInstance,
+    moduleRegistery :: Map.Map TL.Text Interpreter.ModuleInstance
+}
+
+emptyState :: ScriptState
+emptyState = ScriptState {
+    store = Interpreter.emptyStore,
+    lastModule = Nothing,
+    modules = Map.empty,
+    moduleRegistery = Map.empty
+}
+
+runScript :: OnAssertFail -> Script -> IO ()
+runScript onAssertFail script = go script emptyState
+    where
+        go [] _ = return ()
+        go (c:cs) st = runCommand st c >>= go cs
+        
+        addToRegistery :: Maybe Ident -> Interpreter.ModuleInstance -> ScriptState -> ScriptState
+        addToRegistery (Just (Ident ident)) m st = st { moduleRegistery = Map.insert ident m $ moduleRegistery st }
+        addToRegistery Nothing _ st = st
+
+        addModule :: Maybe Ident -> Struct.Module -> ScriptState -> IO ScriptState
+        addModule ident m st =
+            case Validate.validate m of
+                Validate.Valid -> do
+                    (modInst, store') <- Interpreter.instantiate (store st) Interpreter.emptyImports m
+                    return $ addToRegistery ident modInst $ st { lastModule = Just modInst, store = store' }
+                reason -> error $ "Module instantiation failed dut to invalid module with reason: " ++ show reason
+
+        runCommand :: ScriptState -> Command -> IO ScriptState
+        runCommand st (ModuleDef (RawModDef ident m)) = addModule ident m st
+        runCommand st (ModuleDef (TextModDef ident textRep)) =
+            let Right m = Parser.parseModule <$> Lexer.scanner (TLEncoding.encodeUtf8 textRep) in
+            addModule ident m st
+        runCommand st (ModuleDef (BinaryModDef ident binaryRep)) =
+            let Right m = Binary.decodeModuleLazy binaryRep in
+            addModule ident m st
+        runCommand st _ = return st

tests/Test.hs

@@ -16,6 +16,7 @@ import qualified Language.Wasm.Structure as Structure
 import qualified Language.Wasm.Binary as Binary
 import qualified Language.Wasm.Validate as Validate
 import qualified Language.Wasm.Interpreter as Interpreter
+import qualified Language.Wasm.Script as Script
 
 import qualified Debug.Trace as Debug
 
@@ -33,44 +34,9 @@ compile file = do
 main :: IO ()
 main = do
   files <- Directory.listDirectory "tests/samples"
-  -- let files = ["call_indirect.wast"]
+  scriptTestCases <- (`mapM` files) $ \file -> do
-  -- compile "fact.wast"
-  syntaxTestCases <- (`mapM` files) $ \file -> do
     content <- LBS.readFile $ "tests/samples/" ++ file
-    let result = Parser.parseScript <$> Lexer.scanner content
+    let Right script = Parser.parseScript <$> Lexer.scanner content
-    return $ testCase ("Parse module from core Test Suit: " ++ file) $
+    return $ testCase file $ do
-      assertBool "Module parsed" $ isRight result
+      Script.runScript (assertFailure . ("Failed assert: " ++) . show) script
-  -- binaryTestCases <- (`mapM` files) $ \file -> do
+  defaultMain $ testGroup "Wasm Core Test Suit" scriptTestCases
-  --   content <- LBS.readFile $ "tests/samples/" ++ file
-  --   let Right mod = Parser.parseModule <$> Lexer.scanner content
-  --   let Right mod' = Binary.decodeModuleLazy $ Binary.dumpModuleLazy mod
-  --   return $ testCase ("Dump module to binary and parse back: " ++ file) $
-  --     assertEqual "Module matched" mod mod'
-  -- validationTestCases <- (`mapM` files) $ \file -> do
-  --   content <- LBS.readFile $ "tests/samples/" ++ file
-  --   let Right mod = Parser.parseModule <$> Lexer.scanner content
-  --   return $ testCase ("Validate module: " ++ file) $
-  --     case file of
-  --       "import.wast" ->
-  --         assertEqual "Too many tables" Validate.MoreThanOneTable $ Validate.validate mod
-  --       _ ->
-  --         assertBool "Module matched" $ Validate.isValid $ Validate.validate mod
-  -- interpretFactTestCases <- do
-  --   content <- LBS.readFile "tests/samples/fact.wast"
-  --   let Right mod = Parser.parseModule <$> Lexer.scanner content
-  --   (modInst, store) <- Interpreter.instantiate Interpreter.emptyStore Interpreter.emptyImports mod
-  --   (`mapM` ["fac-rec", "fac-rec-named", "fac-iter", "fac-iter-named", "fac-opt"]) $ \fn -> do
-  --     let fac = \n -> Interpreter.invokeExport store modInst fn [Interpreter.VI64 n]
-  --     fac3 <- fac 3
-  --     fac5 <- fac 5
-  --     fac8 <- fac 8
-  --     return $ testCase ("Interprete " ++ show fn) $ do
-  --       assertEqual "Fact 3! == 6" [Interpreter.VI64 6] fac3
-  --       assertEqual "Fact 5! == 120" [Interpreter.VI64 120] fac5
-  --       assertEqual "Fact 8! == 40320" [Interpreter.VI64 40320] fac8
-  defaultMain $ testGroup "tests" [
-      testGroup "Syntax parsing" syntaxTestCases
-      -- testGroup "Binary format" binaryTestCases,
-      -- testGroup "Validation" validationTestCases,
-      -- testGroup "Interpretation" interpretFactTestCases
-    ]

wasm.cabal

@@ -41,6 +41,7 @@ library
       Language.Wasm.Binary
       Language.Wasm.Validate
       Language.Wasm.Interpreter
+      Language.Wasm.Script
       Language.Wasm
   other-modules:
       Paths_wasm