driverslop

app/Main.hs

@@ -1,6 +1,7 @@
 {-# LANGUAGE OverloadedLabels #-}
 {-# LANGUAGE OverloadedLists #-}
 {-# LANGUAGE ViewPatterns #-}
+{-# LANGUAGE OrPatterns #-}
 module Main
   (main)
   where
@@ -8,7 +9,7 @@ module Main
 import Gyehoek.Options
 import qualified Data.Text.IO as TIO
 import Data.Text (Text)
-import Prelude hiding (readFile, (.),id)
+import Prelude hiding (readFile)
 import Options.Applicative
 import Control.Lens
 import Data.Generics.Labels
@@ -29,6 +30,12 @@ import qualified Data.Text.Encoding as T
 import System.IO (Handle)
 import Data.List.NonEmpty (NonEmpty)
 import qualified Cradle as C
+import Gyehoek.CPS.Convert
+import Gyehoek.CPS.Lower
+import Data.Foldable
+import qualified Gyehoek.Scheme.Syntax
+import Gyehoek.CPS.Syntax
+import Data.Maybe (fromMaybe)
 
 
 main :: IO ()
@@ -50,10 +57,28 @@ 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
+withFile
+  :: (FileSystem :> es)
+  => FilePath -> FS.IOMode -> (Handle -> Eff es a) -> Eff es a
+withFile "-" FS.ReadMode k = k FS.stdin
+withFile "-" (FS.WriteMode; FS.AppendMode) k = k FS.stdout
+withFile f m k = FS.withFile f m k
+
+readScm :: FileSystem :> es => FilePath -> Eff es Scm.Exp
+readScm f =
+  withFile f FS.ReadMode $ \h ->
+    Sexp.parseSexps f <$> hGetContents h
+     >>= either error wrap
+  where
+    wrap [x] = pure x
+    wrap xs = pure . Gyehoek.Scheme.Syntax.ExpBegin $ xs
 
 driver
   :: (GenSym :> es, FileSystem :> es, IOE :> es)
   => Options -> Eff es ()
-driver = _
+driver opts = do
+  scm <- readScm opts.sourceFile
+  cps <- convert scm (pure . Halt1)
+  wat <- lower cps
+  withFile opts.output FS.WriteMode \h ->
+    hPutStr h wat