diff --git a/src/Gyehoek/CPS/Lower.hs b/src/Gyehoek/CPS/Lower.hs index bd122a0..1ec0b0d 100644 --- a/src/Gyehoek/CPS/Lower.hs +++ b/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 diff --git a/src/Gyehoek/Wasm.hs b/src/Gyehoek/Wasm.hs index 7b3b018..bb03773 100644 --- a/src/Gyehoek/Wasm.hs +++ b/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