driver

app/Gyehoek/ANF/Syntax.hs

@@ -8,7 +8,10 @@
 {-# OPTIONS_GHC -Wno-orphans -Wno-unused-matches -Wno-missing-signatures #-}
 {- HLINT ignore "Avoid lambda using `infix`" -}
 module Gyehoek.ANF.Syntax
-  (toANF, lower)
+  ( Exp(..)
+  , toANF
+  , lower
+  )
   where
 
 import Data.Text (Text)

app/Main.hs

@@ -17,38 +17,56 @@ import System.OsPath (OsPath)
 import System.FilePath ((-<.>))
 import Effectful.FileSystem
 import Effectful
-import Effectful.FileSystem.IO
-import Gyehoek.GenSym (runGenSym)
+import Effectful.FileSystem.IO qualified as FS
+import Effectful.FileSystem.IO.ByteString qualified as FB
+import Gyehoek.GenSym (runGenSym, GenSym)
 import qualified Gyehoek.Sexp as Sexp
 import Data.Text.Lens
 import Data.List (List)
 import qualified Gyehoek.Scheme.Syntax as Scm
 import Effectful.Exception
+import qualified Gyehoek.QBE as QBE
+import qualified Data.Text as T
+import qualified Data.Text.Encoding as T
+import System.IO (Handle)
 
 
 main :: IO ()
 main = do
-  opts <- info (helper <*> parser) (fullDesc)
-  runEff . runFileSystem . driver $ opts
+  opts <- execParser $ info (helper <*> parser) fullDesc
+  runEff . runFileSystem . runGenSym . driver $ opts
 
 
 
-hPutStr :: IOE :> es => Handle -> Text -> Eff es ()
-hPutStr h = liftIO . TIO.hPutStr h
+hPutStr :: FileSystem :> es => Handle -> Text -> Eff es ()
+hPutStr h = FB.hPutStr h . T.encodeUtf8
 
-readFile :: IOE :> es => FilePath -> Eff es Text
-readFile = liftIO . TIO.readFile
+hGetContents :: FileSystem :> es => Handle -> Eff es Text
+hGetContents h = T.decodeUtf8 <$> FB.hGetContents h
+
+readFile :: FileSystem :> es => FilePath -> Eff es Text
+readFile f = FS.withFile f FS.ReadMode hGetContents
 
 readScm :: FileSystem :> es => FilePath -> Eff es (List Scm.Exp)
 readScm f = (Sexp.parseSexps f <$> readFile f) >>= either error pure
 
-driver :: FileSystem :> es => Options -> Eff es ()
-driver = runGenSym . traverseOf_ (#sourceFiles . folded) \f ->
-  withFile f ReadMode \h_scm ->
-    (Sexp.encode <$> ANF.toANF _) >>= \case
-      Left e -> hPutStr stderr (view packed e)
-      Right s ->
-        withFile (f -<.> "anf") WriteMode \h_anf -> do
+toANF
+  :: (GenSym :> es, FileSystem :> es)
+  => FilePath -> List Scm.Exp -> Eff es (List ANF.Exp)
+toANF f exps = do
+  anfs <- traverse ANF.toANF exps
+  case traverse Sexp.encode anfs of
+    Left e -> hPutStr FS.stderr (view packed e)
+    Right ss -> do
+      let anf_file = f -<.> "anf"
+      FS.withFile anf_file FS.WriteMode \h_anf -> do
         hPutStr h_anf ";;; -*- mode:scheme -*-\n\n"
-          hPutStr h_anf s
+        hPutStr h_anf $ foldr (\x y -> x <> "\n\n" <> y) "" ss
+      hPutStr FS.stderr $ "wrote " <> T.pack anf_file
+  pure anfs
 
+driver :: (GenSym :> es, FileSystem :> es) => Options -> Eff es ()
+driver = runGenSym . traverseOf_ (#sourceFiles . folded) \f -> do
+  exps <- readScm f
+  anfs <- toANF f exps
+  pure ()

play/t.anf

@@ -0,0 +1,4 @@
+;;; -*- mode:scheme -*-
+
+(let ((x0 (prim:write 4))) x0)
+

play/t.scm

@@ -0,0 +1 @@
+(prim:write 4)