SPY / haskell-wasm

Haskell WebAssembly Toolkit
Other
151 stars 24 forks source link

Expose mutable memory access #20

Closed carbolymer closed 1 year ago

carbolymer commented 2 years ago

This PR adds a way to access memory in Store. I've needed that when I was implementing the following code from MDN:

(module
  (import "console" "log" (func $log (param i32 i32)))
  (import "js" "mem" (memory 1))
  (data (i32.const 0) "Hi")
  (func (export "writeHi")
    i32.const 0  ;; pass offset 0 to log
    i32.const 2  ;; pass length 2 to log
    call $log))

which requires those changes to make console.log work.

Sample usage (around line 41):

module Main where

import           Control.Monad.Primitive   (RealWorld)
import           Data.ByteString           (readFile)
import           Data.Either.Combinators   (mapLeft)
import           Data.IORef                (newIORef, readIORef, writeIORef)
import qualified Data.Map.Strict           as M
import           Data.Primitive            (readByteArray)
import           Data.Primitive.ByteArray  (MutableByteArray, newByteArray)
import qualified Data.Vector               as V
import           Language.Wasm             (ValidModule, validate)
import           Language.Wasm.Binary      (decodeModule)
import           Language.Wasm.Interpreter
import           Language.Wasm.Structure
import           Protolude                 hiding (readFile)
import           Unsafe.Coerce

main :: IO ()
main = do
  module'e <- ((mapLeft show . validate) <=< decodeModule) <$> readFile "sample.wasm"
  case module'e of
    Right module' -> runModule module'
    Left err      -> panic (toS err)

runModule :: ValidModule -> IO ()
runModule vm' = do
  -- IORef used for holding memory for printing
  printMemory <- newByteArray 0 >>= newIORef
  let vmPrint :: [Value] -> IO [Value] = \case
        [VI32 start, VI32 len] -> do
          ba <- readIORef printMemory
          readText ba (fromIntegral start) (fromIntegral len) >>= print
          pure []
        _ -> pure []

  (store, ModuleInstance{exports}) <- makeHostModule emptyStore
    [ ("log", HostFunction (FuncType [I32, I32] []) vmPrint)
    , ("mem", HostMemory $ Limit 1 Nothing)
    ]
  -- get memory from the store and put into `printMemory`
  for_ (getMemory store 0) $ \(MemoryInstance _ memoryStore) ->
      readIORef memoryStore >>= writeIORef printMemory

  -- export functions from host module
  let ExportInstance _ extVal = V.head $ V.filter (\(ExportInstance name _) -> name == "log") exports
      ExportInstance _ extMem = V.head $ V.filter (\(ExportInstance name _) -> name == "mem") exports
      imports = M.fromList [ (("console", "log"), extVal)
                           , (("js", "mem"), extMem)
                           ]
  (moduleInstance'e, store') <- instantiate store imports vm'
  case moduleInstance'e of
    Right moduleInstance -> print =<< invokeExport store' moduleInstance "writeHi" []
    Left err -> panic (toS err)

readText :: MutableByteArray RealWorld -> Int -> Int -> IO Text
readText ba start len = toS <$> go start len
  where
    go _ 0 = pure []
    go i l = do
      ch <- readChar ba i
      if ch /= '\0'
         then (ch :) <$> go (i + 1) (l - 1)
         else pure []

readChar :: MutableByteArray RealWorld -> Int -> IO Char
readChar ba idx = unsafeCoerce <$> readByteArray @Word8 ba idx
SPY commented 1 year ago

I have no idea how I missed this PR. My apologize for it. Thanks for contribution.