This commit is contained in:
2026-07-11 16:25:58 -06:00
parent 475f0a7f68
commit d71d78c68f
24 changed files with 458 additions and 120 deletions
+3 -81
View File
@@ -1,84 +1,6 @@
{-# LANGUAGE OverloadedLabels #-}
{-# LANGUAGE OverloadedLists #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE OrPatterns #-}
module Main
(main)
where
module Main (main) where
import Gyehoek.Options
import qualified Data.Text.IO as TIO
import Data.Text (Text)
import Prelude hiding (readFile)
import Options.Applicative
import Control.Lens
import Data.Generics.Labels
import System.OsPath (OsPath)
import System.FilePath ((-<.>), dropExtension)
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, gensym, 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 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
import Gyehoek.CPS.Convert
import Gyehoek.CPS.Lower
import Data.Foldable
import qualified Gyehoek.Scheme.Syntax
import Gyehoek.CPS.Syntax
import Data.Maybe (fromMaybe)
import Gyehoek.Driver qualified
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
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
readFile :: FileSystem :> es => FilePath -> Eff es Text
readFile f = FS.withFile f FS.ReadMode hGetContents
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 opts = do
scm <- readScm opts.sourceFile
cps <- convert scm (pure . Halt1)
wat <- lower cps
withFile opts.output FS.WriteMode \h ->
hPutStr h wat
main = Gyehoek.Driver.main