calculate module instance

src/Language/Wasm/Interpreter.hs

@@ -9,7 +9,8 @@ import qualified Data.Map as Map
 import qualified Data.Text.Lazy as TL
 import qualified Data.ByteString.Lazy as LBS
 
-import Data.Vector (Vector)
+import Data.Vector (Vector, (!))
+import Data.Maybe (fromJust)
 import qualified Data.Vector as Vector
 import Data.IORef (IORef)
 import Data.Array.IO (IOArray, newArray, readArray, writeArray)
@@ -51,9 +52,9 @@ data MemoryInstance = MemoryInstance {
 
 data GlobalInstance = GIConst Value | GIMut (IORef Value)
 
-data ExportInstance = ExportInstance TL.Text ExternalVal deriving (Eq, Show)
+data ExportInstance = ExportInstance TL.Text ExternalValue deriving (Eq, Show)
 
-data ExternalVal =
+data ExternalValue =
     ExternFunction Address
     | ExternTable Address
     | ExternMemory Address
@@ -79,8 +80,8 @@ data Store = Store {
     globals :: Vector GlobalInstance
 }
 
-initialStore :: Store
+emptyStore :: Store
-initialStore = Store {
+emptyStore = Store {
     functions = Vector.empty,
     tables = Vector.empty,
     mems = Vector.empty,
@@ -96,11 +97,42 @@ data ModuleInstance = ModuleInstance {
     exports :: Vector ExportInstance
 } deriving (Eq, Show)
 
-instantiate :: Store -> Module -> IO (ModuleInstance, Store)
+calcInstance :: Store -> Imports -> Module -> ModuleInstance
-instantiate st mod = do
+calcInstance (Store fs ts ms gs) imps Module {functions, types, tables, mems, globals, exports, imports} =
-    return $ (
+    let funLen = length fs in
-            ModuleInstance {
+    let tableLen = length ts in
-                types = Vector.fromList $ Struct.types mod
+    let memLen = length ms in
-            },
+    let globalLen = length gs in
-            st
+    let getImpIdx (Import m n _) = fromJust $ Map.lookup (m, n) imps in
-        )
+    let funImps = map getImpIdx $ filter isFuncImport imports in
+    let tableImps = map getImpIdx $ filter isTableImport imports in
+    let memImps = map getImpIdx $ filter isMemImport imports in
+    let globalImps = map getImpIdx $ filter isGlobalImport imports in
+    let funs = Vector.fromList $ map (\(ExternFunction i) -> i) funImps ++ [funLen..funLen + length functions - 1] in
+    let tbls = Vector.fromList $ map (\(ExternTable i) -> i) tableImps ++ [tableLen..tableLen + length tables - 1] in
+    let memories = Vector.fromList $ map (\(ExternMemory i) -> i) memImps ++ [memLen..memLen + length mems - 1] in
+    let globs = Vector.fromList $ map (\(ExternGlobal i) -> i) globalImps ++ [globalLen..globalLen + length globals - 1] in
+    let
+        refExport (Export name (ExportFunc idx)) =
+            ExportInstance name $ ExternFunction $ funs ! fromIntegral idx
+        refExport (Export name (ExportTable idx)) =
+            ExportInstance name $ ExternTable $ tbls ! fromIntegral idx
+        refExport (Export name (ExportMemory idx)) =
+            ExportInstance name $ ExternMemory $ memories ! fromIntegral idx
+        refExport (Export name (ExportGlobal idx)) =
+            ExportInstance name $ ExternGlobal $ globs ! fromIntegral idx
+    in
+    ModuleInstance {
+        types = Vector.fromList types,
+        functions = funs,
+        tables = tbls,
+        mems = memories,
+        globals = globs,
+        exports = Vector.fromList $ map refExport exports
+    }
+
+type Imports = Map.Map (TL.Text, TL.Text) ExternalValue
+
+instantiate :: Store -> Imports -> Module -> IO (ModuleInstance, Store)
+instantiate st imps m = do
+    return $ (calcInstance st imps m, st)

src/Language/Wasm/Structure.hs

@@ -33,7 +33,11 @@ module Language.Wasm.Structure (
     LabelIndex,
     LocalIndex,
     GlobalIndex,
-    emptyModule
+    emptyModule,
+    isFuncImport,
+    isTableImport,
+    isMemImport,
+    isGlobalImport
 ) where
 
 import Numeric.Natural (Natural)
@@ -232,6 +236,22 @@ data Import = Import {
     desc :: ImportDesc
 } deriving (Show, Eq)
 
+isFuncImport :: Import -> Bool
+isFuncImport (Import _ _ (ImportFunc _)) = True
+isFuncImport _ = False
+
+isTableImport :: Import -> Bool
+isTableImport (Import _ _ (ImportTable _)) = True
+isTableImport _ = False
+
+isMemImport :: Import -> Bool
+isMemImport (Import _ _ (ImportMemory _)) = True
+isMemImport _ = False
+
+isGlobalImport :: Import -> Bool
+isGlobalImport (Import _ _ (ImportGlobal _)) = True
+isGlobalImport _ = False
+
 data Module = Module {
     types :: [FuncType],
     functions :: [Function],

src/Language/Wasm/Validate.hs

@@ -484,10 +484,6 @@ tablesShouldBeValid Module { imports, tables } =
             then Valid
             else InvalidTableType
 
-isTableImport :: Import -> Bool
-isTableImport Import { desc = ImportTable _ } = True
-isTableImport _ = False
-
 memoryShouldBeValid :: Validator
 memoryShouldBeValid Module { imports, mems } =
     let memImports = filter isMemImport imports in
@@ -500,10 +496,6 @@ memoryShouldBeValid Module { imports, mems } =
         isValidLimit :: Limit -> ValidationResult
         isValidLimit (Limit min max) = if min <= fromMaybe min max then Valid else InvalidMemoryLimit
 
-isMemImport :: Import -> Bool
-isMemImport Import { desc = ImportMemory _ } = True
-isMemImport _ = False
-
 globalsShouldBeValid :: Validator
 globalsShouldBeValid m@Module { imports, globals } =
     let ctx = ctxFromModule [] [] Nothing m in