playing with i31

src/Gyehoek/CPS/Lower.hs

@@ -31,7 +31,7 @@ import qualified Data.Vector.Strict as V
 import Data.IntMap.Strict (IntMap)
 import Data.String.Interpolate
 import Gyehoek.Wasm qualified as Wasm
-import Gyehoek.Wasm (i32, ins, sxp)
+import Gyehoek.Wasm (i32, ins, sxp, eq, ref, i31)
 
 
 data Env = MkEnv { vars :: Vector Name }
@@ -48,17 +48,16 @@ instance Ixed Env where
 
 
 
-tshow :: Show a => a -> Text
-tshow = T.pack . show
-
-
-
 lowerVal :: Env -> Val -> Wasm.Expr
 
 lowerVal g (ValLit l) =
   case l of
-    LitInt n -> ins "i32.const" [sxp n]
-    LitBool b -> ins "i32.const" [sxp @Int $ if b then 1 else 0]
+    LitInt n ->
+      ins "i32.const" [sxp n]
+      <> ins "ref.i31" []
+    LitBool b ->
+      ins "i32.const" [sxp @Int $ if b then 1 else 0]
+      <> ins "ref.i31" []
     _ -> _
 
 lowerVal g (ValVar x) = ins "local.get" [sxp l]
@@ -87,8 +86,13 @@ lowerBinOp
   -> _ -> _ -> _ -> _ -> _ -> Wasm.Expr
 lowerBinOp op g x y r e =
   lowerVal g x
+  <> ins "ref.cast" [sxp $ ref i31]
+  <> ins "i31.get_s" []
   <> lowerVal g y
+  <> ins "ref.cast" [sxp $ ref i31]
+  <> ins "i31.get_s" []
   <> ins op []
+  <> ins "ref.i31" []
   <> ins "local.set" [sxp n]
   <> lower' g' e
   where
@@ -97,9 +101,11 @@ lowerBinOp op g x y r e =
 
 
 
+scm = ref eq
+
 lower :: Exp -> Eff es Text
 lower e = fmap Wasm.renderModule . Wasm.execGenMod $ do
-  main <- Wasm.defun [] [i32] [i32, i32, i32, i32, i32] \_ ->
+  main <- Wasm.defun [] [scm] [scm, scm, scm, scm, scm] \_ ->
     lower' emptyEnv e
   Wasm.export "main" "func" main
 

src/Gyehoek/Wasm.hs

@@ -28,6 +28,10 @@ module Gyehoek.Wasm
   , result
   , param
   , if'
+  , ref
+  , eq
+  , i31ref
+  , i31
   )
   where
 
@@ -59,6 +63,7 @@ import Language.Sexp.Located
 import qualified Gyehoek.Sexp
 import GHC.IsList (IsList(..))
 import Data.Coerce (coerce)
+import qualified Control.Category
 
 
 data Module = MkModule
@@ -160,8 +165,14 @@ execGenMod = fmap snd . runGenMod
 renderModule :: Module -> Text
 renderModule = (^?! _Right) . Gyehoek.Sexp.encodePretty
 
-i32 :: Type
+ref :: Type -> Type
+ref (MkType x) = MkType . ParenList $ [Symbol "ref", x]
+
+i32, i31ref, eq, i31 :: Type
 i32 = MkType $ Symbol "i32"
+i31ref = MkType $ Symbol "i31ref"
+eq = MkType $ Symbol "eq"
+i31 = MkType $ Symbol "i31"
 
 
 
@@ -206,6 +217,9 @@ instance SexpIso Module where
       <> (m ^.. #functions . each . to sxp)
       <> (m ^.. #exports . each . to sxp)
 
+instance SexpIso Sexp where
+  sexpIso = Control.Category.id
+
 instance Each Expr Expr Instr Instr where
   each = #MkExpr . each