Haskell: add error handling and try*/catch*.

Achieve self-hosting!

1 files changed, 20 insertions, 15 deletions

diff --git a/haskell/step2_eval.hs b/haskell/step2_eval.hs
index bdc7d28..9105737 100644
--- a/haskell/step2_eval.hs
+++ b/haskell/step2_eval.hs
@@ -1,5 +1,6 @@
-import Control.Monad (when, mapM)
-import Control.Monad.Error (throwError)
+import System.IO (hFlush, stdout)
+import Control.Monad (mapM)
+import Control.Monad.Error (runErrorT)
 import qualified Data.Map as Map
 import qualified Data.Traversable as DT
 
@@ -9,14 +10,14 @@ import Reader (read_str)
 import Printer (_pr_str)
 
 -- read
-mal_read :: String -> IO MalVal
+mal_read :: String -> IOThrows MalVal
 mal_read str = read_str str
 
 -- eval
-eval_ast :: MalVal -> (Map.Map String MalVal) -> IO MalVal
+eval_ast :: MalVal -> (Map.Map String MalVal) -> IOThrows MalVal
 eval_ast (MalSymbol sym) env = do
     case Map.lookup sym env of
-         Nothing -> error $ "'" ++ sym ++ "' not found"
+         Nothing -> throwStr $ "'" ++ sym ++ "' not found"
          Just v  -> return v
 eval_ast ast@(MalList lst m) env = do
     new_lst <- mapM (\x -> (eval x env)) lst
@@ -29,16 +30,16 @@ eval_ast ast@(MalHashMap lst m) env = do
     return $ MalHashMap new_hm m
 eval_ast ast env = return ast
 
-apply_ast :: MalVal -> (Map.Map String MalVal) -> IO MalVal
+apply_ast :: MalVal -> (Map.Map String MalVal) -> IOThrows MalVal
 apply_ast ast@(MalList _ _) env = do
     el <- eval_ast ast env
     case el of
          (MalList ((Func (Fn f) _) : rest) _) ->
             f $ rest
          el ->
-            error $ "invalid apply: " ++ (show el)
+            throwStr $ "invalid apply: " ++ (show el)
 
-eval :: MalVal -> (Map.Map String MalVal) -> IO MalVal
+eval :: MalVal -> (Map.Map String MalVal) -> IOThrows MalVal
 eval ast env = do
     case ast of
          (MalList _ _) -> apply_ast ast env
@@ -51,13 +52,13 @@ mal_print exp = show exp
 
 -- repl
 add [MalNumber a, MalNumber b] = return $ MalNumber $ a + b
-add _ = error $ "illegal arguments to +"
+add _ = throwStr $ "illegal arguments to +"
 sub [MalNumber a, MalNumber b] = return $ MalNumber $ a - b
-sub _ = error $ "illegal arguments to -"
+sub _ = throwStr $ "illegal arguments to -"
 mult [MalNumber a, MalNumber b] = return $ MalNumber $ a * b
-mult _ = error $ "illegal arguments to *"
+mult _ = throwStr $ "illegal arguments to *"
 divd [MalNumber a, MalNumber b] = return $ MalNumber $ a `div` b
-divd _ = error $ "illegal arguments to /"
+divd _ = throwStr $ "illegal arguments to /"
 
 repl_env :: Map.Map String MalVal
 repl_env = Map.fromList [("+", _func add),
@@ -65,7 +66,7 @@ repl_env = Map.fromList [("+", _func add),
                          ("*", _func mult),
                          ("/", _func divd)]
 
-rep :: String -> IO String
+rep :: String -> IOThrows String
 rep line = do
     ast <- mal_read line
     exp <- eval ast repl_env
@@ -78,9 +79,13 @@ repl_loop = do
         Nothing -> return ()
         Just "" -> repl_loop
         Just str -> do
-            out <- catchAny (rep str) $ \e -> do
-                return $ "Error: " ++ (show e)
+            res <- runErrorT $ rep str
+            out <- case res of
+                Left (StringError str) -> return $ "Error: " ++ str
+                Left (MalValError mv) -> return $ "Error: " ++ (show mv)
+                Right val -> return val
             putStrLn out
+            hFlush stdout
             repl_loop
 
 main = do