GitHub/haskell-wasm
1
0
Fork 1
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

reduce deep of code

Browse Source
This commit is contained in:
Ilya Rezvov
2018-04-25 13:47:11 -07:00
parent abc546723d
commit 0a7b417605
1 changed files with 38 additions and 49 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Language/Wasm/Interpreter.hs
+38 -49
View File
@@ -226,21 +226,22 @@ data HostItem
makeHostModule :: Store -> [(TL.Text, HostItem)] -> IO (Store, ModuleInstance) makeHostModule :: Store -> [(TL.Text, HostItem)] -> IO (Store, ModuleInstance)
makeHostModule st items = do makeHostModule st items = do
let (st', inst') = makeHostFunctions st emptyModInstance (st, emptyModInstance)
let (st'', inst'') = makeHostGlobals st' inst' |> makeHostFunctions
(st''', inst''') <- makeHostMems st'' inst'' |> makeHostGlobals
makeHostTables st''' inst''' |> makeHostMems
>>= makeHostTables
where where
hostFunctions :: [(TL.Text, HostItem)] (|>) = flip ($)
hostFunctions = filter isHostFunction items
isHostFunction :: (TL.Text, HostItem) -> Bool isHostFunction :: (TL.Text, HostItem) -> Bool
isHostFunction (_, (HostFunction _ _)) = True isHostFunction (_, (HostFunction _ _)) = True
isHostFunction _ = False isHostFunction _ = False
makeHostFunctions :: Store -> ModuleInstance -> (Store, ModuleInstance) makeHostFunctions :: (Store, ModuleInstance) -> (Store, ModuleInstance)
makeHostFunctions st inst = makeHostFunctions (st, inst) =
let funcLen = Vector.length $ funcInstances st in let funcLen = Vector.length $ funcInstances st in
let hostFunctions = filter isHostFunction items in
let instances = map (\(_, (HostFunction t c)) -> HostInstance t c) hostFunctions in let instances = map (\(_, (HostFunction t c)) -> HostInstance t c) hostFunctions in
let types = map (\(_, (HostFunction t _)) -> t) hostFunctions in let types = map (\(_, (HostFunction t _)) -> t) hostFunctions in
let exps = Vector.fromList $ zipWith (\(name, _) i -> ExportInstance name (ExternFunction i)) hostFunctions [funcLen..] in let exps = Vector.fromList $ zipWith (\(name, _) i -> ExportInstance name (ExternFunction i)) hostFunctions [funcLen..] in
@@ -252,17 +253,15 @@ makeHostModule st items = do
in in
let st' = st { funcInstances = funcInstances st <> Vector.fromList instances } in let st' = st { funcInstances = funcInstances st <> Vector.fromList instances } in
(st', inst') (st', inst')
hostGlobals :: [(TL.Text, HostItem)]
hostGlobals = filter isHostGlobal items
isHostGlobal :: (TL.Text, HostItem) -> Bool isHostGlobal :: (TL.Text, HostItem) -> Bool
isHostGlobal (_, (HostGlobal _)) = True isHostGlobal (_, (HostGlobal _)) = True
isHostGlobal _ = False isHostGlobal _ = False
makeHostGlobals :: Store -> ModuleInstance -> (Store, ModuleInstance) makeHostGlobals :: (Store, ModuleInstance) -> (Store, ModuleInstance)
makeHostGlobals st inst = makeHostGlobals (st, inst) =
let globLen = Vector.length $ globalInstances st in let globLen = Vector.length $ globalInstances st in
let hostGlobals = filter isHostGlobal items in
let instances = map (\(_, (HostGlobal g)) -> g) hostGlobals in let instances = map (\(_, (HostGlobal g)) -> g) hostGlobals in
let exps = Vector.fromList $ zipWith (\(name, _) i -> ExportInstance name (ExternGlobal i)) hostGlobals [globLen..] in let exps = Vector.fromList $ zipWith (\(name, _) i -> ExportInstance name (ExternGlobal i)) hostGlobals [globLen..] in
let inst' = inst { let inst' = inst {
@@ -273,16 +272,14 @@ makeHostModule st items = do
let st' = st { globalInstances = globalInstances st <> Vector.fromList instances } in let st' = st { globalInstances = globalInstances st <> Vector.fromList instances } in
(st', inst') (st', inst')
hostMems :: [(TL.Text, HostItem)]
hostMems = filter isHostMem items
isHostMem :: (TL.Text, HostItem) -> Bool isHostMem :: (TL.Text, HostItem) -> Bool
isHostMem (_, (HostMemory _)) = True isHostMem (_, (HostMemory _)) = True
isHostMem _ = False isHostMem _ = False
makeHostMems :: Store -> ModuleInstance -> IO (Store, ModuleInstance) makeHostMems :: (Store, ModuleInstance) -> IO (Store, ModuleInstance)
makeHostMems st inst = do makeHostMems (st, inst) = do
let memLen = Vector.length $ memInstances st let memLen = Vector.length $ memInstances st
let hostMems = filter isHostMem items
instances <- allocMems $ map (\(_, (HostMemory lim)) -> Memory lim) hostMems instances <- allocMems $ map (\(_, (HostMemory lim)) -> Memory lim) hostMems
let exps = Vector.fromList $ zipWith (\(name, _) i -> ExportInstance name (ExternMemory i)) hostMems [memLen..] let exps = Vector.fromList $ zipWith (\(name, _) i -> ExportInstance name (ExternMemory i)) hostMems [memLen..]
let inst' = inst { let inst' = inst {
@@ -291,17 +288,15 @@ makeHostModule st items = do
} }
let st' = st { memInstances = memInstances st <> instances } let st' = st { memInstances = memInstances st <> instances }
return (st', inst') return (st', inst')
hostTables :: [(TL.Text, HostItem)]
hostTables = filter isHostTable items
isHostTable :: (TL.Text, HostItem) -> Bool isHostTable :: (TL.Text, HostItem) -> Bool
isHostTable (_, (HostTable _)) = True isHostTable (_, (HostTable _)) = True
isHostTable _ = False isHostTable _ = False
makeHostTables :: Store -> ModuleInstance -> IO (Store, ModuleInstance) makeHostTables :: (Store, ModuleInstance) -> IO (Store, ModuleInstance)
makeHostTables st inst = do makeHostTables (st, inst) = do
let tableLen = Vector.length $ tableInstances st let tableLen = Vector.length $ tableInstances st
let hostTables = filter isHostTable items
let instances = allocTables $ map (\(_, (HostTable lim)) -> Table (TableType lim AnyFunc)) hostTables let instances = allocTables $ map (\(_, (HostTable lim)) -> Table (TableType lim AnyFunc)) hostTables
let exps = Vector.fromList $ zipWith (\(name, _) i -> ExportInstance name (ExternTable i)) hostTables [tableLen..] let exps = Vector.fromList $ zipWith (\(name, _) i -> ExportInstance name (ExternTable i)) hostTables [tableLen..]
let inst' = inst { let inst' = inst {
@@ -512,9 +507,8 @@ initialize inst Module {elems, datas, start} store = do
let last = from + length funcs let last = from + length funcs
let TableInstance lim elems = tableInstances st ! idx let TableInstance lim elems = tableInstances st ! idx
let len = Vector.length elems let len = Vector.length elems
if last > len Monad.when (last > len) $ throwError "elements segment does not fit"
then throwError "elements segment does not fit" return (idx, from, funcs)
else return (idx, from, funcs)
initElem :: Store -> (Address, Int, [Address]) -> Initialize Store initElem :: Store -> (Address, Int, [Address]) -> Initialize Store
initElem st (idx, from, funcs) = do initElem st (idx, from, funcs) = do
@@ -531,9 +525,8 @@ initialize inst Module {elems, datas, start} store = do
let MemoryInstance _ memory = memInstances st ! idx let MemoryInstance _ memory = memInstances st ! idx
mem <- liftIO $ readIORef memory mem <- liftIO $ readIORef memory
let len = IOVector.length mem let len = IOVector.length mem
if last > len Monad.when (last > len) $ throwError "data segment does not fit"
then throwError "data segment does not fit" return (from, mem, chunk)
else return (from, mem, chunk)
initData :: (Int, IOVector Word8, LBS.ByteString) -> Initialize () initData :: (Int, IOVector Word8, LBS.ByteString) -> Initialize ()
initData (from, mem, chunk) = initData (from, mem, chunk) =
@@ -605,7 +598,6 @@ eval budget store FunctionInstance { funcType, moduleInstance, code = Function {
go ctx [] = return $ Done ctx go ctx [] = return $ Done ctx
go ctx (instr:rest) = do go ctx (instr:rest) = do
res <- step ctx instr res <- step ctx instr
-- case Debug.trace ("instr " ++ show instr ++ " --> " ++ show res) $ res of
case res of case res of
Done ctx' -> go ctx' rest Done ctx' -> go ctx' rest
command -> return command command -> return command
@@ -696,25 +688,22 @@ eval budget store FunctionInstance { funcType, moduleInstance, code = Function {
step ctx@EvalCtx{ stack = (VI32 v): rest } (CallIndirect typeIdx) = do step ctx@EvalCtx{ stack = (VI32 v): rest } (CallIndirect typeIdx) = do
let funcType = funcTypes moduleInstance ! fromIntegral typeIdx let funcType = funcTypes moduleInstance ! fromIntegral typeIdx
let TableInstance { elements } = tableInstances store ! (tableaddrs moduleInstance ! 0) let TableInstance { elements } = tableInstances store ! (tableaddrs moduleInstance ! 0)
let funcAddr = elements !? fromIntegral v let checks = do
case funcAddr of addr <- Monad.join $ elements !? fromIntegral v
Just (Just addr) -> do let funcInst = funcInstances store ! addr
let funInst = funcInstances store ! addr let targetType = Language.Wasm.Interpreter.funcType funcInst
let targetType = Language.Wasm.Interpreter.funcType funInst Monad.guard $ targetType == funcType
if targetType == funcType let args = params targetType
then do Monad.guard $ length args <= length rest
let args = params targetType params <- sequence $ zipWith checkValType args $ reverse $ take (length args) rest
if length args > length rest return (funcInst, params)
then return Trap case checks of
else case sequence $ zipWith checkValType args $ reverse $ take (length args) rest of Just (funcInst, params) -> do
Just params -> do res <- eval (budget - 1) store funcInst params
res <- eval (budget - 1) store funInst params case res of
case res of Just res -> return $ Done ctx { stack = reverse res ++ (drop (length params) rest) }
Just res -> return $ Done ctx { stack = reverse res ++ (drop (length args) rest) } Nothing -> return Trap
Nothing -> return Trap Nothing -> return Trap
Nothing -> return Trap
else return Trap
_ -> return Trap
step ctx@EvalCtx{ stack = (_:rest) } Drop = return $ Done ctx { stack = rest } step ctx@EvalCtx{ stack = (_:rest) } Drop = return $ Done ctx { stack = rest }
step ctx@EvalCtx{ stack = (VI32 test:val2:val1:rest) } Select = step ctx@EvalCtx{ stack = (VI32 test:val2:val1:rest) } Select =
if test == 0 if test == 0