summaryrefslogtreecommitdiff
path: root/main.hs
diff options
context:
space:
mode:
Diffstat (limited to 'main.hs')
-rw-r--r--main.hs84
1 files changed, 84 insertions, 0 deletions
diff --git a/main.hs b/main.hs
new file mode 100644
index 0000000..51e5815
--- /dev/null
+++ b/main.hs
@@ -0,0 +1,84 @@
+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