driverslop

app/Gyehoek/CPS/Convert.hs

@@ -44,4 +44,6 @@ convert (Scm.ExpApply f xs) k =
     m <- k (ValVar x)
     pure $ ExpFix [(r, MkKappa [x] m)] $ ExpApply f' (xs' ++ [ValVar r])
 
+convert (Scm.ExpBegin xs) k = _
+
 convert _ k = _

app/Gyehoek/CPS/Lower.hs

@@ -5,8 +5,8 @@
 {-# LANGUAGE MultilineStrings #-}
 {-# OPTIONS_GHC -Wno-incomplete-patterns #-}
 module Gyehoek.CPS.Lower
-  ( lower
-  ) where
+  (
+  lower) where
 
 import Gyehoek.CPS.Syntax
 import Data.Generics.Labels
@@ -27,6 +27,7 @@ import Gyehoek.Scheme.Syntax (Lit(LitInt))
 import Text.Printf
 import qualified Data.Text as T
 import qualified Data.Vector.Strict as V
+import Data.IntMap.Strict (IntMap)
 
 
 type Emit = Writer (Vector Text)
@@ -64,6 +65,18 @@ tshow = T.pack . show
 
 
 
+data Module = MkModule
+  { funcs :: IntMap Func
+  }
+  deriving (Show, Generic)
+
+data Func = MkFunc
+  { code :: Text
+  }
+  deriving (Show, Generic)
+
+
+
 lowerVal :: Env -> Val -> Vector Text
 
 lowerVal g (ValLit l) =
@@ -75,11 +88,11 @@ lowerVal g (ValVar x) = [ "local.get " <> tshow i ]
   where
     i = V.elemIndex x g.vars ^?! _Just
 
-lower :: Env -> Exp -> Vector Text
+lower' :: Env -> Exp -> Vector Text
 
-lower g (Halt [e]) = lowerVal g e
+lower' g (Halt [e]) = lowerVal g e
 
-lower g (ExpPrim p rs es) =
+lower' g (ExpPrim p rs es) =
   case p of
     PrimAdd x y -> lowerBinOp "i32.add" g x y r e
     PrimMul x y -> lowerBinOp "i32.mul" g x y r e
@@ -91,7 +104,7 @@ lowerBinOp op g x y r e =
   lowerVal g x
   <> lowerVal g y
   <> [ op, "local.set " <> tshow n ]
-  <> lower g' e
+  <> lower' g' e
   where
     g' = g & #vars <>~ [r]
     n = length (g ^. #vars)
@@ -106,3 +119,6 @@ makeFunc = (preamble<>) . (<>postamble) . T.unlines . toList . fmap indent
                 \  (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