module Main where import Data.Char import Data.List import System.Console.Readline import System.Environment import System.Exit import System.IO.Error import Compiler import Interpreter import Optimiser import Parser import Stdlib import VM usage :: IO () usage = do progname <- getProgName putStrLn $ "Usage: " ++ progname ++ " [filename.lisp]" repl :: Context -> IO () repl ctx = do mline <- fmap (fmap strip) (readline "> ") case mline of Nothing -> putStrLn "" Just "" -> repl ctx Just (';' : _) -> repl ctx Just line -> do addHistory line case parseExpression line of Right val -> do ires <- interpret ctx val case ires of Right (retval, ctx') -> do putStrLn $ "\x1B[36m" ++ show retval ++ "\x1B[0m" repl ctx' Left err -> do putStrLn $ "\x1B[31;1mError: " ++ err ++ "\x1B[0m" repl ctx Left err -> do putStrLn $ "\x1B[31;1mParse error:\n" ++ show err ++ "\x1B[0m" repl ctx runFile :: String -> Context -> IO () runFile fname ctx = do source <- readFile fname case parseProgram source of Right ast -> do res <- interpretProgram ctx ast case res of Right _ -> return () Left err -> die $ "Error: " ++ err Left err -> die $ "Parse error:\n" ++ show err strip :: String -> String strip = dropWhileEnd isSpace . dropWhile isSpace handleEOFError :: IO () -> IO () handleEOFError op = catchIOError op (\e -> if isEOFError e then putStrLn "" else ioError e) -- main :: IO () -- main = do -- clargs <- getArgs -- Right ctx <- interpretProgram newContext stdlib -- case clargs of -- [] -> handleEOFError (repl ctx) -- [fname] -> runFile fname ctx -- _ -> usage >> exitFailure main :: IO () main = do clargs <- getArgs source <- case clargs of [] -> getContents [fname] -> readFile fname _ -> usage >> exitFailure prog <- either (die . show) return (parseProgram source) irprog <- either die return (compileProgram prog) let opt = optimise irprog -- print opt vmRun opt