idk

src/Gyehoek/Wasm.hs

@@ -47,6 +47,7 @@ module Gyehoek.Wasm
   , FromIdx(..)
   , func
   , refnull
+  , declareFuncref
   )
   where
 
@@ -85,6 +86,7 @@ import Data.Functor (void)
 data Module = MkModule
   { types :: Vector RecType
   , functions :: Vector Function
+  , funcrefs :: Vector Funcref
   , start :: Maybe Idx
   , exports :: Vector Export
   , globals :: Vector Global
@@ -97,10 +99,15 @@ instance Semigroup Module where
     , functions = m1.functions <> m2.functions
     , start = m2.start <|> m1.start
     , exports = m1.exports <> m2.exports
+    , funcrefs = m1.funcrefs <> m2.funcrefs
+    , globals = m1.globals <> m2.globals
     }
 
 instance Monoid Module where
-  mempty = MkModule mempty mempty Nothing mempty mempty
+  mempty = MkModule mempty mempty mempty Nothing mempty mempty
+
+newtype Funcref = MkFuncref { inner :: Idx }
+  deriving (Show, Generic)
 
 data Global = MkGlobal
   { ty :: Type
@@ -144,6 +151,7 @@ data GenMod :: Effect where
   Start :: Idx -> GenMod m ()
   Export :: Text -> Text -> Idx -> GenMod m ()
   DefGlobal :: Type -> Expr -> GenMod m Idx
+  DeclareFuncref :: Idx -> GenMod m ()
 
 type instance DispatchOf GenMod = Dynamic
 
@@ -174,6 +182,9 @@ defun
   -> Eff es Idx
 defun params res locals code = send $ Defun params res locals code
 
+declareFuncref :: GenMod :> es => Idx -> Eff es ()
+declareFuncref = send . DeclareFuncref
+
 -- defun
 --   :: (GenMod :> es)
 --   => List Type -> List Type -> List Type
@@ -196,21 +207,22 @@ runGenMod =
       where e = MkExport $ ParenList
               [ "export", sxp name, ParenList [ "func", sxp idx ] ]
     env (Defun params result locals code) ->
-      localSeqUnlift env \unlift ->
-        stateM \m -> do
-          -- the least unused function index, computed as the number
-          -- of currently allocated functions.
-          let idx = IdxNumeric . fromIntegral . length $ m.functions
-          -- the body is computed with access to the newly allocated
-          -- index `idx` for the sake of recursive occurences.
-          body <- unlift $ code idx
-          let func = MkFunction {params,result,locals,body}
-          let m' = m & #functions <>~ V.singleton func
-          pure (idx, m')
+      localSeqUnlift env \unlift -> do
+        m <- get
+        -- the least unused function index, computed as the number
+        -- of currently allocated functions.
+        let idx = IdxNumeric . fromIntegral . length $ m.functions
+        -- the body is computed with access to the newly allocated
+        -- index `idx` for the sake of recursive occurences.
+        body <- unlift $ code idx
+        let func = MkFunction {params,result,locals,body}
+        #functions <>= V.singleton func
+        pure idx
     _ (DefGlobal t e) -> state \m ->
       let prev_n = IdxNumeric . fromIntegral . V.length $ m.globals
           m' = m & #globals <>~ V.singleton (MkGlobal t e)
       in (prev_n, m')
+    _ (DeclareFuncref idx) -> #funcrefs <>= V.singleton (MkFuncref idx)
 
 execGenMod = fmap snd . runGenMod
 
@@ -346,9 +358,19 @@ instance SexpIso Module where
     ParenList $
       [ Symbol "module" ]
       <> (m ^.. #types . each . to sxp)
+      <> (m ^.. #funcrefs . each . to sxp)
       <> (m ^.. #functions . each . to sxp)
       <> (m ^.. #exports . each . to sxp)
 
+instance SexpIso Funcref where
+  sexpIso = with \funcref ->
+    list ( el (sym "elem")
+         >>> el (sym "declare")
+         >>> el (sym "funcref")
+         >>> el (list $ el (sym "ref.func") >>> el (sexpIso @Idx))
+         )
+    >>> funcref
+
 instance SexpIso Sexp where
   sexpIso = Control.Category.id