73 lines
2.2 KiB
Haskell
73 lines
2.2 KiB
Haskell
{-# LANGUAGE OverloadedLabels #-}
|
|
module Main
|
|
(main)
|
|
where
|
|
|
|
import qualified Gyehoek.ANF.Syntax as ANF
|
|
import Gyehoek.QBE (render)
|
|
import Gyehoek.Options
|
|
import qualified Data.Text.IO as TIO
|
|
import Data.Text (Text)
|
|
import Prelude hiding (readFile, (.),id)
|
|
import Control.Category
|
|
import Options.Applicative
|
|
import Control.Lens
|
|
import Data.Generics.Labels
|
|
import System.OsPath (OsPath)
|
|
import System.FilePath ((-<.>))
|
|
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 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 <- execParser $ info (helper <*> parser) fullDesc
|
|
runEff . runFileSystem . runGenSym . driver $ opts
|
|
|
|
|
|
|
|
hPutStr :: FileSystem :> es => Handle -> Text -> Eff es ()
|
|
hPutStr h = FB.hPutStr h . T.encodeUtf8
|
|
|
|
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
|
|
|
|
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 $ 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 ()
|