callQBE

app/Main.hs

@@ -1,4 +1,5 @@
 {-# LANGUAGE OverloadedLabels #-}
+{-# LANGUAGE OverloadedLists #-}
 module Main
   (main)
   where
@@ -19,7 +20,7 @@ import Effectful.FileSystem
 import Effectful
 import Effectful.FileSystem.IO qualified as FS
 import Effectful.FileSystem.IO.ByteString qualified as FB
-import Gyehoek.GenSym (runGenSym, GenSym)
+import Gyehoek.GenSym (runGenSym, GenSym, gensym, gensym')
 import qualified Gyehoek.Sexp as Sexp
 import Data.Text.Lens
 import Data.List (List)
@@ -29,6 +30,8 @@ import qualified Gyehoek.QBE as QBE
 import qualified Data.Text as T
 import qualified Data.Text.Encoding as T
 import System.IO (Handle)
+import Data.List.NonEmpty (NonEmpty)
+import qualified Cradle as C
 
 
 main :: IO ()
@@ -41,6 +44,9 @@ main = do
 hPutStr :: FileSystem :> es => Handle -> Text -> Eff es ()
 hPutStr h = FB.hPutStr h . T.encodeUtf8
 
+hPutStrLn :: FileSystem :> es => Handle -> Text -> Eff es ()
+hPutStrLn h = FB.hPutStrLn h . T.encodeUtf8
+
 hGetContents :: FileSystem :> es => Handle -> Eff es Text
 hGetContents h = T.decodeUtf8 <$> FB.hGetContents h
 
@@ -62,11 +68,39 @@ toANF f exps = do
       FS.withFile anf_file FS.WriteMode \h_anf -> do
         hPutStr h_anf ";;; -*- mode:scheme -*-\n\n"
         hPutStr h_anf $ foldr (\x y -> x <> "\n\n" <> y) "" ss
-      hPutStr FS.stderr $ "wrote " <> T.pack anf_file
+      hPutStrLn FS.stderr $ "wrote " <> T.pack anf_file
   pure anfs
 
-driver :: (GenSym :> es, FileSystem :> es) => Options -> Eff es ()
+toQBE
+  :: (GenSym :> es, FileSystem :> es, Traversable t)
+  => FilePath -> t ANF.Exp -> Eff es QBE.Program
+toQBE f anfs = do
+  p <- ANF.lowerProgram anfs
+  let qbe_file = f -<.> "ssa"
+  FS.withFile qbe_file FS.WriteMode \h -> do
+    hPutStr h . render $ p
+  hPutStrLn FS.stderr $ "wrote " <> T.pack qbe_file
+  pure p
+
+callQBE
+  :: (GenSym :> es, FileSystem :> es, IOE :> es)
+  => FilePath -> Eff es FilePath
+callQBE f = do
+  let asm_file = f -<.> "s"
+      qbe_file = f -<.> "ssa"
+  C.StdoutTrimmed stdout <-
+    C.run $ C.cmd "qbe" & C.addArgs [qbe_file]
+  FS.withFile asm_file FS.WriteMode \h -> do
+    hPutStr h stdout
+  hPutStrLn FS.stderr $ "wrote " <> T.pack asm_file
+  pure asm_file
+
+driver
+  :: (GenSym :> es, FileSystem :> es, IOE :> es)
+  => Options -> Eff es ()
 driver = runGenSym . traverseOf_ (#sourceFiles . folded) \f -> do
   exps <- readScm f
   anfs <- toANF f exps
+  qbe <- toQBE f anfs
+  callQBE f
   pure ()