Haskell: steps 4-6. Line editing. Simpler fn calls.

14 files changed, 774 insertions, 128 deletions

diff --git a/haskell/Core.hs b/haskell/Core.hs
new file mode 100644
index 0000000..9849ddb
--- /dev/null
+++ b/haskell/Core.hs
@@ -0,0 +1,113 @@
+module Core
+( ns )
+where
+
+import qualified Data.Map as Map
+
+import Reader (read_str)
+import Types
+import Printer (_pr_str, _pr_list)
+
+-- General functions
+
+equal_Q args = case args of
+    [a, b] -> return $ if a == b then MalTrue else MalFalse
+    _ -> error $ "illegal arguments to ="
+
+run_1 :: (MalVal -> MalVal) -> [MalVal] -> IO MalVal
+run_1 f args = do
+    case args of
+         (x:[]) -> return $ f x
+         _ -> error $ "function takes a single argument"
+
+
+-- String functions
+
+pr_str args = do
+    return $ MalString $ _pr_list True " " args
+
+str args = do
+    return $ MalString $ _pr_list False "" args
+
+prn args = do
+    putStrLn $ _pr_list True " " args
+    return Nil
+
+println args = do
+    putStrLn $ _pr_list False " " args
+    return Nil
+
+slurp args = do
+    case args of
+        ([MalString path]) -> do
+            str <- readFile path
+            return $ MalString str
+        _ -> error $ "invalid arguments to slurp"
+
+-- Numeric functions
+
+num_op op args = case args of
+    [MalNumber a, MalNumber b] -> return $ MalNumber $ op a b
+    _ -> error $ "illegal arguments to number operation"
+
+cmp_op op args = case args of
+    [MalNumber a, MalNumber b] ->
+        return $ if op a b then MalTrue else MalFalse
+    _ -> error $ "illegal arguments to comparison operation"
+
+
+-- List functions
+
+list args = do
+    return $ MalList args
+
+-- Vector functions
+
+vector args = do
+    return $ MalVector args
+
+-- Hash Map functions
+
+hash_map args = do
+    return $ MalHashMap $ Map.fromList $ _pairs args
+
+-- Sequence functions
+
+empty_Q Nil            = MalTrue
+empty_Q (MalList [])   = MalTrue
+empty_Q (MalVector []) = MalTrue
+empty_Q _              = MalFalse
+
+count Nil             = MalNumber 0
+count (MalList lst)   = MalNumber $ length lst
+count (MalVector lst) = MalNumber $ length lst
+count _ = error $ "non-sequence passed to count"
+
+
+ns = [
+    ("=",  _func equal_Q),
+
+    ("pr-str", _func pr_str),
+    ("str", _func str),
+    ("prn", _func prn),
+    ("println", _func println),
+    ("read-string", _func (\[(MalString s)] -> read_str s)),
+    ("slurp", _func slurp),
+    ("<",  _func $ cmp_op (<)),
+    ("<=", _func $ cmp_op (<=)),
+    (">",  _func $ cmp_op (>)),
+    (">=", _func $ cmp_op (>=)),
+    ("+",  _func $ num_op (+)),
+    ("-",  _func $ num_op (-)),
+    ("*",  _func $ num_op (*)),
+    ("/",  _func $ num_op (div)),
+    
+    ("list",     _func $ list),
+    ("list?",    _func $ run_1 _list_Q),
+    ("vector",   _func $ vector),
+    ("vector?",  _func $ run_1 $ _vector_Q),
+    ("hash-map", _func $ hash_map),
+    ("map?",     _func $ run_1 $ _hash_map_Q),
+    
+    ("empty?", _func $ run_1 $ empty_Q) ,
+    ("count", _func $ run_1 $ count)]
diff --git a/haskell/Env.hs b/haskell/Env.hs
index 535f270..9e36a4e 100644
--- a/haskell/Env.hs
+++ b/haskell/Env.hs
@@ -1,5 +1,5 @@
 module Env
-( Env, env_new, null_env, env_get, env_set )
+( Env, env_new, null_env, env_bind, env_get, env_set )
 where
 
 import Data.IORef (IORef, newIORef, readIORef, writeIORef)
@@ -10,9 +10,9 @@ import qualified Data.Map  as Map
 import Types
 import Printer
 
-data EnvData = EnvPair (Maybe Env, (Map.Map String MalVal))
-
-type Env = IORef EnvData
+-- These Env types are defined in Types module to avoid dep cycle
+--data EnvData = EnvPair (Maybe Env, (Map.Map String MalVal))
+--type Env = IORef EnvData
 
 env_new :: Maybe Env -> IO Env
 env_new outer  = newIORef $ EnvPair (outer, (Map.fromList []))
@@ -20,10 +20,19 @@ env_new outer  = newIORef $ EnvPair (outer, (Map.fromList []))
 null_env = env_new Nothing
 
 env_bind :: Env -> [MalVal] -> [MalVal] -> IO Env
-env_bind env binds exprs = do
+env_bind envRef binds exprs = do
     case (elemIndex (MalSymbol "&") binds) of
-        Just idx -> return env
-        Nothing  -> return env
+        Nothing  -> do
+            -- bind binds to exprs
+            _ <- mapM (\(b,e) -> env_set envRef b e) $ zip binds exprs
+            return envRef
+        Just idx -> do
+            -- Varargs binding
+            _ <- mapM (\(b,e) -> env_set envRef b e) $
+                zip (take idx binds) (take idx exprs)
+            _ <- env_set envRef (binds !! (idx + 1))
+                                (MalList (drop idx exprs))
+            return envRef
 
 {-
 isBound :: Env -> MalVal -> IO Bool
diff --git a/haskell/Makefile b/haskell/Makefile
index d43db16..156a7e7 100644
--- a/haskell/Makefile
+++ b/haskell/Makefile
@@ -4,8 +4,9 @@ SOURCES = $(SOURCES_BASE) $(SOURCES_LISP)
 
 #####################
 
-SRCS = step0_repl.hs step1_read_print.hs step2_eval.hs step3_env.hs
-OTHER_SRCS = Types.hs Reader.hs Printer.hs Env.hs
+SRCS = step0_repl.hs step1_read_print.hs step2_eval.hs step3_env.hs \
+       step4_if_fn_do.hs step5_tco.hs step6_file.hs
+OTHER_SRCS = Readline.hs Types.hs Reader.hs Printer.hs Env.hs Core.hs
 BINS = $(SRCS:%.hs=%)
 
 #####################
diff --git a/haskell/Printer.hs b/haskell/Printer.hs
index 94bc5ed..1cc2a97 100644
--- a/haskell/Printer.hs
+++ b/haskell/Printer.hs
@@ -1,13 +1,20 @@
 module Printer
-( _pr_str )
+( _pr_str, _pr_list )
 where
 
 import qualified Data.Map as Map
 
 import Types
 
-_pr_list :: [MalVal] -> String
-_pr_list = unwords . map _pr_str
+--concat (map (++ delim) list)
+--join [] delim = []
+--join (x:xs) delim = x ++ delim  ++ join xs delim
+
+
+_pr_list :: Bool -> String -> [MalVal] -> String
+_pr_list pr sep [] = []
+_pr_list pr sep (x:[]) = (_pr_str pr x)
+_pr_list pr sep (x:xs) = (_pr_str pr x) ++ sep ++ (_pr_list pr sep xs)
 
 _flatTuples ((a,b):xs) = MalString a : b : _flatTuples xs
 _flatTuples _          = []
@@ -18,19 +25,21 @@ unescape chr = case chr of
     '"'  -> "\\\""
     c    -> [c]
 
-_pr_str :: MalVal -> String
-_pr_str (MalString ('\x029e':str)) = ":" ++ str
-_pr_str (MalString str) = "\"" ++ concatMap unescape str ++ "\""
-_pr_str (MalSymbol name) = name
-_pr_str (MalKeyword name) = ":" ++ name
-_pr_str (MalNumber num) = show num
-_pr_str (MalTrue) = "true"
-_pr_str (MalFalse) = "false"
-_pr_str (Nil) = "nil"
-_pr_str (MalList items) = "(" ++ _pr_list items ++ ")"
-_pr_str (MalVector items) = "[" ++ _pr_list items ++ "]"
-_pr_str (MalHashMap m) = "{" ++ _pr_list (_flatTuples $ Map.assocs m) ++ "}"
-_pr_str (MalFunc f) = "#<function>"
-
-instance Show MalVal where show = _pr_str
+_pr_str :: Bool -> MalVal -> String
+_pr_str _     (MalString ('\x029e':str)) = ":" ++ str
+_pr_str True  (MalString str) = "\"" ++ concatMap unescape str ++ "\""
+_pr_str False (MalString str) = str
+_pr_str _     (MalSymbol name) = name
+_pr_str _     (MalKeyword name) = ":" ++ name
+_pr_str _     (MalNumber num) = show num
+_pr_str _     (MalTrue) = "true"
+_pr_str _     (MalFalse) = "false"
+_pr_str _     (Nil) = "nil"
+_pr_str pr    (MalList items) = "(" ++ (_pr_list pr " " items) ++ ")"
+_pr_str pr    (MalVector items) = "[" ++ (_pr_list pr " " items) ++ "]"
+_pr_str pr    (MalHashMap m) = "{" ++ (_pr_list pr " " (_flatTuples $ Map.assocs m)) ++ "}"
+_pr_str _     (Func f) = "#<function>"
+_pr_str _     (MalFunc {ast=ast, env=fn_env, params=params}) = "(fn* " ++ (show params) ++ " " ++ (show ast) ++ ")"
+
+instance Show MalVal where show = _pr_str True
 
diff --git a/haskell/Reader.hs b/haskell/Reader.hs
index 04381f4..8def91c 100644
--- a/haskell/Reader.hs
+++ b/haskell/Reader.hs
@@ -4,14 +4,22 @@ where
 
 import Text.ParserCombinators.Parsec (
     Parser, parse, space, char, digit, letter,
-    (<|>), oneOf, noneOf, many, many1, skipMany1, sepEndBy)
+    (<|>), oneOf, noneOf, many, many1, skipMany, skipMany1, sepEndBy)
 import qualified Data.Map as Map
 import Control.Monad (liftM)
 
 import Types
 
 spaces :: Parser ()
-spaces = skipMany1 (oneOf ", ")
+spaces = skipMany1 (oneOf ", \n")
+
+comment :: Parser ()
+comment = do
+    char ';'
+    skipMany (noneOf "\r\n")
+
+ignored :: Parser ()
+ignored = skipMany (spaces <|> comment)
 
 symbol :: Parser Char
 symbol = oneOf "!#$%&|*+-/:<=>?@^_~"
@@ -61,34 +69,28 @@ read_atom =  read_number
 read_list :: Parser MalVal
 read_list = do
     char '('
-    x <- sepEndBy read_form spaces
+    x <- sepEndBy read_form ignored
     char ')'
     return $ MalList x
 
 read_vector :: Parser MalVal
 read_vector = do
     char '['
-    x <- sepEndBy read_form spaces
+    x <- sepEndBy read_form ignored
     char ']'
     return $ MalVector x
 
--- TODO: propagate error properly
-_pairs [x] = error "Odd number of element for hashmap"
-_pairs [] = []
-_pairs (MalString x:y:xs) = (x,y):_pairs xs
-_pairs (MalKeyword x:y:xs) = ("\x029e" ++ x,y):_pairs xs
-
 read_hash_map :: Parser MalVal
 read_hash_map = do
     char '{'
-    x <- sepEndBy read_form spaces
+    x <- sepEndBy read_form ignored
     char '}'
     return $ MalHashMap $ Map.fromList $ _pairs x
 
 
 read_form :: Parser MalVal
 read_form =  do
-    many spaces
+    ignored
     x <- read_atom <|> read_list <|> read_vector <|> read_hash_map
     return $ x
 
diff --git a/haskell/Readline.hs b/haskell/Readline.hs
new file mode 100644
index 0000000..483c827
--- /dev/null
+++ b/haskell/Readline.hs
@@ -0,0 +1,30 @@
+module Readline
+( readline, load_history )
+where
+
+-- Pick one of these:
+-- GPL license
+import qualified System.Console.Readline as RL
+-- BSD license
+--import qualified System.Console.Editline.Readline as RL
+
+import System.Directory (getHomeDirectory)
+
+history_file = do
+    home <- getHomeDirectory
+    return $ home ++ "/.mal-history"
+
+load_history = do
+    hfile <- history_file
+    content <- readFile hfile
+    mapM RL.addHistory (lines content)
+
+readline prompt = do
+    hfile <- history_file
+    maybeLine <- RL.readline prompt
+    case maybeLine of 
+         Just line -> do
+             appendFile hfile (line ++ "\n")
+             RL.addHistory line
+             return maybeLine
+         _ -> return maybeLine
diff --git a/haskell/Types.hs b/haskell/Types.hs
index bec26be..9a433c5 100644
--- a/haskell/Types.hs
+++ b/haskell/Types.hs
@@ -1,13 +1,15 @@
 module Types
---( MalVal (Nil,MalFalse,MalTrue,MalNumber,MalString,MalSymbol,MalKeyword,MalList,MalVector,MalFunc), _obj_type )
-(MalVal (..), FuncT (..), _malfunc, catchAny)
+(MalVal (..), Fn (..), EnvData (..), Env,
+ catchAny, _pairs, _func, _malfunc, _list_Q, _vector_Q, _hash_map_Q)
 where
 
+import Data.IORef (IORef)
 import qualified Data.Map as Map
-import Control.Exception (SomeException, catch)
+import Control.Exception as CE
 
--- Based Mal types --
-newtype FuncT = FuncT (MalVal -> MalVal)
+
+-- Base Mal types --
+newtype Fn = Fn ([MalVal] -> IO MalVal)
 data MalVal = Nil
             | MalFalse
             | MalTrue
@@ -18,23 +20,39 @@ data MalVal = Nil
             | MalList     [MalVal]
             | MalVector   [MalVal]
             | MalHashMap  (Map.Map String MalVal)
-            | MalFunc     FuncT
-            deriving (Eq)
+            | Func         Fn
+            | MalFunc      {fn :: Fn,
+                            ast :: MalVal,
+                            env :: Env,
+                            params :: MalVal}
+
+_equal_Q Nil Nil = True
+_equal_Q MalFalse MalFalse = True
+_equal_Q MalTrue MalTrue = True
+_equal_Q (MalNumber a) (MalNumber b) = a == b
+_equal_Q (MalString a) (MalString b) = a == b
+_equal_Q (MalSymbol a) (MalSymbol b) = a == b
+_equal_Q (MalKeyword a) (MalKeyword b) = a == b
+_equal_Q (MalList a) (MalList b) = a == b
+_equal_Q (MalList a) (MalVector b) = a == b
+_equal_Q (MalVector a) (MalList b) = a == b
+_equal_Q (MalHashMap a) (MalHashMap b) = a == b
+_equal_Q _ _ = False
 
-instance Eq FuncT where
-    x == y = False
+instance Eq MalVal where
+    x == y = _equal_Q x y
 
-_malfunc f = MalFunc $ FuncT f
 
+-- Env types --
+-- Note: Env functions are in Env module
+data EnvData = EnvPair (Maybe Env, (Map.Map String MalVal))
+type Env = IORef EnvData
 
--- Error definitions --
-catchAny :: IO a -> (SomeException -> IO a) -> IO a
-catchAny = catch
 
 
 ----------------------------------------------------------
 
--- General type functions --
+-- General functions --
 
 _obj_type :: MalVal     -> String
 _obj_type (Nil)          = "nil"
@@ -46,4 +64,38 @@ _obj_type (MalSymbol _)  = "symbol"
 _obj_type (MalList _)    = "list"
 _obj_type (MalVector _)  = "vector"
 _obj_type (MalHashMap _) = "hashmap"
-_obj_type (MalFunc _)    = "malfunc"
+_obj_type (Func _)       = "function"
+
+-- TODO: propagate error properly
+_pairs [x] = error "Odd number of elements to _pairs"
+_pairs [] = []
+_pairs (MalString x:y:xs) = (x,y):_pairs xs
+_pairs (MalKeyword x:y:xs) = ("\x029e" ++ x,y):_pairs xs
+
+-- Errors
+
+catchAny :: IO a -> (CE.SomeException -> IO a) -> IO a
+catchAny = CE.catch
+
+
+-- Functions
+
+_func fn = Func $ Fn fn
+_malfunc ast env params fn = MalFunc {fn=(Fn fn), ast=ast,
+                                      env=env, params=params}
+
+-- Lists
+
+_list_Q (MalList _) = MalTrue
+_list_Q _           = MalFalse
+
+-- Vectors
+
+_vector_Q (MalVector _) = MalTrue
+_vector_Q _             = MalFalse
+
+-- Hash Maps
+
+_hash_map_Q (MalHashMap _) = MalTrue
+_hash_map_Q _              = MalFalse
+
diff --git a/haskell/step0_repl.hs b/haskell/step0_repl.hs
index d944263..ab83602 100644
--- a/haskell/step0_repl.hs
+++ b/haskell/step0_repl.hs
@@ -1,6 +1,7 @@
-import System.IO (hGetLine, hFlush, hIsEOF, stdin, stdout)
 import Control.Monad
 
+import Readline (readline, load_history)
+
 -- read
 mal_read str = str
 
@@ -14,15 +15,14 @@ mal_print exp = exp
 rep line = mal_print $ eval (mal_read line) ""
 
 repl_loop = do
-    putStr "user> "
-    hFlush stdout
-    ineof <- hIsEOF stdin
-    when (not ineof) $ do
-        line <- hGetLine stdin
-        if null line
-            then repl_loop
-            else do
-                putStrLn $ rep line
-                repl_loop
+    line <- readline "user> "
+    case line of
+        Nothing -> return ()
+        Just "" -> repl_loop
+        Just str -> do
+            putStrLn $ rep str
+            repl_loop
 
-main = repl_loop
+main = do
+    load_history
+    repl_loop
diff --git a/haskell/step1_read_print.hs b/haskell/step1_read_print.hs
index 56f2024..70bfee6 100644
--- a/haskell/step1_read_print.hs
+++ b/haskell/step1_read_print.hs
@@ -1,7 +1,7 @@
-import System.IO (hGetLine, hFlush, hIsEOF, stdin, stdout)
 import Control.Monad (when)
 import Control.Monad.Error (throwError)
 
+import Readline (readline, load_history)
 import Types
 import Reader (read_str)
 import Printer (_pr_str)
@@ -26,17 +26,16 @@ rep line = do
 
 repl_loop :: IO ()
 repl_loop = do
-    putStr "user> "
-    hFlush stdout
-    ineof <- hIsEOF stdin
-    when (not ineof) $ do
-        line <- hGetLine stdin
-        if null line
-            then repl_loop
-            else do
-                out <- catchAny (rep line) $ \e -> do
-                    return $ "Error: " ++ (show e)
-                putStrLn out
-                repl_loop
+    line <- readline "user> "
+    case line of
+        Nothing -> return ()
+        Just "" -> repl_loop
+        Just str -> do
+            out <- catchAny (rep str) $ \e -> do
+                return $ "Error: " ++ (show e)
+            putStrLn out
+            repl_loop
 
-main = repl_loop
+main = do
+    load_history
+    repl_loop
diff --git a/haskell/step2_eval.hs b/haskell/step2_eval.hs
index 0a95fcc..2fba218 100644
--- a/haskell/step2_eval.hs
+++ b/haskell/step2_eval.hs
@@ -1,9 +1,9 @@
-import System.IO (hGetLine, hFlush, hIsEOF, stdin, stdout)
 import Control.Monad (when, mapM)
 import Control.Monad.Error (throwError)
 import qualified Data.Map as Map
 import qualified Data.Traversable as DT
 
+import Readline (readline, load_history)
 import Types
 import Reader (read_str)
 import Printer (_pr_str)
@@ -33,8 +33,8 @@ apply_ast :: MalVal -> (Map.Map String MalVal) -> IO MalVal
 apply_ast ast@(MalList _) env = do
     el <- eval_ast ast env
     case el of
-         (MalList (MalFunc (FuncT f) : rest)) ->
-            return $ f $ MalList rest
+         (MalList (Func (Fn f) : rest)) ->
+            f $ rest
          el ->
             error $ "invalid apply: " ++ (show el)
 
@@ -51,23 +51,23 @@ mal_print exp = show exp
 
 -- repl
 add args = case args of
-    (MalList [MalNumber a, MalNumber b]) -> MalNumber $ a + b
+    [MalNumber a, MalNumber b] -> return $ MalNumber $ a + b
     _ -> error $ "illegal arguments to +"
 sub args = case args of
-    (MalList [MalNumber a, MalNumber b]) -> MalNumber $ a - b
+    [MalNumber a, MalNumber b] -> return $ MalNumber $ a - b
     _ -> error $ "illegal arguments to -"
 mult args = case args of
-    (MalList [MalNumber a, MalNumber b]) -> MalNumber $ a * b
+    [MalNumber a, MalNumber b] -> return $ MalNumber $ a * b
     _ -> error $ "illegal arguments to *"
 divd args = case args of
-    (MalList [MalNumber a, MalNumber b]) -> MalNumber $ a `div` b
+    [MalNumber a, MalNumber b] -> return $ MalNumber $ a `div` b
     _ -> error $ "illegal arguments to /"
 
 repl_env :: Map.Map String MalVal
-repl_env = Map.fromList [("+", _malfunc add),
-                         ("-", _malfunc sub),
-                         ("*", _malfunc mult),
-                         ("/", _malfunc divd)]
+repl_env = Map.fromList [("+", _func add),
+                         ("-", _func sub),
+                         ("*", _func mult),
+                         ("/", _func divd)]
 
 rep :: String -> IO String
 rep line = do
@@ -77,17 +77,16 @@ rep line = do
 
 repl_loop :: IO ()
 repl_loop = do
-    putStr "user> "
-    hFlush stdout
-    ineof <- hIsEOF stdin
-    when (not ineof) $ do
-        line <- hGetLine stdin
-        if null line
-            then repl_loop
-            else do
-                out <- catchAny (rep line) $ \e -> do
-                    return $ "Error: " ++ (show e)
-                putStrLn out
-                repl_loop
+    line <- readline "user> "
+    case line of
+        Nothing -> return ()
+        Just "" -> repl_loop
+        Just str -> do
+            out <- catchAny (rep str) $ \e -> do
+                return $ "Error: " ++ (show e)
+            putStrLn out
+            repl_loop
 
-main = repl_loop
+main = do
+    load_history
+    repl_loop
diff --git a/haskell/step3_env.hs b/haskell/step3_env.hs
index 58545cb..dfd52d8 100644
--- a/haskell/step3_env.hs
+++ b/haskell/step3_env.hs
@@ -1,9 +1,9 @@
-import System.IO (hGetLine, hFlush, hIsEOF, stdin, stdout)
 import Control.Monad (when, mapM)
 import Control.Monad.Error (throwError)
 import qualified Data.Map as Map
 import qualified Data.Traversable as DT
 
+import Readline (readline, load_history)
 import Types
 import Reader (read_str)
 import Printer (_pr_str)
@@ -43,7 +43,7 @@ apply_ast ast@(MalList (MalSymbol "def!" : args)) env = do
          _ -> error $ "invalid def!"
 apply_ast ast@(MalList (MalSymbol "let*" : args)) env = do
     case args of
-         (MalList a1   : a2 : []) -> do
+         (MalList a1 : a2 : []) -> do
             let_env <- env_new $ Just env
             let_bind let_env a1
             eval a2 let_env
@@ -55,8 +55,8 @@ apply_ast ast@(MalList (MalSymbol "let*" : args)) env = do
 apply_ast ast@(MalList _) env = do
     el <- eval_ast ast env
     case el of
-         (MalList (MalFunc (FuncT f) : rest)) ->
-            return $ f $ MalList rest
+         (MalList (Func (Fn f) : rest)) ->
+            f $ rest
          el ->
             error $ "invalid apply: " ++ (show el)
 
@@ -73,16 +73,16 @@ mal_print exp = show exp
 
 -- repl
 add args = case args of
-    (MalList [MalNumber a, MalNumber b]) -> MalNumber $ a + b
+    [MalNumber a, MalNumber b] -> return $ MalNumber $ a + b
     _ -> error $ "illegal arguments to +"
 sub args = case args of
-    (MalList [MalNumber a, MalNumber b]) -> MalNumber $ a - b
+    [MalNumber a, MalNumber b] -> return $ MalNumber $ a - b
     _ -> error $ "illegal arguments to -"
 mult args = case args of
-    (MalList [MalNumber a, MalNumber b]) -> MalNumber $ a * b
+    [MalNumber a, MalNumber b] -> return $ MalNumber $ a * b
     _ -> error $ "illegal arguments to *"
 divd args = case args of
-    (MalList [MalNumber a, MalNumber b]) -> MalNumber $ a `div` b
+    [MalNumber a, MalNumber b] -> return $ MalNumber $ a `div` b
     _ -> error $ "illegal arguments to /"
 
 rep :: Env -> String -> IO String
@@ -93,23 +93,21 @@ rep env line = do
 
 repl_loop :: Env -> IO ()
 repl_loop env = do
-    putStr "user> "
-    hFlush stdout
-    ineof <- hIsEOF stdin
-    when (not ineof) $ do
-        line <- hGetLine stdin
-        if null line
-            then repl_loop env
-            else do
-                out <- catchAny (rep env line) $ \e -> do
-                    return $ "Error: " ++ (show e)
-                putStrLn out
-                repl_loop env
+    line <- readline "user> "
+    case line of
+        Nothing -> return ()
+        Just "" -> repl_loop env
+        Just str -> do
+            out <- catchAny (rep env str) $ \e -> do
+                return $ "Error: " ++ (show e)
+            putStrLn out
+            repl_loop env
 
 main = do
+    load_history
     repl_env <- env_new Nothing
-    env_set repl_env (MalSymbol "+") $ _malfunc add
-    env_set repl_env (MalSymbol "-") $ _malfunc sub
-    env_set repl_env (MalSymbol "*") $ _malfunc mult
-    env_set repl_env (MalSymbol "/") $ _malfunc divd
+    env_set repl_env (MalSymbol "+") $ _func add
+    env_set repl_env (MalSymbol "-") $ _func sub
+    env_set repl_env (MalSymbol "*") $ _func mult
+    env_set repl_env (MalSymbol "/") $ _func divd
     repl_loop repl_env
diff --git a/haskell/step4_if_fn_do.hs b/haskell/step4_if_fn_do.hs
new file mode 100644
index 0000000..9a4ceb1
--- /dev/null
+++ b/haskell/step4_if_fn_do.hs
@@ -0,0 +1,140 @@
+import Control.Monad (when, mapM)
+import Control.Monad.Error (throwError)
+import qualified Data.Map as Map
+import qualified Data.Traversable as DT
+
+import Readline (readline, load_history)
+import Types
+import Reader (read_str)
+import Printer (_pr_str)
+import Env (Env, env_new, env_bind, env_get, env_set)
+import Core as Core
+
+-- read
+mal_read :: String -> IO MalVal
+mal_read str = read_str str
+
+-- eval
+eval_ast :: MalVal -> Env -> IO MalVal
+eval_ast sym@(MalSymbol _) env = env_get env sym
+eval_ast ast@(MalList lst) env = do
+    new_lst <- mapM (\x -> (eval x env)) lst
+    return $ MalList new_lst
+eval_ast ast@(MalVector lst) env = do
+    new_lst <- mapM (\x -> (eval x env)) lst
+    return $ MalVector new_lst
+eval_ast ast@(MalHashMap lst) env = do
+    new_hm <- DT.mapM (\x -> (eval x env)) lst
+    return $ MalHashMap new_hm
+eval_ast ast env = return ast
+
+let_bind :: Env -> [MalVal] -> IO Env
+let_bind env [] = return env
+let_bind env (b:e:xs) = do
+    evaled <- eval e env
+    x <- env_set env b evaled
+    let_bind env xs
+
+apply_ast :: MalVal -> Env -> IO MalVal
+apply_ast ast@(MalList (MalSymbol "def!" : args)) env = do
+    case args of
+         (a1@(MalSymbol _): a2 : []) -> do
+            evaled <- eval a2 env
+            env_set env a1 evaled
+         _ -> error $ "invalid def!"
+apply_ast ast@(MalList (MalSymbol "let*" : args)) env = do
+    case args of
+         (MalList a1 : a2 : []) -> do
+            let_env <- env_new $ Just env
+            let_bind let_env a1
+            eval a2 let_env
+         (MalVector a1 : a2 : []) -> do
+            let_env <- env_new $ Just env
+            let_bind let_env a1
+            eval a2 let_env
+         _ -> error $ "invalid let*"
+apply_ast ast@(MalList (MalSymbol "do" : args)) env = do
+    case args of
+         ([]) -> return Nil
+         _  -> do
+            el <- eval_ast (MalList args) env
+            case el of
+                 (MalList el) -> return $ last el
+            
+apply_ast ast@(MalList (MalSymbol "if" : args)) env = do
+    case args of
+         (a1 : a2 : a3 : []) -> do
+            cond <- eval a1 env
+            if cond == MalFalse || cond == Nil
+                then eval a3 env
+                else eval a2 env
+         (a1 : a2 : []) -> do
+            cond <- eval a1 env
+            if cond == MalFalse || cond == Nil
+                then return Nil
+                else eval a2 env
+         _ -> error $ "invalid if"
+apply_ast ast@(MalList (MalSymbol "fn*" : args)) env = do
+    case args of
+         ((MalList binds) : a2 : []) -> do
+            return $ _func (\args -> do
+                fn_env1 <- env_new $ Just env
+                fn_env2 <- (env_bind fn_env1  binds args)
+                eval a2 fn_env2)
+         ((MalVector binds) : a2 : []) -> do
+            return $ _func (\args -> do
+                fn_env1 <- env_new $ Just env
+                fn_env2 <- (env_bind fn_env1  binds args)
+                eval a2 fn_env2)
+         _ -> error $ "invalid fn*"
+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)
+
+eval :: MalVal -> Env -> IO MalVal
+eval ast env = do
+    case ast of
+         (MalList lst) -> apply_ast ast env
+         _             -> eval_ast ast env
+
+
+-- print
+mal_print :: MalVal -> String
+mal_print exp = show exp
+
+-- repl
+
+rep :: Env -> String -> IO String
+rep env line = do
+    ast <- mal_read line
+    exp <- eval ast env
+    return $ mal_print exp
+
+repl_loop :: Env -> IO ()
+repl_loop env = do
+    line <- readline "user> "
+    case line of
+        Nothing -> return ()
+        Just "" -> repl_loop env
+        Just str -> do
+            out <- catchAny (rep env str) $ \e -> do
+                return $ "Error: " ++ (show e)
+            putStrLn out
+            repl_loop env
+
+main = do
+    load_history
+
+    repl_env <- env_new Nothing
+
+    -- core.hs: defined using Haskell
+    (mapM (\(k,v) -> (env_set repl_env (MalSymbol k) v)) Core.ns)
+
+    -- core.mal: defined using the language itself
+    rep repl_env "(def! not (fn* (a) (if a false true)))"
+
+    repl_loop repl_env
diff --git a/haskell/step5_tco.hs b/haskell/step5_tco.hs
new file mode 100644
index 0000000..be8b8b2
--- /dev/null
+++ b/haskell/step5_tco.hs
@@ -0,0 +1,142 @@
+import Control.Monad (when, mapM)
+import Control.Monad.Error (throwError)
+import qualified Data.Map as Map
+import qualified Data.Traversable as DT
+
+import Readline (readline, load_history)
+import Types
+import Reader (read_str)
+import Printer (_pr_str)
+import Env (Env, env_new, env_bind, env_get, env_set)
+import Core as Core
+
+-- read
+mal_read :: String -> IO MalVal
+mal_read str = read_str str
+
+-- eval
+eval_ast :: MalVal -> Env -> IO MalVal
+eval_ast sym@(MalSymbol _) env = env_get env sym
+eval_ast ast@(MalList lst) env = do
+    new_lst <- mapM (\x -> (eval x env)) lst
+    return $ MalList new_lst
+eval_ast ast@(MalVector lst) env = do
+    new_lst <- mapM (\x -> (eval x env)) lst
+    return $ MalVector new_lst
+eval_ast ast@(MalHashMap lst) env = do
+    new_hm <- DT.mapM (\x -> (eval x env)) lst
+    return $ MalHashMap new_hm
+eval_ast ast env = return ast
+
+let_bind :: Env -> [MalVal] -> IO Env
+let_bind env [] = return env
+let_bind env (b:e:xs) = do
+    evaled <- eval e env
+    x <- env_set env b evaled
+    let_bind env xs
+
+apply_ast :: MalVal -> Env -> IO MalVal
+apply_ast ast@(MalList (MalSymbol "def!" : args)) env = do
+    case args of
+         (a1@(MalSymbol _): a2 : []) -> do
+            evaled <- eval a2 env
+            env_set env a1 evaled
+         _ -> error $ "invalid def!"
+apply_ast ast@(MalList (MalSymbol "let*" : args)) env = do
+    case args of
+         (MalList a1 : a2 : []) -> do
+            let_env <- env_new $ Just env
+            let_bind let_env a1
+            eval a2 let_env
+         (MalVector a1 : a2 : []) -> do
+            let_env <- env_new $ Just env
+            let_bind let_env a1
+            eval a2 let_env
+         _ -> error $ "invalid let*"
+apply_ast ast@(MalList (MalSymbol "do" : args)) env = do
+    case args of
+         ([]) -> return Nil
+         _  -> do
+            el <- eval_ast (MalList args) env
+            case el of
+                 (MalList el) -> return $ last el
+            
+apply_ast ast@(MalList (MalSymbol "if" : args)) env = do
+    case args of
+         (a1 : a2 : a3 : []) -> do
+            cond <- eval a1 env
+            if cond == MalFalse || cond == Nil
+                then eval a3 env
+                else eval a2 env
+         (a1 : a2 : []) -> do
+            cond <- eval a1 env
+            if cond == MalFalse || cond == Nil
+                then return Nil
+                else eval a2 env
+         _ -> error $ "invalid if"
+apply_ast ast@(MalList (MalSymbol "fn*" : args)) env = do
+    let params = case args of
+                     ((MalList lst) : _)   -> lst
+                     ((MalVector lst) : _) -> lst in
+        case args of
+             (a1 : a2 : []) -> do
+                return $ (_malfunc a2 env a1 (\args -> do
+                    fn_env1 <- env_new $ Just env
+                    fn_env2 <- (env_bind fn_env1 params args)
+                    eval a2 fn_env2))
+             _ -> error $ "invalid fn*"
+apply_ast ast@(MalList _) env = do
+    el <- eval_ast ast env
+    case el of
+         (MalList (Func (Fn f) : rest)) ->
+            f $ rest
+         (MalList (MalFunc {ast=ast, env=fn_env, params=(MalList params)} : rest)) -> do
+            fn_env1 <- env_new $ Just fn_env
+            fn_env2 <- (env_bind fn_env1 params rest)
+            eval ast fn_env2
+         el ->
+            error $ "invalid apply: " ++ (show el)
+
+eval :: MalVal -> Env -> IO MalVal
+eval ast env = do
+    case ast of
+         (MalList lst) -> apply_ast ast env
+         _             -> eval_ast ast env
+
+
+-- print
+mal_print :: MalVal -> String
+mal_print exp = show exp
+
+-- repl
+
+rep :: Env -> String -> IO String
+rep env line = do
+    ast <- mal_read line
+    exp <- eval ast env
+    return $ mal_print exp
+
+repl_loop :: Env -> IO ()
+repl_loop env = do
+    line <- readline "user> "
+    case line of
+        Nothing -> return ()
+        Just "" -> repl_loop env
+        Just str -> do
+            out <- catchAny (rep env str) $ \e -> do
+                return $ "Error: " ++ (show e)
+            putStrLn out
+            repl_loop env
+
+main = do
+    load_history
+
+    repl_env <- env_new Nothing
+
+    -- core.hs: defined using Haskell
+    (mapM (\(k,v) -> (env_set repl_env (MalSymbol k) v)) Core.ns)
+
+    -- core.mal: defined using the language itself
+    rep repl_env "(def! not (fn* (a) (if a false true)))"
+
+    repl_loop repl_env
diff --git a/haskell/step6_file.hs b/haskell/step6_file.hs
new file mode 100644
index 0000000..bdfcfe1
--- /dev/null
+++ b/haskell/step6_file.hs
@@ -0,0 +1,152 @@
+import System.Environment (getArgs)
+import Control.Monad (when, mapM)
+import Control.Monad.Error (throwError)
+import qualified Data.Map as Map
+import qualified Data.Traversable as DT
+
+import Readline (readline, load_history)
+import Types
+import Reader (read_str)
+import Printer (_pr_str)
+import Env (Env, env_new, env_bind, env_get, env_set)
+import Core as Core
+
+-- read
+mal_read :: String -> IO MalVal
+mal_read str = read_str str
+
+-- eval
+eval_ast :: MalVal -> Env -> IO MalVal
+eval_ast sym@(MalSymbol _) env = env_get env sym
+eval_ast ast@(MalList lst) env = do
+    new_lst <- mapM (\x -> (eval x env)) lst
+    return $ MalList new_lst
+eval_ast ast@(MalVector lst) env = do
+    new_lst <- mapM (\x -> (eval x env)) lst
+    return $ MalVector new_lst
+eval_ast ast@(MalHashMap lst) env = do
+    new_hm <- DT.mapM (\x -> (eval x env)) lst
+    return $ MalHashMap new_hm
+eval_ast ast env = return ast
+
+let_bind :: Env -> [MalVal] -> IO Env
+let_bind env [] = return env
+let_bind env (b:e:xs) = do
+    evaled <- eval e env
+    x <- env_set env b evaled
+    let_bind env xs
+
+apply_ast :: MalVal -> Env -> IO MalVal
+apply_ast ast@(MalList (MalSymbol "def!" : args)) env = do
+    case args of
+         (a1@(MalSymbol _): a2 : []) -> do
+            evaled <- eval a2 env
+            env_set env a1 evaled
+         _ -> error $ "invalid def!"
+apply_ast ast@(MalList (MalSymbol "let*" : args)) env = do
+    case args of
+         (MalList a1 : a2 : []) -> do
+            let_env <- env_new $ Just env
+            let_bind let_env a1
+            eval a2 let_env
+         (MalVector a1 : a2 : []) -> do
+            let_env <- env_new $ Just env
+            let_bind let_env a1
+            eval a2 let_env
+         _ -> error $ "invalid let*"
+apply_ast ast@(MalList (MalSymbol "do" : args)) env = do
+    case args of
+         ([]) -> return Nil
+         _  -> do
+            el <- eval_ast (MalList args) env
+            case el of
+                 (MalList el) -> return $ last el
+            
+apply_ast ast@(MalList (MalSymbol "if" : args)) env = do
+    case args of
+         (a1 : a2 : a3 : []) -> do
+            cond <- eval a1 env
+            if cond == MalFalse || cond == Nil
+                then eval a3 env
+                else eval a2 env
+         (a1 : a2 : []) -> do
+            cond <- eval a1 env
+            if cond == MalFalse || cond == Nil
+                then return Nil
+                else eval a2 env
+         _ -> error $ "invalid if"
+apply_ast ast@(MalList (MalSymbol "fn*" : args)) env = do
+    let params = case args of
+                     ((MalList lst) : _)   -> lst
+                     ((MalVector lst) : _) -> lst in
+        case args of
+             (a1 : a2 : []) -> do
+                return $ (_malfunc a2 env a1 (\args -> do
+                    fn_env1 <- env_new $ Just env
+                    fn_env2 <- (env_bind fn_env1 params args)
+                    eval a2 fn_env2))
+             _ -> error $ "invalid fn*"
+apply_ast ast@(MalList _) env = do
+    el <- eval_ast ast env
+    case el of
+         (MalList (Func (Fn f) : rest)) ->
+            f $ rest
+         (MalList (MalFunc {ast=ast, env=fn_env, params=(MalList params)} : rest)) -> do
+            fn_env1 <- env_new $ Just fn_env
+            fn_env2 <- (env_bind fn_env1 params rest)
+            eval ast fn_env2
+         el ->
+            error $ "invalid apply: " ++ (show el)
+
+eval :: MalVal -> Env -> IO MalVal
+eval ast env = do
+    case ast of
+         (MalList lst) -> apply_ast ast env
+         _             -> eval_ast ast env
+
+
+-- print
+mal_print :: MalVal -> String
+mal_print exp = show exp
+
+-- repl
+
+rep :: Env -> String -> IO String
+rep env line = do
+    ast <- mal_read line
+    exp <- eval ast env
+    return $ mal_print exp
+
+repl_loop :: Env -> IO ()
+repl_loop env = do
+    line <- readline "user> "
+    case line of
+        Nothing -> return ()
+        Just "" -> repl_loop env
+        Just str -> do
+            out <- catchAny (rep env str) $ \e -> do
+                return $ "Error: " ++ (show e)
+            putStrLn out
+            repl_loop env
+
+main = do
+    args <- getArgs
+    load_history
+
+    repl_env <- env_new Nothing
+
+    -- core.hs: defined using Haskell
+    (mapM (\(k,v) -> (env_set repl_env (MalSymbol k) v)) Core.ns)
+    env_set repl_env (MalSymbol "eval") (_func (\[ast] -> eval ast repl_env))
+    env_set repl_env (MalSymbol "*ARGV*") (MalList [])
+
+    -- core.mal: defined using the language itself
+    rep repl_env "(def! not (fn* (a) (if a false true)))"
+    rep repl_env "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))"
+
+    if length args > 0 then do
+        env_set repl_env (MalSymbol "*ARGV*") (MalList (map MalString (drop 1 args)))
+        rep repl_env $ "(load-file \"" ++ (args !! 0) ++ "\")" 
+        return ()
+    else 
+        repl_loop repl_env