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) 'quote' list(string) ')' { TextModDef $2 $4 }
+    : 'module' opt(ident) 'binary' list(string) ')' { BinaryModDef $2 (TLEncoding.encodeUtf8 $ TL.concat $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]
-    | BinaryModDef (Maybe Ident) [TL.Text]
+    | TextModDef (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