From 897fb17dd6a045a7056e6d6babbbb24748f698f6 Mon Sep 17 00:00:00 2001
From: tomsmeding <tom.smeding@gmail.com>
Date: Sat, 9 Dec 2017 10:48:58 +0100
Subject: Initial

---
 main.hs | 84 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 84 insertions(+)
 create mode 100644 main.hs

(limited to 'main.hs')

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
-- 
cgit v1.2.3-54-g00ecf