Interpreter

.gitignore

@@ -1,3 +1,3 @@
 *.o
 *.hi
-parser
+lisp

compile

@@ -1 +1 @@
-ghc -package parsec -fglasgow-exts -o parser --make scheme.hs
+ghc -package parsec -fglasgow-exts -o lisp --make scheme.hs

scheme.hs

@@ -1,3 +1,4 @@
+import IO hiding (try)
 import System.Environment
 import Text.ParserCombinators.Parsec hiding (spaces)
 import Control.Monad
@@ -302,6 +303,30 @@ trapError action = catchError action (return . show)
 extractValue :: ThrowsError a -> a
 extractValue (Right val) = val
 
+-- Console Loop
+
+flushStr :: String -> IO()
+flushStr str = putStr str >> hFlush stdout
+
+readPrompt :: String -> IO String
+readPrompt prompt = flushStr prompt >> getLine
+
+evalString :: String -> IO String
+evalString expr = return $ extractValue $ trapError (liftM show $ readExpr expr >>= eval)
+
+evalAndPrint :: String -> IO ()
+evalAndPrint expr = evalString expr >>= putStrLn
+
+until_ :: Monad m => (a -> Bool) -> m a -> (a -> m ()) -> m ()
+until_ pred prompt action = do
+    result <- prompt 
+    if pred result
+        then return()
+        else action result >> until_ pred prompt action
+
+runRepl :: IO ()
+runRepl = until_ (== "quit") (readPrompt "Lisp>>> ") evalAndPrint
+
 -- Main
 readExpr :: String -> ThrowsError LispVal
 readExpr input = case parse parseExpr "lisp" input of 
@@ -311,6 +336,7 @@ readExpr input = case parse parseExpr "lisp" input of
 main :: IO ()
 main = do 
     args <- getArgs
-    evaled <- return $ liftM show $ readExpr (args !! 0) >>= eval
-    putStrLn $ extractValue $ trapError evaled
-
+    case length args of
+        0 -> runRepl
+        1 -> evalAndPrint $ args !! 0
+        otherwise -> putStrLn "Program takes only 0 or 1 argument"