we r so bak

app/Gyehoek/CPS/Lower.hs

@@ -1,4 +1,5 @@
 {-# LANGUAGE OverloadedLists #-}
+{-# LANGUAGE QuasiQuotes #-}
 {-# LANGUAGE OverloadedRecordDot #-}
 {-# LANGUAGE OverloadedLabels #-}
 {-# LANGUAGE TypeFamilies #-}
@@ -28,6 +29,9 @@ import Text.Printf
 import qualified Data.Text as T
 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)
 
 
 data Env = MkEnv { vars :: Vector Name }
@@ -49,18 +53,18 @@ tshow = T.pack . show
 
 
 
-lowerVal :: Env -> Val -> Vector Text
+lowerVal :: Env -> Val -> Wasm.Expr
 
 lowerVal g (ValLit l) =
   case l of
-    LitInt n -> [ "i32.const " <> tshow n ]
+    LitInt n -> [i|i32.const #{n}|]
     _ -> _
 
-lowerVal g (ValVar x) = [ "local.get " <> tshow i ]
+lowerVal g (ValVar x) = [i|local.get #{l}|]
   where
-    i = V.elemIndex x g.vars ^?! _Just
+    l = V.elemIndex x g.vars ^?! _Just
 
-lower' :: Env -> Exp -> Vector Text
+lower' :: Env -> Exp -> Wasm.Expr
 
 lower' g (Halt [e]) = lowerVal g e
 
@@ -71,10 +75,14 @@ lower' g (ExpPrim p rs e) =
   where
     r = head rs
 
+lowerBinOp
+  :: _
+  -> _ -> _ -> _ -> _ -> _ -> Wasm.Expr
 lowerBinOp op g x y r e =
   lowerVal g x
   <> lowerVal g y
-  <> [ op, "local.set " <> tshow n ]
+  <> op
+  <> [i|local.set #{n}|]
   <> lower' g' e
   where
     g' = g & #vars <>~ [r]
@@ -82,14 +90,8 @@ lowerBinOp op g x y r e =
 
 
 
-makeFunc :: Vector Text -> Text
-makeFunc = (preamble<>) . (<>postamble) . T.unlines . toList . fmap indent
-  where
-    indent = ("    "<>)
-    preamble  = "(module\n\
-                \  (func (export \"main\") (result i32)\n\
-                \    (local i32 i32 i32 i32 i32 i32)\n"
-    postamble = "  ))"
-
 lower :: Exp -> Eff es Text
-lower = pure . makeFunc . lower' emptyEnv
+lower e = fmap Wasm.renderModule . Wasm.execGenMod $ do
+  idx <- Wasm.defun [] [i32] [i32, i32, i32, i32, i32] \_ ->
+    lower' emptyEnv e
+  Wasm.export "main" "func" idx