Browse Source

Interpreter

master
parent
commit
f6d5d0e79c
  1. 2
      .gitignore
  2. 2
      compile
  3. 32
      scheme.hs

2
.gitignore

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

2
compile

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

32
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"

Loading…
Cancel
Save