blob: 18e1c53d8ad140ca99a24c8cefbb6dfd3973a0f7 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
|
module Main where
import Control.Monad (liftM)
import Control.Monad.Except (liftIO, runExceptT, throwError)
import Environment
import Error.Base (LispError (..), LispResult (..),
unwrap)
import Error.Pretty (defaults, showError)
import Evaluator (eval)
import Parser (Expr (..), parseLispValue)
import System.Console.Readline
import System.Environment (getArgs)
import Text.ParserCombinators.Parsec
readExpr :: String -> LispResult Expr
readExpr inp =
case parse parseLispValue "(lisk-repl)" inp of
Left err -> throwError $ Parse err
Right val -> return val
evalExpr :: Env -> String -> IO (LispResult String)
evalExpr env inp = runExceptT $ fmap show $
liftLispResult (readExpr inp) >>= eval env
repl :: Env -> IO ()
repl env = do
let pp = showError defaults
inp <- readline "† "
case inp of
Nothing -> return ()
Just ",q" -> return ()
Just i -> evalExpr env i >>= either (putStrLn . pp i) putStrLn >> repl env
main :: IO ()
main = do
args <- getArgs
env <- newEnv
if null args
then do
putStrLn ";;; Entering lisk repl ..."
repl env
else do
let pp = showError defaults "(lisk-repl)"
evalExpr env (head args) >>= either (putStrLn . pp) print
|
