2024-06-04 18:45:06 +02:00
|
|
|
|
module Main where
|
|
|
|
|
|
2024-06-10 22:14:40 +02:00
|
|
|
|
import Text.Megaparsec.Error (errorBundlePretty)
|
|
|
|
|
|
|
|
|
|
import System.Environment
|
|
|
|
|
import System.IO
|
|
|
|
|
import System.Exit
|
|
|
|
|
import qualified Data.Text.IO as T
|
|
|
|
|
import Control.Monad ((<=<))
|
|
|
|
|
|
|
|
|
|
import Parse (parseExpr)
|
|
|
|
|
import Type (infer)
|
|
|
|
|
import CompChez (comp)
|
|
|
|
|
import Eval (eval)
|
|
|
|
|
|
2024-06-04 18:45:06 +02:00
|
|
|
|
main :: IO ()
|
2024-06-10 22:14:40 +02:00
|
|
|
|
main = getArgs >>= \case
|
|
|
|
|
[] -> processFile "stdin" stdin
|
|
|
|
|
xs -> mapM_ (\file -> processFile file =<< openFile file ReadMode) xs
|
|
|
|
|
|
|
|
|
|
putStyle :: String -> IO () -- bold blue :)
|
|
|
|
|
putStyle s = putStrLn ("\x1b[38;5;87m\x1b[1m=>> " ++ s ++ "\x1b[0m")
|
|
|
|
|
|
|
|
|
|
processFile :: String -> Handle -> IO ()
|
|
|
|
|
processFile f h = do
|
|
|
|
|
contents <- T.hGetContents h
|
|
|
|
|
case parseExpr f contents of
|
|
|
|
|
Left e -> putStrLn (errorBundlePretty e)
|
|
|
|
|
Right ast -> do
|
|
|
|
|
putStyle "Parse Successful"
|
|
|
|
|
print ast
|
|
|
|
|
putStyle "Type Checking / Inferring"
|
|
|
|
|
case infer [] ast of
|
|
|
|
|
Nothing -> putStrLn "=> Type error" >> exitWith (ExitFailure 1)
|
|
|
|
|
Just t -> print t
|
|
|
|
|
putStyle "Compiling to Chez"
|
|
|
|
|
putStrLn (comp ast)
|
|
|
|
|
putStyle "Evaluating"
|
|
|
|
|
print (eval [] ast)
|
|
|
|
|
|
|
|
|
|
|