| | 1 | import System.IO (hFlush, stdout) |
| | 2 | import Control.Monad (mapM) |
| | 3 | import Control.Monad.Except (runExceptT) |
| | 4 | import qualified Data.Map as Map |
| | 5 | import qualified Data.Traversable as DT |
| | 6 | |
| | 7 | import Readline (readline, load_history) |
| | 8 | import Types |
| | 9 | import Reader (read_str) |
| | 10 | import Printer (_pr_str) |
| | 11 | |
| | 12 | -- read |
| | 13 | mal_read :: String -> IOThrows MalVal |
| | 14 | mal_read str = read_str str |
| | 15 | |
| | 16 | -- eval |
| | 17 | eval_ast :: MalVal -> (Map.Map String MalVal) -> IOThrows MalVal |
| | 18 | eval_ast (MalSymbol sym) env = do |
| | 19 | case Map.lookup sym env of |
| | 20 | Nothing -> throwStr $ "'" ++ sym ++ "' not found" |
| | 21 | Just v -> return v |
| | 22 | eval_ast ast@(MalList lst m) env = do |
| | 23 | new_lst <- mapM (\x -> (eval x env)) lst |
| | 24 | return $ MalList new_lst m |
| | 25 | eval_ast ast@(MalVector lst m) env = do |
| | 26 | new_lst <- mapM (\x -> (eval x env)) lst |
| | 27 | return $ MalVector new_lst m |
| | 28 | eval_ast ast@(MalHashMap lst m) env = do |
| | 29 | new_hm <- DT.mapM (\x -> (eval x env)) lst |
| | 30 | return $ MalHashMap new_hm m |
| | 31 | eval_ast ast env = return ast |
| | 32 | |
| | 33 | apply_ast :: MalVal -> (Map.Map String MalVal) -> IOThrows MalVal |
| | 34 | apply_ast ast@(MalList [] _) env = do |
| | 35 | return ast |
| | 36 | apply_ast ast@(MalList _ _) env = do |
| | 37 | el <- eval_ast ast env |
| | 38 | case el of |
| | 39 | (MalList ((Func (Fn f) _) : rest) _) -> |
| | 40 | f $ rest |
| | 41 | el -> |
| | 42 | throwStr $ "invalid apply: " ++ (show el) |
| | 43 | |
| | 44 | eval :: MalVal -> (Map.Map String MalVal) -> IOThrows MalVal |
| | 45 | eval ast env = do |
| | 46 | case ast of |
| | 47 | (MalList _ _) -> apply_ast ast env |
| | 48 | _ -> eval_ast ast env |
| | 49 | |
| | 50 | |
| | 51 | -- print |
| | 52 | mal_print :: MalVal -> String |
| | 53 | mal_print exp = show exp |
| | 54 | |
| | 55 | -- repl |
| | 56 | add [MalNumber a, MalNumber b] = return $ MalNumber $ a + b |
| | 57 | add _ = throwStr $ "illegal arguments to +" |
| | 58 | sub [MalNumber a, MalNumber b] = return $ MalNumber $ a - b |
| | 59 | sub _ = throwStr $ "illegal arguments to -" |
| | 60 | mult [MalNumber a, MalNumber b] = return $ MalNumber $ a * b |
| | 61 | mult _ = throwStr $ "illegal arguments to *" |
| | 62 | divd [MalNumber a, MalNumber b] = return $ MalNumber $ a `div` b |
| | 63 | divd _ = throwStr $ "illegal arguments to /" |
| | 64 | |
| | 65 | repl_env :: Map.Map String MalVal |
| | 66 | repl_env = Map.fromList [("+", _func add), |
| | 67 | ("-", _func sub), |
| | 68 | ("*", _func mult), |
| | 69 | ("/", _func divd)] |
| | 70 | |
| | 71 | rep :: String -> IOThrows String |
| | 72 | rep line = do |
| | 73 | ast <- mal_read line |
| | 74 | exp <- eval ast repl_env |
| | 75 | return $ mal_print exp |
| | 76 | |
| | 77 | repl_loop :: IO () |
| | 78 | repl_loop = do |
| | 79 | line <- readline "user> " |
| | 80 | case line of |
| | 81 | Nothing -> return () |
| | 82 | Just "" -> repl_loop |
| | 83 | Just str -> do |
| | 84 | res <- runExceptT $ rep str |
| | 85 | out <- case res of |
| | 86 | Left (StringError str) -> return $ "Error: " ++ str |
| | 87 | Left (MalValError mv) -> return $ "Error: " ++ (show mv) |
| | 88 | Right val -> return val |
| | 89 | putStrLn out |
| | 90 | hFlush stdout |
| | 91 | repl_loop |
| | 92 | |
| | 93 | main = do |
| | 94 | load_history |
| | 95 | repl_loop |
HCoop / jackhill / mal.git / blame_incremental