diff --git a/src/Language/Wasm/Interpreter.hs b/src/Language/Wasm/Interpreter.hs index d7886ff..83014df 100644 --- a/src/Language/Wasm/Interpreter.hs +++ b/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 -initialStore = Store { +emptyStore :: 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) -instantiate st mod = do - return $ ( - ModuleInstance { - types = Vector.fromList $ Struct.types mod - }, - st - ) +calcInstance :: Store -> Imports -> Module -> ModuleInstance +calcInstance (Store fs ts ms gs) imps Module {functions, types, tables, mems, globals, exports, imports} = + let funLen = length fs in + let tableLen = length ts in + let memLen = length ms in + let globalLen = length gs in + 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) diff --git a/src/Language/Wasm/Structure.hs b/src/Language/Wasm/Structure.hs index de04b25..999ef0b 100644 --- a/src/Language/Wasm/Structure.hs +++ b/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], diff --git a/src/Language/Wasm/Validate.hs b/src/Language/Wasm/Validate.hs index bf6318a..9f8c849 100644 --- a/src/Language/Wasm/Validate.hs +++ b/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