callQBE

app/Gyehoek/ANF/Syntax.hs

@@ -11,6 +11,8 @@ module Gyehoek.ANF.Syntax
   ( Exp(..)
   , toANF
   , lower
+  , wrapFunction
+  , lowerProgram
   )
   where
 
@@ -29,13 +31,13 @@ import Gyehoek.Scheme.Syntax (Name, Prim(..), Lit(..))
 import Gyehoek.GenSym
 import Control.Monad.Cont
 import Data.Foldable
-import Data.List.NonEmpty (NonEmpty((:|)), toList)
+import Data.List.NonEmpty (NonEmpty((:|)))
 import Data.List.NonEmpty qualified as NE
 import Gyehoek.QBE (FuncDef(FuncDef))
 import Data.Foldable1
 import qualified Data.Text as T
 import Data.String (fromString)
-import Language.SexpGrammar as Sexp hiding (List, iso, encode, decode)
+import Language.SexpGrammar as Sexp hiding (List, iso, encode, decode, traversed)
 import Language.SexpGrammar.Generic
 import GHC.Generics (Generic)
 import Gyehoek.Sexp
@@ -414,6 +416,34 @@ lower' _ k = _
 lower :: GenSym :> es => QBE.Ident QBE.Label -> Exp -> Eff es QBE.Block
 lower n e = buildBlock n <$> lower' e (pure . Exit . QBE.Ret . Just)
 
+lowerProgram 
+  :: (GenSym :> es, Traversable t)
+  => t Exp -> Eff es QBE.Program
+lowerProgram anfs =
+  case toList anfs of
+    -- hack for dev convenience: if there's only one expression, let
+    -- it be the entry point.
+    [e] -> do
+      b <- lower "start" e
+      let f = wrapFunction @NonEmpty "main" [b]
+      pure $ QBE.Program [] [] [f]
+    _ -> do
+      let low e = do
+            bl <- gensym' "b"
+            fl <- gensym' "f"
+            b <- lower bl e
+            pure $ wrapFunction @NonEmpty fl [b]
+      fs <- traverse low anfs
+      pure $ QBE.Program [] [] (fs ^.. traversed)
+
+wrapFunction
+  :: Foldable1 t
+  => QBE.Ident 'QBE.Global -> t QBE.Block -> QBE.FuncDef
+wrapFunction l bs =
+  QBE.FuncDef [QBE.Export]
+    (Just (QBE.AbiBaseTy QBE.Word))
+    l Nothing [] QBE.NoVariadic (toNonEmpty bs)
+
 wrapProgram :: Foldable1 t => t QBE.Block -> QBE.Program
 wrapProgram bs = prims <> QBE.Program [] [] [main] where
   main = QBE.FuncDef [QBE.Export]