haskell/step2_eval.hs

   1 import System.IO (hFlush, stdout)
   2 import Control.Monad (mapM)
   3 import Control.Monad.Error (runErrorT)
   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 <- runErrorT $ 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