haskell/step2_eval.hs

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