diff --git a/impls/haskell/Core.hs b/impls/haskell/Core.hs
index e07d78732c..f2468cd60a 100644
--- a/impls/haskell/Core.hs
+++ b/impls/haskell/Core.hs
@@ -5,7 +5,7 @@ where
 import System.IO (hFlush, stdout)
 import Control.Monad.Except (throwError)
 import Control.Monad.Trans (liftIO)
-import qualified Data.Map as Map
+import qualified Data.Map.Strict as Map
 import Data.Foldable (foldlM)
 import Data.Time.Clock.POSIX (getPOSIXTime)
 import Data.IORef (newIORef, readIORef, writeIORef)
@@ -29,9 +29,11 @@ throw _ = throwStr "illegal arguments to throw"
 
 -- Unary predicates
 
-pred1 :: (MalVal -> Bool) -> Fn
-pred1 hostPred [x] = return $ MalBoolean $ hostPred x
-pred1 _ _ = throwStr "illegal call to unary predicate"
+pred1 :: String -> (MalVal -> Bool) -> (String, Fn)
+pred1 name op = (name, fn) where
+  fn :: Fn
+  fn [a] = return $ MalBoolean $ op a
+  fn _ = throwStr $ "illegal arguments to " ++ name
 
 atom_Q :: MalVal -> Bool
 atom_Q (MalAtom _ _) = True
@@ -42,20 +44,20 @@ false_Q (MalBoolean False) = True
 false_Q _                  = False
 
 fn_Q :: MalVal -> Bool
-fn_Q (MalFunction {macro=False}) = True
-fn_Q _                           = False
+fn_Q (MalFunction _ _) = True
+fn_Q _                 = False
 
 macro_Q :: MalVal -> Bool
-macro_Q (MalFunction {macro=True}) = True
-macro_Q _                          = False
+macro_Q (MalMacro _) = True
+macro_Q _            = False
 
 map_Q :: MalVal -> Bool
 map_Q (MalHashMap _ _) = True
 map_Q _                = False
 
 keyword_Q :: MalVal -> Bool
-keyword_Q (MalString (c : _)) = c == keywordMagic
-keyword_Q _                   = False
+keyword_Q (MalKeyword _) = True
+keyword_Q _              = False
 
 list_Q :: MalVal -> Bool
 list_Q (MalSeq _ (Vect False) _) = True
@@ -70,9 +72,8 @@ number_Q (MalNumber _) = True
 number_Q _             = False
 
 string_Q :: MalVal -> Bool
-string_Q (MalString "")      = True
-string_Q (MalString (c : _)) = c /= keywordMagic
-string_Q _                   = False
+string_Q (MalString _) = True
+string_Q _             = False
 
 symbol_Q :: MalVal -> Bool
 symbol_Q (MalSymbol _) = True
@@ -93,8 +94,8 @@ symbol [MalString s] = return $ MalSymbol s
 symbol _ = throwStr "symbol called with non-string"
 
 keyword :: Fn
-keyword [kw@(MalString (c : _))] | c == keywordMagic = return kw
-keyword [MalString s] = return $ MalString (keywordMagic : s)
+keyword [kw@(MalKeyword _)] = return kw
+keyword [MalString s] = return $ MalKeyword s
 keyword _ = throwStr "keyword called with non-string"
 
 -- String functions
@@ -135,13 +136,17 @@ read_string _ = throwStr "invalid read-string"
 
 -- Numeric functions
 
-num_op :: (Int -> Int -> Int) -> Fn
-num_op op [MalNumber a, MalNumber b] = return $ MalNumber $ op a b
-num_op _ _ = throwStr "illegal arguments to number operation"
+num_op :: String -> (Int -> Int -> Int) -> (String, Fn)
+num_op name op = (name, fn) where
+  fn :: Fn
+  fn [MalNumber a, MalNumber b] = return $ MalNumber $ op a b
+  fn _ = throwStr $ "illegal arguments to " ++ name
 
-cmp_op :: (Int -> Int -> Bool) -> Fn
-cmp_op op [MalNumber a, MalNumber b] = return $ MalBoolean $ op a b
-cmp_op _ _ = throwStr "illegal arguments to comparison operation"
+cmp_op :: String -> (Int -> Int -> Bool) -> (String, Fn)
+cmp_op name op = (name, fn) where
+  fn :: Fn
+  fn [MalNumber a, MalNumber b] = return $ MalBoolean $ op a b
+  fn _ = throwStr $ "illegal arguments to " ++ name
 
 time_ms :: Fn
 time_ms [] = MalNumber . round . (* 1000) <$> liftIO getPOSIXTime
@@ -161,41 +166,44 @@ vector = return . MalSeq (MetaData Nil) (Vect True)
 -- Hash Map functions
 
 hash_map :: Fn
-hash_map kvs =
-    case keyValuePairs kvs of
-        Just pairs -> return $ MalHashMap (MetaData Nil) $ Map.fromList pairs
+hash_map kvs = case kv2map Map.empty kvs of
+        Just m     -> return m
         Nothing    -> throwStr "invalid call to hash-map"
 
 assoc :: Fn
-assoc (MalHashMap _ hm : kvs) =
-    case keyValuePairs kvs of
-        Just pairs -> return $ MalHashMap (MetaData Nil) $ Map.union (Map.fromList pairs) hm
+assoc (MalHashMap _ hm : kvs) = case kv2map hm kvs of
+        Just m     -> return m
         Nothing    -> throwStr "invalid assoc"
 assoc _ = throwStr "invalid call to assoc"
 
 remover :: Map.Map String MalVal -> MalVal -> IOThrows (Map.Map String MalVal)
-remover m (MalString k) = return $ Map.delete k m
-remover _ _ = throwStr "invalid dissoc"
+remover acc key = case encodeKey key of
+    Nothing      -> throwStr "invalid dissoc"
+    Just encoded -> return $ Map.delete encoded acc
 
 dissoc :: Fn
 dissoc (MalHashMap _ hm : ks) = MalHashMap (MetaData Nil) <$> foldlM remover hm ks
 dissoc _ = throwStr "invalid call to dissoc"
 
 get :: Fn
-get [MalHashMap _ hm, MalString k] =
-    case Map.lookup k hm of
+get [MalHashMap _ hm, k] = case encodeKey k of
+    Nothing  -> throwStr "invalid call to get"
+    Just key -> case Map.lookup key hm of
         Just mv -> return mv
         Nothing -> return Nil
 get [Nil, MalString _] = return Nil
 get _ = throwStr "invalid call to get"
 
 contains_Q :: Fn
-contains_Q [MalHashMap _ hm, MalString k] = return $ MalBoolean $ Map.member k hm
-contains_Q [Nil,             MalString _] = return $ MalBoolean False
+contains_Q [MalHashMap _ hm, k] = case encodeKey k of
+  Just key -> return $ MalBoolean $ Map.member key  hm
+  Nothing  -> throwStr "invalid call to contains?"
+contains_Q [Nil, MalString _] = return $ MalBoolean False
+contains_Q [Nil, MalSymbol _] = return $ MalBoolean False
 contains_Q _ = throwStr "invalid call to contains?"
 
 keys :: Fn
-keys [MalHashMap _ hm] = return $ toList $ MalString <$> Map.keys hm
+keys [MalHashMap _ hm] = return $ toList $ decodeKey <$> Map.keys hm
 keys _ = throwStr "invalid call to keys"
 
 vals :: Fn
@@ -245,10 +253,10 @@ rest [MalSeq _ _ []      ] = return $ toList []
 rest [MalSeq _ _ (_ : xs)] = return $ toList xs
 rest _ = throwStr "illegal call to rest"
 
-empty_Q :: MalVal -> Bool
-empty_Q Nil             = True
-empty_Q (MalSeq _ _ []) = True
-empty_Q _               = False
+empty_Q :: Fn
+empty_Q [Nil]           = return $ MalBoolean True
+empty_Q [MalSeq _ _ xs] = return $ MalBoolean $ xs == []
+empty_Q _               = throwStr "illegal call to empty?"
 
 count :: Fn
 count [Nil           ] = return $ MalNumber 0
@@ -261,11 +269,11 @@ concatLast (a : as)         = (a :) <$> concatLast as
 concatLast _ = throwStr "last argument of apply must be a sequence"
 
 apply :: Fn
-apply (MalFunction {fn=f} : xs) = f =<< concatLast xs
+apply (MalFunction _ f : xs) = f =<< concatLast xs
 apply _ = throwStr "Illegal call to apply"
 
 do_map :: Fn
-do_map [MalFunction {fn=f}, MalSeq _ _ args] = toList <$> mapM (\x -> f [x]) args
+do_map [MalFunction _ f, MalSeq _ _ args] = toList <$> mapM (\x -> f [x]) args
 do_map _ = throwStr "Illegal call to map"
 
 conj :: Fn
@@ -287,14 +295,14 @@ with_meta :: Fn
 with_meta [MalSeq _ v x,       m] = return $ MalSeq (MetaData m) v x
 with_meta [MalHashMap _ x,     m] = return $ MalHashMap (MetaData m) x
 with_meta [MalAtom _ x,        m] = return $ MalAtom (MetaData m) x
-with_meta [f@(MalFunction {}), m] = return $ f {meta=m}
+with_meta [MalFunction _ f,    m] = return $ MalFunction (MetaData m) f
 with_meta _ = throwStr "invalid with-meta call"
 
 do_meta :: Fn
 do_meta [MalSeq (MetaData m) _ _  ] = return m
 do_meta [MalHashMap (MetaData m) _] = return m
 do_meta [MalAtom (MetaData m) _   ] = return m
-do_meta [MalFunction {meta=m}     ] = return m
+do_meta [MalFunction (MetaData m) _] = return m
 do_meta _ = throwStr "invalid meta call"
 
 -- Atom functions
@@ -309,12 +317,12 @@ deref _ = throwStr "invalid deref call"
 
 reset_BANG :: Fn
 reset_BANG [MalAtom _ ref, val] = do
-    liftIO $ writeIORef ref $ val
+    liftIO $ writeIORef ref val
     return val
 reset_BANG _ = throwStr "invalid reset!"
 
 swap_BANG :: Fn
-swap_BANG (MalAtom _ ref : MalFunction {fn=f} : args) = do
+swap_BANG (MalAtom _ ref : MalFunction _ f : args) = do
     val <- liftIO $ readIORef ref
     new_val <- f (val : args)
     liftIO $ writeIORef ref new_val
@@ -325,17 +333,17 @@ ns :: [(String, Fn)]
 ns = [
     ("=",           equal_Q),
     ("throw",       throw),
-    ("nil?",        pred1 nil_Q),
-    ("true?",       pred1 true_Q),
-    ("false?",      pred1 false_Q),
-    ("string?",     pred1 string_Q),
+    (pred1 "nil?"   nil_Q),
+    (pred1 "true?"  true_Q),
+    (pred1 "false?" false_Q),
+    (pred1 "string?" string_Q),
     ("symbol",      symbol),
-    ("symbol?",     pred1 symbol_Q),
+    (pred1 "symbol?" symbol_Q),
     ("keyword",     keyword),
-    ("keyword?",    pred1 keyword_Q),
-    ("number?",     pred1 number_Q),
-    ("fn?",         pred1 fn_Q),
-    ("macro?",      pred1 macro_Q),
+    (pred1 "keyword?" keyword_Q),
+    (pred1 "number?" number_Q),
+    (pred1 "fn?"    fn_Q),
+    (pred1 "macro?" macro_Q),
 
     ("pr-str",      pr_str),
     ("str",         str),
@@ -345,22 +353,22 @@ ns = [
     ("read-string", read_string),
     ("slurp",       slurp),
 
-    ("<",           cmp_op (<)),
-    ("<=",          cmp_op (<=)),
-    (">",           cmp_op (>)),
-    (">=",          cmp_op (>=)),
-    ("+",           num_op (+)),
-    ("-",           num_op (-)),
-    ("*",           num_op (*)),
-    ("/",           num_op (div)),
+    (cmp_op "<"     (<)),
+    (cmp_op "<="    (<=)),
+    (cmp_op ">"     (>)),
+    (cmp_op ">="    (>=)),
+    (num_op "+"     (+)),
+    (num_op "-"     (-)),
+    (num_op "*"     (*)),
+    (num_op "/"     div),
     ("time-ms",     time_ms),
 
     ("list",        list),
-    ("list?",       pred1 list_Q),
+    (pred1 "list?" list_Q),
     ("vector",      vector),
-    ("vector?",     pred1 vector_Q),
+    (pred1 "vector?" vector_Q),
     ("hash-map",    hash_map),
-    ("map?",        pred1 map_Q),
+    (pred1 "map?" map_Q),
     ("assoc",       assoc),
     ("dissoc",      dissoc),
     ("get",         get),
@@ -368,14 +376,14 @@ ns = [
     ("keys",        keys),
     ("vals",        vals),
 
-    ("sequential?", pred1 sequential_Q),
+    (pred1 "sequential?" sequential_Q),
     ("cons",        cons),
     ("concat",      do_concat),
     ("vec",         vec),
     ("nth",         nth),
     ("first",       first),
     ("rest",        rest),
-    ("empty?",      pred1 empty_Q),
+    ("empty?",      empty_Q),
     ("count",       count),
     ("apply",       apply),
     ("map",         do_map),
@@ -386,7 +394,7 @@ ns = [
     ("with-meta",   with_meta),
     ("meta",        do_meta),
     ("atom",        atom),
-    ("atom?",       pred1 atom_Q),
+    (pred1 "atom?" atom_Q),
     ("deref",       deref),
     ("reset!",      reset_BANG),
     ("swap!",       swap_BANG)]
diff --git a/impls/haskell/Env.hs b/impls/haskell/Env.hs
index a760d197f1..62b9d264de 100644
--- a/impls/haskell/Env.hs
+++ b/impls/haskell/Env.hs
@@ -1,36 +1,60 @@
 module Env
-( Env, env_new, env_bind, env_get, env_set )
+( Env, env_apply, env_get, env_let, env_put, env_repl, env_set )
 where
 
-import Data.IORef (modifyIORef, newIORef, readIORef)
-import qualified Data.Map  as Map
+import Data.IORef (IORef, modifyIORef, newIORef, readIORef)
+import qualified Data.Map.Strict as Map
 
+import Printer (_pr_str)
 import Types
 
--- The Env type si defined in Types module to avoid dep cycle.
+data Binds = Variable (IORef (Map.Map String MalVal))
+           | Constant (Map.Map String MalVal)
 
-env_new :: Env -> IO Env
-env_new outer = (: outer) <$> newIORef (Map.fromList [])
+type Env = [Binds]
 
---  True means that the actual arguments match the signature.
-env_bind :: Env -> [String] -> [MalVal] -> IO Bool
-env_bind env (k : ks) (v : vs) | k /= "&" = do
-    env_set env k v
-    env_bind env ks vs
-env_bind env ["&", k] vs = do
-    env_set env k $ toList vs
-    return True
-env_bind _ [] [] = return True
-env_bind _ _ _ = return False
+env_repl :: IO Env
+env_repl = (: []) . Variable <$> newIORef Map.empty
+
+env_let :: Env -> IO Env
+env_let outer = (: outer) . Variable <$> newIORef Map.empty
+
+--  catch* should also use this
+env_apply :: Env -> [MalVal] -> [MalVal] -> Maybe (Env)
+env_apply outer keys values = (: outer) . Constant <$> bind keys values Map.empty
+
+bind :: [MalVal] -> [MalVal] -> Map.Map String MalVal -> Maybe (Map.Map String MalVal)
+bind [MalSymbol "&", (MalSymbol k)] vs       m = Just $ Map.insert k (toList vs) m
+bind (MalSymbol k : ks)             (v : vs) m = Map.insert k v <$> bind ks vs m
+bind []                             []       m = Just m
+bind _                              _        _ = Nothing
 
 env_get :: Env -> String -> IO (Maybe MalVal)
-env_get [] _ = return Nothing
-env_get (ref : outer) key = do
-    hm <- readIORef ref
-    case Map.lookup key hm of
-        Nothing -> env_get outer key
-        justVal -> return justVal
+env_get env key = loop env where
+  loop :: Env -> IO (Maybe MalVal)
+  loop [] = return Nothing
+  loop (Constant m : outer) = case Map.lookup key m of
+    Nothing -> loop outer
+    justVal -> return justVal
+  loop (Variable ref : outer) = do
+    m <- readIORef ref
+    case Map.lookup key m of
+      Nothing -> loop outer
+      justVal -> return justVal
 
+--  def! and let*
 env_set :: Env -> String -> MalVal -> IO ()
-env_set (ref : _) key val = modifyIORef ref $ Map.insert key val
-env_set [] _ _ = error "assertion failed in env_set"
+env_set (Variable ref : _) key value = modifyIORef ref $ Map.insert key value
+env_set _         _   _     = error "assertion failed in env.env_set"
+
+put1 :: (String, MalVal) -> IO ()
+put1 (key, value) = do
+  putChar ' '
+  putStr key
+  putChar ':'
+  putStr =<< _pr_str True value
+
+env_put :: Env -> IO ()
+env_put []        = error "assertion failed in Env.env_format"
+env_put (Variable ref : _) = mapM_ put1 =<< Map.assocs <$> readIORef ref
+env_put (Constant m : _) = mapM_ put1 $ Map.assocs m
diff --git a/impls/haskell/Printer.hs b/impls/haskell/Printer.hs
index ae41623e5d..e0931b6dd2 100644
--- a/impls/haskell/Printer.hs
+++ b/impls/haskell/Printer.hs
@@ -2,47 +2,37 @@ module Printer
 ( _pr_str, _pr_list )
 where
 
-import qualified Data.Map as Map
+import qualified Data.Map.Strict as Map
 import Data.IORef (readIORef)
+import Data.List (intercalate)
 
 import Types
 
 _pr_list :: Bool -> String -> [MalVal] -> IO String
-_pr_list _  _   []     = return $ []
-_pr_list pr _   [x]    = _pr_str pr x
-_pr_list pr sep (x:xs) = format <$> _pr_str pr x <*> _pr_list pr sep xs where
-    format l r = l ++ sep ++ r
+_pr_list pr sep = fmap (intercalate sep) . mapM (_pr_str pr)
 
-_flatTuples :: [(String, MalVal)] -> [MalVal]
-_flatTuples ((a,b):xs) = MalString a : b : _flatTuples xs
-_flatTuples _          = []
+enclose :: String -> String -> String -> String
+enclose open close middle = open ++ middle ++ close
 
-unescape :: Char -> String
-unescape '\n' = "\\n"
-unescape '\\' = "\\\\"
-unescape '"'  = "\\\""
-unescape c    = [c]
+escape :: Char -> String -> String
+escape '\n' acc = '\\' : 'n'  : acc
+escape '\\' acc = '\\' : '\\' : acc
+escape '"'  acc = '\\' : '"'  : acc
+escape c    acc = c           : acc
 
 _pr_str :: Bool -> MalVal -> IO String
-_pr_str _     (MalString (c : cs)) | c == keywordMagic
-                                 = return $ ':' : cs
-_pr_str True  (MalString str)    = return $ "\"" ++ concatMap unescape str ++ "\""
+_pr_str _     (MalKeyword kwd)   = return $ ':' : kwd
+_pr_str True  (MalString str)    = return $ enclose "\"" "\"" $ foldr escape [] str
 _pr_str False (MalString str)    = return str
 _pr_str _     (MalSymbol name)   = return name
 _pr_str _     (MalNumber num)    = return $ show num
 _pr_str _     (MalBoolean True)  = return "true"
-_pr_str _     (MalBoolean False) = return $ "false"
+_pr_str _     (MalBoolean False) = return "false"
 _pr_str _     Nil                = return "nil"
-_pr_str pr (MalSeq _ (Vect False) items) = format <$> _pr_list pr " " items where
-    format x = "(" ++ x ++ ")"
-_pr_str pr (MalSeq _ (Vect True)  items) = format <$> _pr_list pr " " items where
-    format x = "[" ++ x ++ "]"
-_pr_str pr (MalHashMap _ m) = format <$> _pr_list pr " " (_flatTuples $ Map.assocs m) where
-    format x = "{" ++ x ++ "}"
-_pr_str pr (MalAtom _ r) = format  <$> (_pr_str pr =<< readIORef r) where
-    format x = "(atom " ++ x ++ ")"
-_pr_str _ (MalFunction {f_ast=Nil}) = pure "#<function>"
-_pr_str _ (MalFunction {f_ast=a, f_params=p, macro=False}) = format <$> _pr_str True a where
-    format x = "(fn* " ++ show p ++ " -> " ++ x ++ ")"
-_pr_str _ (MalFunction {f_ast=a, f_params=p, macro=True})  = format <$> _pr_str True a where
-    format x = "(macro* " ++ show p ++ " -> " ++ x ++ ")"
+_pr_str pr (MalSeq _ (Vect False) xs) = enclose "(" ")" <$> _pr_list pr " " xs
+_pr_str pr (MalSeq _ (Vect True)  xs) = enclose "[" "]" <$> _pr_list pr " " xs
+_pr_str pr (MalHashMap _ m)      = enclose "{" "}" <$> _pr_list pr " "
+                                    (Map.foldMapWithKey (\k v -> [decodeKey k, v]) m)
+_pr_str pr (MalAtom _ r)         = enclose "(atom " ")" <$> (_pr_str pr =<< readIORef r)
+_pr_str _ (MalFunction _ _)      = return "<fn>"
+_pr_str _ (MalMacro _)           = return "<macro>"
diff --git a/impls/haskell/Reader.hs b/impls/haskell/Reader.hs
index c775bb3b9c..47ed49cd2d 100644
--- a/impls/haskell/Reader.hs
+++ b/impls/haskell/Reader.hs
@@ -2,98 +2,122 @@ module Reader
 ( read_str )
 where
 
+import qualified Data.Map.Strict as Map
 import Text.ParserCombinators.Parsec (
-    Parser, (<|>), anyChar, char, digit, many, many1, noneOf, oneOf, parse)
-import qualified Data.Map as Map
+    Parser, parse, char, digit, anyChar,
+    (<|>), oneOf, noneOf, many, many1)
 
 import Types
 
---  Helpers
-
-symbolFalseTrueNil :: String -> MalVal
-symbolFalseTrueNil "true"  = MalBoolean True
-symbolFalseTrueNil "false" = MalBoolean False
-symbolFalseTrueNil "nil"   = Nil
-symbolFalseTrueNil s       = MalSymbol s
+----------------------------------------------------------------------
+--  A MAL grammar and a possible parsing are described here.
+
+--  If you are only interested in the grammar, please ignore the
+--  left-hand side of <$> and =<< operators (second column).
+
+--  *>  <*  <*>                     all mean concatenation
+--  <|>                             means alternative
+--  many  p = (many1 p) | empty     means p*, zero or more p
+--  many1 p = p (many p)            means p+, one or more p
+
+--  For efficiency, the alternative operator <|> expects each branch
+--  to either:
+--  * succeed,
+--  * fall after looking at the next character without consuming it,
+--  * or consume some input and fail, indicating that the input is
+--    incorrect and no remaining branches should be ignored.
+
+allowedChar   :: Parser Char
+allowedChar =                    noneOf "\n\r \"(),;[\\]{}"
+
+sep           :: Parser String
+sep         =                    many (oneOf  ", \n"
+                                       <|> char ';' <* many (noneOf "\n"))
+
+stringChar    :: Parser Char
+stringChar  = unescapeChar  <$> (char '\\' *>  anyChar)
+          <|>                    noneOf "\""
+
+afterMinus    :: Parser MalVal
+afterMinus  = negative      <$>  many1 digit
+          <|> hyphenSymbol  <$>  many allowedChar
+
+afterTilde    :: Parser MalVal
+afterTilde  = spliceUnquote <$> (char '@' *> sep *> form)
+          <|> unquote       <$> (sep *> form)
+
+form          :: Parser MalVal
+form        = MalString     <$> (char '"'  *> many stringChar <* char '"')
+          <|> MalKeyword    <$> (char ':'  *> many1 allowedChar)
+          <|>                    char '-'  *> afterMinus
+          <|> toList        <$> (char '('  *> sep *> many (form <* sep) <* char ')')
+          <|> vector        <$> (char '['  *> sep *> many (form <* sep) <* char ']')
+          <|> (toMap        =<<  char '{'  *> sep *> many (form <* sep) <* char '}')
+          <|> quote         <$> (char '\'' *> sep *> form)
+          <|> quasiquote    <$> (char '`'  *> sep *> form)
+          <|> deref         <$> (char '@'  *> sep *> form)
+          <|>                    char '~'  *> afterTilde
+          <|> withMeta      <$> (char '^'  *> sep *> form <* sep) <*> form
+          <|> positive      <$>  many1 digit
+          <|> symbol        <$>  many1 allowedChar
+
+read_form     :: Parser MalVal
+read_form   =                    sep *> form
+
+----------------------------------------------------------------------
+--  Part specific to Haskell
 
 addPrefix :: String -> MalVal -> MalVal
-addPrefix s m = toList [MalSymbol s, m]
-
-with_meta :: MalVal -> MalVal -> MalVal
-with_meta m x = toList [MalSymbol "with-meta", x, m]
-
-hash_map         :: [MalVal] -> Parser MalVal
-hash_map = g . keyValuePairs
-    where
-          g (Just pairs) = return $ MalHashMap (MetaData Nil) $ Map.fromList pairs
-          g Nothing      = fail "invalid contents inside map braces"
-
-toKeyword :: String -> MalVal
-toKeyword = MalString . (:) keywordMagic
-
-toVector :: [MalVal] -> MalVal
-toVector = MalSeq (MetaData Nil) (Vect True)
-
---  Parsing
-
---  For efficiency, <|> expects each choice in an alternative to
---  * either succeed,
---  * or fall after looking only at the next character
---  * or consume some input and fail for incorrect input.
-
---  The grammar should be human-readable in the first and third column
---  without former knowledge of Haskell, except these two regex-style
---  combinators:
---  many  p = (many1 p) | empty     AKA p*, zero or more p
---  many1 p = p (many p)            AKA p+, one or more p
-
-allowedChar    :: Parser Char
-allowedChar =                                 noneOf "\n\r \"(),;[\\]{}"
-
-separChar      :: Parser ()
-separChar   =  ()                         <$  oneOf "\n ,"
-          <|>  ()                         <$  char ';' <* many (noneOf "\n")
-
-sep            :: Parser ()
-sep         =  ()                         <$  many separChar
---  A comment may also reach the end of the input. The terminator, if
---  present, will be consumed by the first option later anyway.
-
-escapedChar    :: Parser Char
-escapedChar =  '\n'                       <$  char 'n'
-          <|>                                 anyChar
-
-stringChar     :: Parser Char
-stringChar  =                                 char '\\' *> escapedChar
-          <|>                                 noneOf "\""
-
-afterMinus     :: Parser MalVal
-afterMinus  =  MalNumber . negate . read  <$> many1 digit
-          <|>  MalSymbol . (:) '-'        <$> many allowedChar
-
-afterTilde     :: Parser MalVal
-afterTilde  =  addPrefix "splice-unquote" <$> (char '@' *> sep *> form)
-          <|>  addPrefix "unquote"        <$> (sep *> form)
-
-form           :: Parser MalVal
-form        =  MalString                  <$> (char '"' *> many stringChar <* char '"')
-          <|>  addPrefix "quote"          <$> (char '\'' *> sep *> form)
-          <|>  toList                     <$> (char '(' *> sep *> many (form <* sep) <* char ')')
-          <|>                                 char '-' *> afterMinus
-          <|>  MalNumber . read           <$> many1 digit
-          <|>  toKeyword                  <$> (char ':' *> many1 allowedChar)
-          <|>  addPrefix "deref"          <$> (char '@' *> sep *> form)
-          <|>  toVector                   <$> (char '[' *> sep *> many (form <* sep) <* char ']')
-          <|>  with_meta                  <$> (char '^' *> sep *> form <* sep) <*> form
-          <|>  addPrefix "quasiquote"     <$> (char '`' *> sep *> form)
-          <|>  (hash_map                  =<< char '{' *> sep *> many (form <* sep) <* char '}')
-          <|>                                 char '~' *> afterTilde
-          <|>  symbolFalseTrueNil         <$> many1 allowedChar
-
-top            :: Parser MalVal
-top         =                                 sep *> form
+addPrefix s x = toList [MalSymbol s, x]
+
+deref :: MalVal -> MalVal
+deref = addPrefix "deref"
+
+hyphenSymbol :: String -> MalVal
+hyphenSymbol = MalSymbol . (:) '-'
+
+negative ::  String ->  MalVal
+negative = MalNumber . negate . read
+
+positive :: String -> MalVal
+positive = MalNumber . read
+
+quasiquote :: MalVal -> MalVal
+quasiquote = addPrefix "quasiquote"
+
+quote :: MalVal -> MalVal
+quote = addPrefix "quote"
+
+spliceUnquote :: MalVal -> MalVal
+spliceUnquote = addPrefix "splice-unquote"
+
+toMap :: [MalVal] -> Parser MalVal
+toMap kvs = case kv2map Map.empty kvs of
+  Just m -> return m
+  Nothing -> fail "invalid contents in map braces"
+
+unquote :: MalVal -> MalVal
+unquote = addPrefix "unquote"
+
+symbol ::  String -> MalVal
+symbol "true"  = MalBoolean True
+symbol "false" = MalBoolean False
+symbol "nil"   = Nil
+symbol s       = MalSymbol s
+
+unescapeChar :: Char -> Char
+unescapeChar 'n' = '\n'
+unescapeChar c   = c
+
+vector :: [MalVal] -> MalVal
+vector = MalSeq (MetaData Nil) (Vect True)
+
+withMeta :: MalVal -> MalVal -> MalVal
+withMeta m d = toList [MalSymbol "with-meta", d, m]
+
+--  The only exported function
 
 read_str :: String -> IOThrows MalVal
-read_str str = case parse top "Mal" str of
+read_str str = case parse read_form "Mal" str of
     Left err -> throwStr $ show err
     Right val -> return val
diff --git a/impls/haskell/Types.hs b/impls/haskell/Types.hs
index 480195d7ec..d60a74bb00 100644
--- a/impls/haskell/Types.hs
+++ b/impls/haskell/Types.hs
@@ -1,13 +1,14 @@
 module Types
-( MalVal (..), IOThrows, Fn, Env, MetaData (..), Vect (..),
-  keyValuePairs, throwStr, toList, keywordMagic)
+( MalVal (..), IOThrows, Fn, MetaData (..), Vect (..),
+  decodeKey, encodeKey, kv2map,
+  throwStr, toList)
 where
 
 import Data.IORef (IORef)
-import qualified Data.Map as Map
+import qualified Data.Map.Strict as Map
+--  The documentation recommends strict except in specific cases.
 import Control.Monad.Except (ExceptT, throwError)
 
-
 -- Base Mal types --
 type Fn = [MalVal] -> IOThrows MalVal
 
@@ -20,32 +21,35 @@ data MalVal = Nil
             | MalNumber   Int
             | MalString   String
             | MalSymbol   String
+            | MalKeyword  String
             | MalSeq      MetaData Vect [MalVal]
             | MalHashMap  MetaData (Map.Map String MalVal)
             | MalAtom     MetaData (IORef MalVal)
-            | MalFunction {fn :: Fn,
-                           f_ast :: MalVal,
-                           f_params :: [String],
-                           macro :: Bool,
-                           meta :: MalVal}
+            | MalFunction MetaData Fn
+            | MalMacro    Fn
 
-keywordMagic :: Char
-keywordMagic = '\x029e'
+--  Stored into maps to distinguish keywords and symbols.
+encodeKey :: MalVal -> Maybe String
+encodeKey (MalString  s) = pure $ 't' : s
+encodeKey (MalKeyword s) = pure $ 'e' : s
+encodeKey _              = Nothing
 
-_equal_Q :: MalVal -> MalVal -> Bool
-_equal_Q Nil Nil = True
-_equal_Q (MalBoolean a) (MalBoolean b) = a == b
-_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 (MalSeq _ _ a) (MalSeq _ _ b) = a == b
-_equal_Q (MalHashMap _ a) (MalHashMap _ b) = a == b
-_equal_Q (MalAtom _ a) (MalAtom _ b) = a == b
-_equal_Q _ _ = False
+decodeKey :: String -> MalVal
+decodeKey ('t' : k) = MalString k
+decodeKey ('e' : k) = MalKeyword k
+decodeKey _         = error "internal error in Types.decodeKey"
 
 instance Eq MalVal where
-    x == y = _equal_Q x y
-
+    Nil              == Nil              = True
+    (MalBoolean a)   == (MalBoolean b)   = a == b
+    (MalNumber a)    == (MalNumber b)    = a == b
+    (MalString a)    == (MalString b)    = a == b
+    (MalKeyword a)   == (MalKeyword b)   = a == b
+    (MalSymbol a)    == (MalSymbol b)    = a == b
+    (MalSeq _ _ a)   == (MalSeq _ _ b)   = a == b
+    (MalHashMap _ a) == (MalHashMap _ b) = a == b
+    (MalAtom _ a)    == (MalAtom _ b)    = a == b
+    _                == _                = False
 
 --- Errors/Exceptions ---
 
@@ -54,16 +58,16 @@ type IOThrows = ExceptT MalVal IO
 throwStr :: String -> IOThrows a
 throwStr = throwError . MalString
 
--- Env types --
--- Note: Env functions are in Env module
-type Env = [IORef (Map.Map String MalVal)]
-
 --  Convenient shortcuts for common situations.
 
 toList :: [MalVal] -> MalVal
 toList = MalSeq (MetaData Nil) (Vect False)
 
-keyValuePairs :: [MalVal] -> Maybe [(String, MalVal)]
-keyValuePairs []                      = pure []
-keyValuePairs (MalString k : v : kvs) = ((k, v) :) <$> keyValuePairs kvs
-keyValuePairs _ = Nothing
+kv2map :: Map.Map String MalVal -> [MalVal] -> Maybe MalVal
+kv2map start forms = MalHashMap (MetaData Nil) <$> assoc1 start forms where
+  assoc1 :: Map.Map String MalVal -> [MalVal] -> Maybe (Map.Map String MalVal)
+  assoc1 acc (k : v : kvs) = do
+    encoded <- encodeKey k
+    assoc1 (Map.insert encoded v acc) kvs
+  assoc1 acc [] = Just acc
+  assoc1 _ [_] = Nothing
diff --git a/impls/haskell/step1_read_print.hs b/impls/haskell/step1_read_print.hs
index 9835f42575..cf9df742d7 100644
--- a/impls/haskell/step1_read_print.hs
+++ b/impls/haskell/step1_read_print.hs
@@ -1,6 +1,5 @@
 import System.IO (hFlush, stdout)
-import Control.Monad.Except (runExceptT)
-import Control.Monad.Trans (liftIO)
+import Control.Monad.Except (liftIO, runExceptT)
 
 import Readline (addHistory, readline, load_history)
 import Types
@@ -20,7 +19,7 @@ eval = id
 -- print
 
 mal_print :: MalVal -> IOThrows String
-mal_print = liftIO. Printer._pr_str True
+mal_print = liftIO . Printer._pr_str True
 
 -- repl
 
diff --git a/impls/haskell/step2_eval.hs b/impls/haskell/step2_eval.hs
index 70605c06d8..36fd0bedd7 100644
--- a/impls/haskell/step2_eval.hs
+++ b/impls/haskell/step2_eval.hs
@@ -1,13 +1,17 @@
 import System.IO (hFlush, stdout)
-import Control.Monad ((<=<))
-import Control.Monad.Except (runExceptT)
-import Control.Monad.Trans (liftIO)
+import Control.Monad.Except (liftIO, runExceptT)
 import qualified Data.Map as Map
 
 import Readline (addHistory, readline, load_history)
 import Types
 import Reader (read_str)
-import Printer (_pr_str)
+import Printer (_pr_list, _pr_str)
+
+--
+--  Set this to True for a trace of each call to Eval.
+--
+traceEval :: Bool
+traceEval = False
 
 -- read
 
@@ -16,32 +20,35 @@ mal_read = read_str
 
 -- eval
 
--- eval_ast is replaced with pattern matching.
-
-apply_ast :: [MalVal] -> IOThrows MalVal
-
-apply_ast [] = return $ toList []
-
-apply_ast ast = do
-    evd <- mapM eval ast
+apply_ast :: MalVal -> [MalVal] -> IOThrows MalVal
+apply_ast first rest = do
+    evd <- eval first
     case evd of
-        MalFunction {fn=f} : args -> f args
-        _ -> throwStr . (++) "invalid apply: " =<< liftIO (Printer._pr_str True (toList ast))
+        MalFunction _ f -> f =<< mapM eval rest
+        _               -> throwStr . (++) "invalid apply: " =<< liftIO (_pr_list True " " $ first : rest)
 
 eval :: MalVal -> IOThrows MalVal
-eval (MalSymbol sym)            = do
-    case Map.lookup sym repl_env of
-        Nothing  -> throwStr $ "'" ++ sym ++ "' not found"
-        Just val -> return val
-eval (MalSeq _ (Vect False) xs) = apply_ast xs
-eval (MalSeq m (Vect True)  xs) = MalSeq m (Vect True) <$> mapM eval xs
-eval (MalHashMap m xs)          = MalHashMap m         <$> mapM eval xs
-eval ast                        = return ast
+eval ast = do
+    case traceEval of
+        True -> liftIO $ do
+            putStr "EVAL: "
+            putStrLn =<< _pr_str True ast
+            hFlush stdout
+        False -> pure ()
+    case ast of
+        MalSymbol sym -> do
+            case Map.lookup sym repl_env of
+                Nothing  -> throwStr $ "'" ++ sym ++ "' not found"
+                Just val -> return val
+        MalSeq _ (Vect False) (a1 : as) -> apply_ast a1 as
+        MalSeq _ (Vect True)  xs        -> MalSeq (MetaData Nil) (Vect True) <$> mapM eval xs
+        MalHashMap _ xs                 -> MalHashMap (MetaData Nil) <$> mapM eval xs
+        _ -> return ast
 
 -- print
 
 mal_print :: MalVal -> IOThrows String
-mal_print = liftIO. Printer._pr_str True
+mal_print = liftIO . Printer._pr_str True
 
 -- repl
 
@@ -68,7 +75,7 @@ repl_env = Map.fromList [("+", _func add),
                          ("/", _func divd)]
 
 rep :: String -> IOThrows String
-rep = mal_print <=< eval <=< mal_read
+rep line = mal_print =<< eval =<< mal_read line
 
 repl_loop :: IO ()
 repl_loop = do
@@ -87,7 +94,7 @@ repl_loop = do
             repl_loop
 
 _func :: Fn -> MalVal
-_func f = MalFunction {fn=f, f_ast=Nil, f_params=[], macro=False, meta=Nil}
+_func f = MalFunction (MetaData Nil) f
 
 main :: IO ()
 main = do
diff --git a/impls/haskell/step3_env.hs b/impls/haskell/step3_env.hs
index 308a09a360..4edb7489d0 100644
--- a/impls/haskell/step3_env.hs
+++ b/impls/haskell/step3_env.hs
@@ -1,13 +1,17 @@
 import System.IO (hFlush, stdout)
-import Control.Monad ((<=<))
-import Control.Monad.Except (runExceptT)
-import Control.Monad.Trans (liftIO)
+import Control.Monad.Except (liftIO, runExceptT)
 
 import Readline (addHistory, readline, load_history)
 import Types
 import Reader (read_str)
-import Printer (_pr_str)
-import Env (env_new, env_get, env_set)
+import Printer (_pr_list, _pr_str)
+import Env (Env, env_get, env_let, env_put, env_repl, env_set)
+
+--
+--  Set this to True for a trace of each call to Eval.
+--
+traceEval :: Bool
+traceEval = False
 
 -- read
 
@@ -16,8 +20,6 @@ mal_read = read_str
 
 -- eval
 
--- eval_ast is replaced with pattern matching.
-
 let_bind :: Env -> [MalVal] -> IOThrows ()
 let_bind _ [] = return ()
 let_bind env (MalSymbol b : e : xs) = do
@@ -25,43 +27,52 @@ let_bind env (MalSymbol b : e : xs) = do
     let_bind env xs
 let_bind _ _ = throwStr "invalid let*"
 
-apply_ast :: [MalVal] -> Env -> IOThrows MalVal
+apply_ast :: MalVal -> [MalVal] -> Env -> IOThrows MalVal
 
-apply_ast [] _ = return $ toList []
-
-apply_ast [MalSymbol "def!", MalSymbol a1, a2] env = do
+apply_ast (MalSymbol "def!") [MalSymbol a1, a2] env = do
     evd <- eval env a2
     liftIO $ env_set env a1 evd
     return evd
-apply_ast (MalSymbol "def!" : _) _ = throwStr "invalid def!"
+apply_ast (MalSymbol "def!") _ _ = throwStr "invalid def!"
 
-apply_ast [MalSymbol "let*", MalSeq _ _ params, a2] env = do
-    let_env <- liftIO $ env_new env
+apply_ast (MalSymbol "let*") [MalSeq _ _ params, a2] env = do
+    let_env <- liftIO $ env_let env
     let_bind let_env params
     eval let_env a2
-apply_ast (MalSymbol "let*" : _) _ = throwStr "invalid let*"
+apply_ast (MalSymbol "let*") _ _ = throwStr "invalid let*"
 
-apply_ast ast env = do
-    evd <- mapM (eval env) ast
+apply_ast first rest env = do
+    evd <- eval env first
     case evd of
-        MalFunction {fn=f} : args -> f args
-        _ -> throwStr . (++) "invalid apply: " =<< liftIO (Printer._pr_str True (toList ast))
+        MalFunction _ f -> f =<< mapM (eval env) rest
+        _               -> throwStr . (++) "invalid apply: " =<< liftIO (_pr_list True " " $ first : rest)
 
 eval :: Env -> MalVal -> IOThrows MalVal
-eval env (MalSymbol sym)            = do
-    maybeVal <- liftIO $ env_get env sym
-    case maybeVal of
-        Nothing  -> throwStr $ "'" ++ sym ++ "' not found"
-        Just val -> return val
-eval env (MalSeq _ (Vect False) xs) = apply_ast xs env
-eval env (MalSeq m (Vect True)  xs) = MalSeq m (Vect True) <$> mapM (eval env) xs
-eval env (MalHashMap m xs)          = MalHashMap m         <$> mapM (eval env) xs
-eval _   ast                        = return ast
+eval env ast = do
+    case traceEval of
+        True -> liftIO $ do
+            putStr "EVAL: "
+            putStr =<< _pr_str True ast
+            putStr "   "
+            env_put env
+            putStrLn ""
+            hFlush stdout
+        False -> pure ()
+    case ast of
+        MalSymbol sym -> do
+            maybeVal <- liftIO $ env_get env sym
+            case maybeVal of
+                Nothing  -> throwStr $ "'" ++ sym ++ "' not found"
+                Just val -> return val
+        MalSeq _ (Vect False) (a1 : as) -> apply_ast a1 as env
+        MalSeq _ (Vect True)  xs        -> MalSeq (MetaData Nil) (Vect True) <$> mapM (eval env) xs
+        MalHashMap _ xs                 -> MalHashMap (MetaData Nil) <$> mapM (eval env) xs
+        _ -> return ast
 
 -- print
 
 mal_print :: MalVal -> IOThrows String
-mal_print = liftIO. Printer._pr_str True
+mal_print = liftIO . Printer._pr_str True
 
 -- repl
 
@@ -82,7 +93,7 @@ divd [MalNumber a, MalNumber b] = return $ MalNumber $ a `div` b
 divd _ = throwStr $ "illegal arguments to /"
 
 rep :: Env -> String -> IOThrows String
-rep env = mal_print <=< eval env <=< mal_read
+rep env line = mal_print =<< eval env =<< mal_read line
 
 repl_loop :: Env -> IO ()
 repl_loop env = do
@@ -102,13 +113,13 @@ repl_loop env = do
 
 defBuiltIn :: Env -> String -> Fn -> IO ()
 defBuiltIn env sym f =
-    env_set env sym $ MalFunction {fn=f, f_ast=Nil, f_params=[], macro=False, meta=Nil}
+    env_set env sym $ MalFunction (MetaData Nil) f
 
 main :: IO ()
 main = do
     load_history
 
-    repl_env <- env_new []
+    repl_env <- env_repl
 
     defBuiltIn repl_env "+" add
     defBuiltIn repl_env "-" sub
diff --git a/impls/haskell/step4_if_fn_do.hs b/impls/haskell/step4_if_fn_do.hs
index 032fc90307..bfc2e49aa0 100644
--- a/impls/haskell/step4_if_fn_do.hs
+++ b/impls/haskell/step4_if_fn_do.hs
@@ -1,16 +1,20 @@
 import System.IO (hFlush, stdout)
-import Control.Monad ((<=<))
-import Control.Monad.Except (runExceptT)
-import Control.Monad.Trans (liftIO)
+import Control.Monad.Except (liftIO, runExceptT)
 import Data.Foldable (foldlM)
 
 import Readline (addHistory, readline, load_history)
 import Types
 import Reader (read_str)
-import Printer (_pr_str)
-import Env (env_new, env_bind, env_get, env_set)
+import Printer(_pr_list, _pr_str)
+import Env (Env, env_apply, env_get, env_let, env_put, env_repl, env_set)
 import Core (ns)
 
+--
+--  Set this to True for a trace of each call to Eval.
+--
+traceEval :: Bool
+traceEval = False
+
 -- read
 
 mal_read :: String -> IOThrows MalVal
@@ -18,8 +22,6 @@ mal_read = read_str
 
 -- eval
 
--- eval_ast is replaced with pattern matching.
-
 let_bind :: Env -> [MalVal] -> IOThrows ()
 let_bind _ [] = return ()
 let_bind env (MalSymbol b : e : xs) = do
@@ -27,80 +29,84 @@ let_bind env (MalSymbol b : e : xs) = do
     let_bind env xs
 let_bind _ _ = throwStr "invalid let*"
 
-unWrapSymbol :: MalVal -> IOThrows String
-unWrapSymbol (MalSymbol s) = return s
-unWrapSymbol _ = throwStr "fn* parameter must be symbols"
-
-newFunction :: MalVal -> Env -> [String] -> MalVal
-newFunction a env p = MalFunction {f_ast=a, f_params=p, macro=False, meta=Nil,
-    fn=(\args -> do
-        fn_env <- liftIO $ env_new env
-        ok <- liftIO $ env_bind fn_env p args
-        case ok of
-            True  -> eval fn_env a
-            False -> throwStr $ "actual parameters do not match signature " ++ show p)}
-
-apply_ast :: [MalVal] -> Env -> IOThrows MalVal
+apply_ast :: MalVal -> [MalVal] -> Env -> IOThrows MalVal
 
-apply_ast [] _ = return $ toList []
-
-apply_ast [MalSymbol "def!", MalSymbol a1, a2] env = do
+apply_ast (MalSymbol "def!") [MalSymbol a1, a2] env = do
     evd <- eval env a2
     liftIO $ env_set env a1 evd
     return evd
-apply_ast (MalSymbol "def!" : _) _ = throwStr "invalid def!"
+apply_ast (MalSymbol "def!") _ _ = throwStr "invalid def!"
 
-apply_ast [MalSymbol "let*", MalSeq _ _ params, a2] env = do
-    let_env <- liftIO $ env_new env
+apply_ast (MalSymbol "let*") [MalSeq _ _ params, a2] env = do
+    let_env <- liftIO $ env_let env
     let_bind let_env params
     eval let_env a2
-apply_ast (MalSymbol "let*" : _) _ = throwStr "invalid let*"
+apply_ast (MalSymbol "let*") _ _ = throwStr "invalid let*"
 
-apply_ast (MalSymbol "do" : args) env = foldlM (const $ eval env) Nil args
+apply_ast (MalSymbol "do") args env = foldlM (const $ eval env) Nil args
 
-apply_ast [MalSymbol "if", a1, a2, a3] env = do
+apply_ast (MalSymbol "if") [a1, a2, a3] env = do
     cond <- eval env a1
     eval env $ case cond of
         Nil              -> a3
         MalBoolean False -> a3
         _                -> a2
-apply_ast [MalSymbol "if", a1, a2] env = do
+apply_ast (MalSymbol "if") [a1, a2] env = do
     cond <- eval env a1
     case cond of
         Nil              -> return Nil
         MalBoolean False -> return Nil
         _                -> eval env a2
-apply_ast (MalSymbol "if" : _) _ = throwStr "invalid if"
-
-apply_ast [MalSymbol "fn*", MalSeq _ _ params, ast] env = newFunction ast env <$> mapM unWrapSymbol params
-apply_ast (MalSymbol "fn*" : _) _ = throwStr "invalid fn*"
-
-apply_ast ast env = do
-    evd <- mapM (eval env) ast
+apply_ast (MalSymbol "if") _ _ = throwStr "invalid if"
+
+apply_ast (MalSymbol "fn*") [MalSeq _ _ params, ast] env = return $ MalFunction (MetaData Nil) fn where
+    fn :: [MalVal] -> IOThrows MalVal
+    fn args = do
+        case env_apply env params args of
+            Just fn_env -> eval fn_env ast
+            Nothing -> do
+                p <- liftIO $ _pr_list True " " params
+                a <- liftIO $ _pr_list True " " args
+                throwStr $ "actual parameters: " ++ a ++ " do not match signature: " ++ p
+apply_ast (MalSymbol "fn*") _ _ = throwStr "invalid fn*"
+
+apply_ast first rest env = do
+    evd <- eval env first
     case evd of
-        MalFunction {fn=f} : args -> f args
-        _ -> throwStr . (++) "invalid apply: " =<< liftIO (Printer._pr_str True (toList ast))
+        MalFunction _ f -> f =<< mapM (eval env) rest
+        _               -> throwStr . (++) "invalid apply: " =<< liftIO (_pr_list True " " $ first : rest)
 
 eval :: Env -> MalVal -> IOThrows MalVal
-eval env (MalSymbol sym)            = do
-    maybeVal <- liftIO $ env_get env sym
-    case maybeVal of
-        Nothing  -> throwStr $ "'" ++ sym ++ "' not found"
-        Just val -> return val
-eval env (MalSeq _ (Vect False) xs) = apply_ast xs env
-eval env (MalSeq m (Vect True)  xs) = MalSeq m (Vect True) <$> mapM (eval env) xs
-eval env (MalHashMap m xs)          = MalHashMap m         <$> mapM (eval env) xs
-eval _   ast                        = return ast
+eval env ast = do
+    case traceEval of
+        True -> liftIO $ do
+            putStr "EVAL: "
+            putStr =<< _pr_str True ast
+            putStr "   "
+            env_put env
+            putStrLn ""
+            hFlush stdout
+        False -> pure ()
+    case ast of
+        MalSymbol sym -> do
+            maybeVal <- liftIO $ env_get env sym
+            case maybeVal of
+                Nothing  -> throwStr $ "'" ++ sym ++ "' not found"
+                Just val -> return val
+        MalSeq _ (Vect False) (a1 : as) -> apply_ast a1 as env
+        MalSeq _ (Vect True)  xs        -> MalSeq (MetaData Nil) (Vect True) <$> mapM (eval env) xs
+        MalHashMap _ xs                 -> MalHashMap (MetaData Nil) <$> mapM (eval env) xs
+        _ -> return ast
 
 -- print
 
 mal_print :: MalVal -> IOThrows String
-mal_print = liftIO. Printer._pr_str True
+mal_print = liftIO . Printer._pr_str True
 
 -- repl
 
 rep :: Env -> String -> IOThrows String
-rep env = mal_print <=< eval env <=< mal_read
+rep env line = mal_print =<< eval env =<< mal_read line
 
 repl_loop :: Env -> IO ()
 repl_loop env = do
@@ -129,13 +135,13 @@ re repl_env line = do
 
 defBuiltIn :: Env -> (String, Fn) -> IO ()
 defBuiltIn env (sym, f) =
-    env_set env sym $ MalFunction {fn=f, f_ast=Nil, f_params=[], macro=False, meta=Nil}
+    env_set env sym $ MalFunction (MetaData Nil) f
 
 main :: IO ()
 main = do
     load_history
 
-    repl_env <- env_new []
+    repl_env <- env_repl
 
     -- core.hs: defined using Haskell
     mapM_ (defBuiltIn repl_env) Core.ns
diff --git a/impls/haskell/step5_tco.hs b/impls/haskell/step5_tco.hs
index 032fc90307..bfc2e49aa0 100644
--- a/impls/haskell/step5_tco.hs
+++ b/impls/haskell/step5_tco.hs
@@ -1,16 +1,20 @@
 import System.IO (hFlush, stdout)
-import Control.Monad ((<=<))
-import Control.Monad.Except (runExceptT)
-import Control.Monad.Trans (liftIO)
+import Control.Monad.Except (liftIO, runExceptT)
 import Data.Foldable (foldlM)
 
 import Readline (addHistory, readline, load_history)
 import Types
 import Reader (read_str)
-import Printer (_pr_str)
-import Env (env_new, env_bind, env_get, env_set)
+import Printer(_pr_list, _pr_str)
+import Env (Env, env_apply, env_get, env_let, env_put, env_repl, env_set)
 import Core (ns)
 
+--
+--  Set this to True for a trace of each call to Eval.
+--
+traceEval :: Bool
+traceEval = False
+
 -- read
 
 mal_read :: String -> IOThrows MalVal
@@ -18,8 +22,6 @@ mal_read = read_str
 
 -- eval
 
--- eval_ast is replaced with pattern matching.
-
 let_bind :: Env -> [MalVal] -> IOThrows ()
 let_bind _ [] = return ()
 let_bind env (MalSymbol b : e : xs) = do
@@ -27,80 +29,84 @@ let_bind env (MalSymbol b : e : xs) = do
     let_bind env xs
 let_bind _ _ = throwStr "invalid let*"
 
-unWrapSymbol :: MalVal -> IOThrows String
-unWrapSymbol (MalSymbol s) = return s
-unWrapSymbol _ = throwStr "fn* parameter must be symbols"
-
-newFunction :: MalVal -> Env -> [String] -> MalVal
-newFunction a env p = MalFunction {f_ast=a, f_params=p, macro=False, meta=Nil,
-    fn=(\args -> do
-        fn_env <- liftIO $ env_new env
-        ok <- liftIO $ env_bind fn_env p args
-        case ok of
-            True  -> eval fn_env a
-            False -> throwStr $ "actual parameters do not match signature " ++ show p)}
-
-apply_ast :: [MalVal] -> Env -> IOThrows MalVal
+apply_ast :: MalVal -> [MalVal] -> Env -> IOThrows MalVal
 
-apply_ast [] _ = return $ toList []
-
-apply_ast [MalSymbol "def!", MalSymbol a1, a2] env = do
+apply_ast (MalSymbol "def!") [MalSymbol a1, a2] env = do
     evd <- eval env a2
     liftIO $ env_set env a1 evd
     return evd
-apply_ast (MalSymbol "def!" : _) _ = throwStr "invalid def!"
+apply_ast (MalSymbol "def!") _ _ = throwStr "invalid def!"
 
-apply_ast [MalSymbol "let*", MalSeq _ _ params, a2] env = do
-    let_env <- liftIO $ env_new env
+apply_ast (MalSymbol "let*") [MalSeq _ _ params, a2] env = do
+    let_env <- liftIO $ env_let env
     let_bind let_env params
     eval let_env a2
-apply_ast (MalSymbol "let*" : _) _ = throwStr "invalid let*"
+apply_ast (MalSymbol "let*") _ _ = throwStr "invalid let*"
 
-apply_ast (MalSymbol "do" : args) env = foldlM (const $ eval env) Nil args
+apply_ast (MalSymbol "do") args env = foldlM (const $ eval env) Nil args
 
-apply_ast [MalSymbol "if", a1, a2, a3] env = do
+apply_ast (MalSymbol "if") [a1, a2, a3] env = do
     cond <- eval env a1
     eval env $ case cond of
         Nil              -> a3
         MalBoolean False -> a3
         _                -> a2
-apply_ast [MalSymbol "if", a1, a2] env = do
+apply_ast (MalSymbol "if") [a1, a2] env = do
     cond <- eval env a1
     case cond of
         Nil              -> return Nil
         MalBoolean False -> return Nil
         _                -> eval env a2
-apply_ast (MalSymbol "if" : _) _ = throwStr "invalid if"
-
-apply_ast [MalSymbol "fn*", MalSeq _ _ params, ast] env = newFunction ast env <$> mapM unWrapSymbol params
-apply_ast (MalSymbol "fn*" : _) _ = throwStr "invalid fn*"
-
-apply_ast ast env = do
-    evd <- mapM (eval env) ast
+apply_ast (MalSymbol "if") _ _ = throwStr "invalid if"
+
+apply_ast (MalSymbol "fn*") [MalSeq _ _ params, ast] env = return $ MalFunction (MetaData Nil) fn where
+    fn :: [MalVal] -> IOThrows MalVal
+    fn args = do
+        case env_apply env params args of
+            Just fn_env -> eval fn_env ast
+            Nothing -> do
+                p <- liftIO $ _pr_list True " " params
+                a <- liftIO $ _pr_list True " " args
+                throwStr $ "actual parameters: " ++ a ++ " do not match signature: " ++ p
+apply_ast (MalSymbol "fn*") _ _ = throwStr "invalid fn*"
+
+apply_ast first rest env = do
+    evd <- eval env first
     case evd of
-        MalFunction {fn=f} : args -> f args
-        _ -> throwStr . (++) "invalid apply: " =<< liftIO (Printer._pr_str True (toList ast))
+        MalFunction _ f -> f =<< mapM (eval env) rest
+        _               -> throwStr . (++) "invalid apply: " =<< liftIO (_pr_list True " " $ first : rest)
 
 eval :: Env -> MalVal -> IOThrows MalVal
-eval env (MalSymbol sym)            = do
-    maybeVal <- liftIO $ env_get env sym
-    case maybeVal of
-        Nothing  -> throwStr $ "'" ++ sym ++ "' not found"
-        Just val -> return val
-eval env (MalSeq _ (Vect False) xs) = apply_ast xs env
-eval env (MalSeq m (Vect True)  xs) = MalSeq m (Vect True) <$> mapM (eval env) xs
-eval env (MalHashMap m xs)          = MalHashMap m         <$> mapM (eval env) xs
-eval _   ast                        = return ast
+eval env ast = do
+    case traceEval of
+        True -> liftIO $ do
+            putStr "EVAL: "
+            putStr =<< _pr_str True ast
+            putStr "   "
+            env_put env
+            putStrLn ""
+            hFlush stdout
+        False -> pure ()
+    case ast of
+        MalSymbol sym -> do
+            maybeVal <- liftIO $ env_get env sym
+            case maybeVal of
+                Nothing  -> throwStr $ "'" ++ sym ++ "' not found"
+                Just val -> return val
+        MalSeq _ (Vect False) (a1 : as) -> apply_ast a1 as env
+        MalSeq _ (Vect True)  xs        -> MalSeq (MetaData Nil) (Vect True) <$> mapM (eval env) xs
+        MalHashMap _ xs                 -> MalHashMap (MetaData Nil) <$> mapM (eval env) xs
+        _ -> return ast
 
 -- print
 
 mal_print :: MalVal -> IOThrows String
-mal_print = liftIO. Printer._pr_str True
+mal_print = liftIO . Printer._pr_str True
 
 -- repl
 
 rep :: Env -> String -> IOThrows String
-rep env = mal_print <=< eval env <=< mal_read
+rep env line = mal_print =<< eval env =<< mal_read line
 
 repl_loop :: Env -> IO ()
 repl_loop env = do
@@ -129,13 +135,13 @@ re repl_env line = do
 
 defBuiltIn :: Env -> (String, Fn) -> IO ()
 defBuiltIn env (sym, f) =
-    env_set env sym $ MalFunction {fn=f, f_ast=Nil, f_params=[], macro=False, meta=Nil}
+    env_set env sym $ MalFunction (MetaData Nil) f
 
 main :: IO ()
 main = do
     load_history
 
-    repl_env <- env_new []
+    repl_env <- env_repl
 
     -- core.hs: defined using Haskell
     mapM_ (defBuiltIn repl_env) Core.ns
diff --git a/impls/haskell/step6_file.hs b/impls/haskell/step6_file.hs
index 99fc24265d..01f28a8e3f 100644
--- a/impls/haskell/step6_file.hs
+++ b/impls/haskell/step6_file.hs
@@ -1,17 +1,21 @@
 import System.IO (hFlush, stdout)
 import System.Environment (getArgs)
-import Control.Monad ((<=<))
-import Control.Monad.Except (runExceptT)
-import Control.Monad.Trans (liftIO)
+import Control.Monad.Except (liftIO, runExceptT)
 import Data.Foldable (foldlM)
 
 import Readline (addHistory, readline, load_history)
 import Types
 import Reader (read_str)
-import Printer (_pr_str)
-import Env (env_new, env_bind, env_get, env_set)
+import Printer(_pr_list, _pr_str)
+import Env (Env, env_apply, env_get, env_let, env_put, env_repl, env_set)
 import Core (ns)
 
+--
+--  Set this to True for a trace of each call to Eval.
+--
+traceEval :: Bool
+traceEval = False
+
 -- read
 
 mal_read :: String -> IOThrows MalVal
@@ -19,8 +23,6 @@ mal_read = read_str
 
 -- eval
 
--- eval_ast is replaced with pattern matching.
-
 let_bind :: Env -> [MalVal] -> IOThrows ()
 let_bind _ [] = return ()
 let_bind env (MalSymbol b : e : xs) = do
@@ -28,80 +30,84 @@ let_bind env (MalSymbol b : e : xs) = do
     let_bind env xs
 let_bind _ _ = throwStr "invalid let*"
 
-unWrapSymbol :: MalVal -> IOThrows String
-unWrapSymbol (MalSymbol s) = return s
-unWrapSymbol _ = throwStr "fn* parameter must be symbols"
-
-newFunction :: MalVal -> Env -> [String] -> MalVal
-newFunction a env p = MalFunction {f_ast=a, f_params=p, macro=False, meta=Nil,
-    fn=(\args -> do
-        fn_env <- liftIO $ env_new env
-        ok <- liftIO $ env_bind fn_env p args
-        case ok of
-            True  -> eval fn_env a
-            False -> throwStr $ "actual parameters do not match signature " ++ show p)}
-
-apply_ast :: [MalVal] -> Env -> IOThrows MalVal
+apply_ast :: MalVal -> [MalVal] -> Env -> IOThrows MalVal
 
-apply_ast [] _ = return $ toList []
-
-apply_ast [MalSymbol "def!", MalSymbol a1, a2] env = do
+apply_ast (MalSymbol "def!") [MalSymbol a1, a2] env = do
     evd <- eval env a2
     liftIO $ env_set env a1 evd
     return evd
-apply_ast (MalSymbol "def!" : _) _ = throwStr "invalid def!"
+apply_ast (MalSymbol "def!") _ _ = throwStr "invalid def!"
 
-apply_ast [MalSymbol "let*", MalSeq _ _ params, a2] env = do
-    let_env <- liftIO $ env_new env
+apply_ast (MalSymbol "let*") [MalSeq _ _ params, a2] env = do
+    let_env <- liftIO $ env_let env
     let_bind let_env params
     eval let_env a2
-apply_ast (MalSymbol "let*" : _) _ = throwStr "invalid let*"
+apply_ast (MalSymbol "let*") _ _ = throwStr "invalid let*"
 
-apply_ast (MalSymbol "do" : args) env = foldlM (const $ eval env) Nil args
+apply_ast (MalSymbol "do") args env = foldlM (const $ eval env) Nil args
 
-apply_ast [MalSymbol "if", a1, a2, a3] env = do
+apply_ast (MalSymbol "if") [a1, a2, a3] env = do
     cond <- eval env a1
     eval env $ case cond of
         Nil              -> a3
         MalBoolean False -> a3
         _                -> a2
-apply_ast [MalSymbol "if", a1, a2] env = do
+apply_ast (MalSymbol "if") [a1, a2] env = do
     cond <- eval env a1
     case cond of
         Nil              -> return Nil
         MalBoolean False -> return Nil
         _                -> eval env a2
-apply_ast (MalSymbol "if" : _) _ = throwStr "invalid if"
-
-apply_ast [MalSymbol "fn*", MalSeq _ _ params, ast] env = newFunction ast env <$> mapM unWrapSymbol params
-apply_ast (MalSymbol "fn*" : _) _ = throwStr "invalid fn*"
-
-apply_ast ast env = do
-    evd <- mapM (eval env) ast
+apply_ast (MalSymbol "if") _ _ = throwStr "invalid if"
+
+apply_ast (MalSymbol "fn*") [MalSeq _ _ params, ast] env = return $ MalFunction (MetaData Nil) fn where
+    fn :: [MalVal] -> IOThrows MalVal
+    fn args = do
+        case env_apply env params args of
+            Just fn_env -> eval fn_env ast
+            Nothing -> do
+                p <- liftIO $ _pr_list True " " params
+                a <- liftIO $ _pr_list True " " args
+                throwStr $ "actual parameters: " ++ a ++ " do not match signature: " ++ p
+apply_ast (MalSymbol "fn*") _ _ = throwStr "invalid fn*"
+
+apply_ast first rest env = do
+    evd <- eval env first
     case evd of
-        MalFunction {fn=f} : args -> f args
-        _ -> throwStr . (++) "invalid apply: " =<< liftIO (Printer._pr_str True (toList ast))
+        MalFunction _ f -> f =<< mapM (eval env) rest
+        _               -> throwStr . (++) "invalid apply: " =<< liftIO (_pr_list True " " $ first : rest)
 
 eval :: Env -> MalVal -> IOThrows MalVal
-eval env (MalSymbol sym)            = do
-    maybeVal <- liftIO $ env_get env sym
-    case maybeVal of
-        Nothing  -> throwStr $ "'" ++ sym ++ "' not found"
-        Just val -> return val
-eval env (MalSeq _ (Vect False) xs) = apply_ast xs env
-eval env (MalSeq m (Vect True)  xs) = MalSeq m (Vect True) <$> mapM (eval env) xs
-eval env (MalHashMap m xs)          = MalHashMap m         <$> mapM (eval env) xs
-eval _   ast                        = return ast
+eval env ast = do
+    case traceEval of
+        True -> liftIO $ do
+            putStr "EVAL: "
+            putStr =<< _pr_str True ast
+            putStr "   "
+            env_put env
+            putStrLn ""
+            hFlush stdout
+        False -> pure ()
+    case ast of
+        MalSymbol sym -> do
+            maybeVal <- liftIO $ env_get env sym
+            case maybeVal of
+                Nothing  -> throwStr $ "'" ++ sym ++ "' not found"
+                Just val -> return val
+        MalSeq _ (Vect False) (a1 : as) -> apply_ast a1 as env
+        MalSeq _ (Vect True)  xs        -> MalSeq (MetaData Nil) (Vect True) <$> mapM (eval env) xs
+        MalHashMap _ xs                 -> MalHashMap (MetaData Nil) <$> mapM (eval env) xs
+        _ -> return ast
 
 -- print
 
 mal_print :: MalVal -> IOThrows String
-mal_print = liftIO. Printer._pr_str True
+mal_print = liftIO . Printer._pr_str True
 
 -- repl
 
 rep :: Env -> String -> IOThrows String
-rep env = mal_print <=< eval env <=< mal_read
+rep env line = mal_print =<< eval env =<< mal_read line
 
 repl_loop :: Env -> IO ()
 repl_loop env = do
@@ -130,7 +136,7 @@ re repl_env line = do
 
 defBuiltIn :: Env -> (String, Fn) -> IO ()
 defBuiltIn env (sym, f) =
-    env_set env sym $ MalFunction {fn=f, f_ast=Nil, f_params=[], macro=False, meta=Nil}
+    env_set env sym $ MalFunction (MetaData Nil) f
 
 evalFn :: Env -> Fn
 evalFn env [ast] = eval env ast
@@ -141,7 +147,7 @@ main = do
     args <- getArgs
     load_history
 
-    repl_env <- env_new []
+    repl_env <- env_repl
 
     -- core.hs: defined using Haskell
     mapM_ (defBuiltIn repl_env) Core.ns
diff --git a/impls/haskell/step7_quote.hs b/impls/haskell/step7_quote.hs
index 30806880cb..26a4130a1a 100644
--- a/impls/haskell/step7_quote.hs
+++ b/impls/haskell/step7_quote.hs
@@ -1,17 +1,21 @@
 import System.IO (hFlush, stdout)
 import System.Environment (getArgs)
-import Control.Monad ((<=<))
-import Control.Monad.Except (runExceptT)
-import Control.Monad.Trans (liftIO)
+import Control.Monad.Except (liftIO, runExceptT)
 import Data.Foldable (foldlM, foldrM)
 
 import Readline (addHistory, readline, load_history)
 import Types
 import Reader (read_str)
-import Printer (_pr_str)
-import Env (env_new, env_bind, env_get, env_set)
+import Printer(_pr_list, _pr_str)
+import Env (Env, env_apply, env_get, env_let, env_put, env_repl, env_set)
 import Core (ns)
 
+--
+--  Set this to True for a trace of each call to Eval.
+--
+traceEval :: Bool
+traceEval = False
+
 -- read
 
 mal_read :: String -> IOThrows MalVal
@@ -19,8 +23,6 @@ mal_read = read_str
 
 -- eval
 
--- starts-with is replaced with pattern matching.
-
 qqIter :: MalVal -> MalVal -> IOThrows MalVal
 qqIter (MalSeq _ (Vect False) [MalSymbol "splice-unquote", x]) acc = return $ toList [MalSymbol "concat", x, acc]
 qqIter (MalSeq _ (Vect False) (MalSymbol "splice-unquote" : _)) _ = throwStr "invalid splice-unquote"
@@ -39,8 +41,6 @@ quasiquote ast@(MalHashMap _ _) = return $ toList [MalSymbol "quote", ast]
 quasiquote ast@(MalSymbol _)    = return $ toList [MalSymbol "quote", ast]
 quasiquote ast = return ast
 
--- eval_ast is replaced with pattern matching.
-
 let_bind :: Env -> [MalVal] -> IOThrows ()
 let_bind _ [] = return ()
 let_bind env (MalSymbol b : e : xs) = do
@@ -48,89 +48,93 @@ let_bind env (MalSymbol b : e : xs) = do
     let_bind env xs
 let_bind _ _ = throwStr "invalid let*"
 
-unWrapSymbol :: MalVal -> IOThrows String
-unWrapSymbol (MalSymbol s) = return s
-unWrapSymbol _ = throwStr "fn* parameter must be symbols"
-
-newFunction :: MalVal -> Env -> [String] -> MalVal
-newFunction a env p = MalFunction {f_ast=a, f_params=p, macro=False, meta=Nil,
-    fn=(\args -> do
-        fn_env <- liftIO $ env_new env
-        ok <- liftIO $ env_bind fn_env p args
-        case ok of
-            True  -> eval fn_env a
-            False -> throwStr $ "actual parameters do not match signature " ++ show p)}
-
-apply_ast :: [MalVal] -> Env -> IOThrows MalVal
+apply_ast :: MalVal -> [MalVal] -> Env -> IOThrows MalVal
 
-apply_ast [] _ = return $ toList []
-
-apply_ast [MalSymbol "def!", MalSymbol a1, a2] env = do
+apply_ast (MalSymbol "def!") [MalSymbol a1, a2] env = do
     evd <- eval env a2
     liftIO $ env_set env a1 evd
     return evd
-apply_ast (MalSymbol "def!" : _) _ = throwStr "invalid def!"
+apply_ast (MalSymbol "def!") _ _ = throwStr "invalid def!"
 
-apply_ast [MalSymbol "let*", MalSeq _ _ params, a2] env = do
-    let_env <- liftIO $ env_new env
+apply_ast (MalSymbol "let*") [MalSeq _ _ params, a2] env = do
+    let_env <- liftIO $ env_let env
     let_bind let_env params
     eval let_env a2
-apply_ast (MalSymbol "let*" : _) _ = throwStr "invalid let*"
+apply_ast (MalSymbol "let*") _ _ = throwStr "invalid let*"
 
-apply_ast [MalSymbol "quote", a1] _ = return a1
-apply_ast (MalSymbol "quote" : _) _ = throwStr "invalid quote"
+apply_ast (MalSymbol "quote") [a1] _ = return a1
+apply_ast (MalSymbol "quote") _ _ = throwStr "invalid quote"
 
-apply_ast [MalSymbol "quasiquoteexpand", a1] _ = quasiquote a1
-apply_ast (MalSymbol "quasiquoteexpand" : _) _ = throwStr "invalid quasiquote"
+apply_ast (MalSymbol "quasiquoteexpand") [a1] _ = quasiquote a1
+apply_ast (MalSymbol "quasiquoteexpand") _ _ = throwStr "invalid quasiquote"
 
-apply_ast [MalSymbol "quasiquote", a1] env = eval env =<< quasiquote a1
-apply_ast (MalSymbol "quasiquote" : _) _ = throwStr "invalid quasiquote"
+apply_ast (MalSymbol "quasiquote") [a1] env = eval env =<< quasiquote a1
+apply_ast (MalSymbol "quasiquote") _ _ = throwStr "invalid quasiquote"
 
-apply_ast (MalSymbol "do" : args) env = foldlM (const $ eval env) Nil args
+apply_ast (MalSymbol "do") args env = foldlM (const $ eval env) Nil args
 
-apply_ast [MalSymbol "if", a1, a2, a3] env = do
+apply_ast (MalSymbol "if") [a1, a2, a3] env = do
     cond <- eval env a1
     eval env $ case cond of
         Nil              -> a3
         MalBoolean False -> a3
         _                -> a2
-apply_ast [MalSymbol "if", a1, a2] env = do
+apply_ast (MalSymbol "if") [a1, a2] env = do
     cond <- eval env a1
     case cond of
         Nil              -> return Nil
         MalBoolean False -> return Nil
         _                -> eval env a2
-apply_ast (MalSymbol "if" : _) _ = throwStr "invalid if"
-
-apply_ast [MalSymbol "fn*", MalSeq _ _ params, ast] env = newFunction ast env <$> mapM unWrapSymbol params
-apply_ast (MalSymbol "fn*" : _) _ = throwStr "invalid fn*"
-
-apply_ast ast env = do
-    evd <- mapM (eval env) ast
+apply_ast (MalSymbol "if") _ _ = throwStr "invalid if"
+
+apply_ast (MalSymbol "fn*") [MalSeq _ _ params, ast] env = return $ MalFunction (MetaData Nil) fn where
+    fn :: [MalVal] -> IOThrows MalVal
+    fn args = do
+        case env_apply env params args of
+            Just fn_env -> eval fn_env ast
+            Nothing -> do
+                p <- liftIO $ _pr_list True " " params
+                a <- liftIO $ _pr_list True " " args
+                throwStr $ "actual parameters: " ++ a ++ " do not match signature: " ++ p
+apply_ast (MalSymbol "fn*") _ _ = throwStr "invalid fn*"
+
+apply_ast first rest env = do
+    evd <- eval env first
     case evd of
-        MalFunction {fn=f} : args -> f args
-        _ -> throwStr . (++) "invalid apply: " =<< liftIO (Printer._pr_str True (toList ast))
+        MalFunction _ f -> f =<< mapM (eval env) rest
+        _               -> throwStr . (++) "invalid apply: " =<< liftIO (_pr_list True " " $ first : rest)
 
 eval :: Env -> MalVal -> IOThrows MalVal
-eval env (MalSymbol sym)            = do
-    maybeVal <- liftIO $ env_get env sym
-    case maybeVal of
-        Nothing  -> throwStr $ "'" ++ sym ++ "' not found"
-        Just val -> return val
-eval env (MalSeq _ (Vect False) xs) = apply_ast xs env
-eval env (MalSeq m (Vect True)  xs) = MalSeq m (Vect True) <$> mapM (eval env) xs
-eval env (MalHashMap m xs)          = MalHashMap m         <$> mapM (eval env) xs
-eval _   ast                        = return ast
+eval env ast = do
+    case traceEval of
+        True -> liftIO $ do
+            putStr "EVAL: "
+            putStr =<< _pr_str True ast
+            putStr "   "
+            env_put env
+            putStrLn ""
+            hFlush stdout
+        False -> pure ()
+    case ast of
+        MalSymbol sym -> do
+            maybeVal <- liftIO $ env_get env sym
+            case maybeVal of
+                Nothing  -> throwStr $ "'" ++ sym ++ "' not found"
+                Just val -> return val
+        MalSeq _ (Vect False) (a1 : as) -> apply_ast a1 as env
+        MalSeq _ (Vect True)  xs        -> MalSeq (MetaData Nil) (Vect True) <$> mapM (eval env) xs
+        MalHashMap _ xs                 -> MalHashMap (MetaData Nil) <$> mapM (eval env) xs
+        _ -> return ast
 
 -- print
 
 mal_print :: MalVal -> IOThrows String
-mal_print = liftIO. Printer._pr_str True
+mal_print = liftIO . Printer._pr_str True
 
 -- repl
 
 rep :: Env -> String -> IOThrows String
-rep env = mal_print <=< eval env <=< mal_read
+rep env line = mal_print =<< eval env =<< mal_read line
 
 repl_loop :: Env -> IO ()
 repl_loop env = do
@@ -159,7 +163,7 @@ re repl_env line = do
 
 defBuiltIn :: Env -> (String, Fn) -> IO ()
 defBuiltIn env (sym, f) =
-    env_set env sym $ MalFunction {fn=f, f_ast=Nil, f_params=[], macro=False, meta=Nil}
+    env_set env sym $ MalFunction (MetaData Nil) f
 
 evalFn :: Env -> Fn
 evalFn env [ast] = eval env ast
@@ -170,7 +174,7 @@ main = do
     args <- getArgs
     load_history
 
-    repl_env <- env_new []
+    repl_env <- env_repl
 
     -- core.hs: defined using Haskell
     mapM_ (defBuiltIn repl_env) Core.ns
diff --git a/impls/haskell/step8_macros.hs b/impls/haskell/step8_macros.hs
index b3ad713dfc..d49acf1b27 100644
--- a/impls/haskell/step8_macros.hs
+++ b/impls/haskell/step8_macros.hs
@@ -1,17 +1,21 @@
 import System.IO (hFlush, stdout)
 import System.Environment (getArgs)
-import Control.Monad ((<=<))
-import Control.Monad.Except (runExceptT)
-import Control.Monad.Trans (liftIO)
+import Control.Monad.Except (liftIO, runExceptT)
 import Data.Foldable (foldlM, foldrM)
 
 import Readline (addHistory, readline, load_history)
 import Types
 import Reader (read_str)
-import Printer (_pr_str)
-import Env (env_new, env_bind, env_get, env_set)
+import Printer(_pr_list, _pr_str)
+import Env (Env, env_apply, env_get, env_let, env_put, env_repl, env_set)
 import Core (ns)
 
+--
+--  Set this to True for a trace of each call to Eval.
+--
+traceEval :: Bool
+traceEval = False
+
 -- read
 
 mal_read :: String -> IOThrows MalVal
@@ -19,8 +23,6 @@ mal_read = read_str
 
 -- eval
 
--- starts-with is replaced with pattern matching.
-
 qqIter :: MalVal -> MalVal -> IOThrows MalVal
 qqIter (MalSeq _ (Vect False) [MalSymbol "splice-unquote", x]) acc = return $ toList [MalSymbol "concat", x, acc]
 qqIter (MalSeq _ (Vect False) (MalSymbol "splice-unquote" : _)) _ = throwStr "invalid splice-unquote"
@@ -39,18 +41,14 @@ quasiquote ast@(MalHashMap _ _) = return $ toList [MalSymbol "quote", ast]
 quasiquote ast@(MalSymbol _)    = return $ toList [MalSymbol "quote", ast]
 quasiquote ast = return ast
 
--- is-macro-call is replaced with pattern matching.
-
 macroexpand :: Env -> MalVal -> IOThrows MalVal
 macroexpand env ast@(MalSeq _ (Vect False) (MalSymbol a0 : args)) = do
     maybeMacro <- liftIO $ env_get env a0
     case maybeMacro of
-        Just (MalFunction {fn=f, macro=True}) -> macroexpand env =<< f args
+        Just (MalMacro f)                     -> macroexpand env =<< f args
         _                                     -> return ast
 macroexpand _ ast = return ast
 
--- eval_ast is replaced with pattern matching.
-
 let_bind :: Env -> [MalVal] -> IOThrows ()
 let_bind _ [] = return ()
 let_bind env (MalSymbol b : e : xs) = do
@@ -58,105 +56,107 @@ let_bind env (MalSymbol b : e : xs) = do
     let_bind env xs
 let_bind _ _ = throwStr "invalid let*"
 
-unWrapSymbol :: MalVal -> IOThrows String
-unWrapSymbol (MalSymbol s) = return s
-unWrapSymbol _ = throwStr "fn* parameter must be symbols"
-
-newFunction :: MalVal -> Env -> [String] -> MalVal
-newFunction a env p = MalFunction {f_ast=a, f_params=p, macro=False, meta=Nil,
-    fn=(\args -> do
-        fn_env <- liftIO $ env_new env
-        ok <- liftIO $ env_bind fn_env p args
-        case ok of
-            True  -> eval fn_env a
-            False -> throwStr $ "actual parameters do not match signature " ++ show p)}
+apply_ast :: MalVal -> [MalVal] -> Env -> IOThrows MalVal
 
-apply_ast :: [MalVal] -> Env -> IOThrows MalVal
-
-apply_ast [] _ = return $ toList []
-
-apply_ast [MalSymbol "def!", MalSymbol a1, a2] env = do
+apply_ast (MalSymbol "def!") [MalSymbol a1, a2] env = do
     evd <- eval env a2
     liftIO $ env_set env a1 evd
     return evd
-apply_ast (MalSymbol "def!" : _) _ = throwStr "invalid def!"
+apply_ast (MalSymbol "def!") _ _ = throwStr "invalid def!"
 
-apply_ast [MalSymbol "let*", MalSeq _ _ params, a2] env = do
-    let_env <- liftIO $ env_new env
+apply_ast (MalSymbol "let*") [MalSeq _ _ params, a2] env = do
+    let_env <- liftIO $ env_let env
     let_bind let_env params
     eval let_env a2
-apply_ast (MalSymbol "let*" : _) _ = throwStr "invalid let*"
+apply_ast (MalSymbol "let*") _ _ = throwStr "invalid let*"
 
-apply_ast [MalSymbol "quote", a1] _ = return a1
-apply_ast (MalSymbol "quote" : _) _ = throwStr "invalid quote"
+apply_ast (MalSymbol "quote") [a1] _ = return a1
+apply_ast (MalSymbol "quote") _ _ = throwStr "invalid quote"
 
-apply_ast [MalSymbol "quasiquoteexpand", a1] _ = quasiquote a1
-apply_ast (MalSymbol "quasiquoteexpand" : _) _ = throwStr "invalid quasiquote"
+apply_ast (MalSymbol "quasiquoteexpand") [a1] _ = quasiquote a1
+apply_ast (MalSymbol "quasiquoteexpand") _ _ = throwStr "invalid quasiquote"
 
-apply_ast [MalSymbol "quasiquote", a1] env = eval env =<< quasiquote a1
-apply_ast (MalSymbol "quasiquote" : _) _ = throwStr "invalid quasiquote"
+apply_ast (MalSymbol "quasiquote") [a1] env = eval env =<< quasiquote a1
+apply_ast (MalSymbol "quasiquote") _ _ = throwStr "invalid quasiquote"
 
-apply_ast [MalSymbol "defmacro!", MalSymbol a1, a2] env = do
+apply_ast (MalSymbol "defmacro!") [MalSymbol a1, a2] env = do
     func <- eval env a2
     case func of
-        MalFunction {macro=False} -> do
-            let m = func {macro=True}
+        MalFunction _ f -> do
+            let m = MalMacro f
             liftIO $ env_set env a1 m
             return m
         _ -> throwStr "defmacro! on non-function"
-apply_ast (MalSymbol "defmacro!" : _) _ = throwStr "invalid defmacro!"
+apply_ast (MalSymbol "defmacro!") _ _ = throwStr "invalid defmacro!"
 
-apply_ast [MalSymbol "macroexpand", a1] env = macroexpand env a1
-apply_ast (MalSymbol "macroexpand" : _) _ = throwStr "invalid macroexpand"
+apply_ast (MalSymbol "macroexpand") [a1] env = macroexpand env  a1
+apply_ast (MalSymbol "macroexpand") _ _ = throwStr "invalid macroexpand"
 
-apply_ast (MalSymbol "do" : args) env = foldlM (const $ eval env) Nil args
+apply_ast (MalSymbol "do") args env = foldlM (const $ eval env) Nil args
 
-apply_ast [MalSymbol "if", a1, a2, a3] env = do
+apply_ast (MalSymbol "if") [a1, a2, a3] env = do
     cond <- eval env a1
     eval env $ case cond of
         Nil              -> a3
         MalBoolean False -> a3
         _                -> a2
-apply_ast [MalSymbol "if", a1, a2] env = do
+apply_ast (MalSymbol "if") [a1, a2] env = do
     cond <- eval env a1
     case cond of
         Nil              -> return Nil
         MalBoolean False -> return Nil
         _                -> eval env a2
-apply_ast (MalSymbol "if" : _) _ = throwStr "invalid if"
-
-apply_ast [MalSymbol "fn*", MalSeq _ _ params, ast] env = newFunction ast env <$> mapM unWrapSymbol params
-apply_ast (MalSymbol "fn*" : _) _ = throwStr "invalid fn*"
-
-apply_ast ast env = do
-    evd <- mapM (eval env) ast
+apply_ast (MalSymbol "if") _ _ = throwStr "invalid if"
+
+apply_ast (MalSymbol "fn*") [MalSeq _ _ params, ast] env = return $ MalFunction (MetaData Nil) fn where
+    fn :: [MalVal] -> IOThrows MalVal
+    fn args = do
+        case env_apply env params args of
+            Just fn_env -> eval fn_env ast
+            Nothing -> do
+                p <- liftIO $ _pr_list True " " params
+                a <- liftIO $ _pr_list True " " args
+                throwStr $ "actual parameters: " ++ a ++ " do not match signature: " ++ p
+apply_ast (MalSymbol "fn*") _ _ = throwStr "invalid fn*"
+
+apply_ast first rest env = do
+    evd <- eval env first
     case evd of
-        MalFunction {fn=f, macro=False} : args -> f args
-        _ -> throwStr . (++) "invalid apply: " =<< liftIO (Printer._pr_str True (toList ast))
+        MalFunction _ f -> f =<< mapM (eval env) rest
+        MalMacro m      -> eval env =<< m rest
+        _               -> throwStr . (++) "invalid apply: " =<< liftIO (_pr_list True " " $ first : rest)
 
 eval :: Env -> MalVal -> IOThrows MalVal
 eval env ast = do
-    newAst <- macroexpand env ast
-    case newAst of
+    case traceEval of
+        True -> liftIO $ do
+            putStr "EVAL: "
+            putStr =<< _pr_str True ast
+            putStr "   "
+            env_put env
+            putStrLn ""
+            hFlush stdout
+        False -> pure ()
+    case ast of
         MalSymbol sym -> do
             maybeVal <- liftIO $ env_get env sym
             case maybeVal of
                 Nothing  -> throwStr $ "'" ++ sym ++ "' not found"
                 Just val -> return val
-        MalSeq _ (Vect False) xs -> apply_ast xs env
-        MalSeq m (Vect True)  xs -> MalSeq m (Vect True) <$> mapM (eval env) xs
-        MalHashMap m xs          -> MalHashMap m         <$> mapM (eval env) xs
-        _ -> return newAst
+        MalSeq _ (Vect False) (a1 : as) -> apply_ast a1 as env
+        MalSeq _ (Vect True)  xs        -> MalSeq (MetaData Nil) (Vect True) <$> mapM (eval env) xs
+        MalHashMap _ xs                 -> MalHashMap (MetaData Nil) <$> mapM (eval env) xs
+        _ -> return ast
 
 -- print
 
 mal_print :: MalVal -> IOThrows String
-mal_print = liftIO. Printer._pr_str True
+mal_print = liftIO . Printer._pr_str True
 
 -- repl
 
 rep :: Env -> String -> IOThrows String
-rep env = mal_print <=< eval env <=< mal_read
+rep env line = mal_print =<< eval env =<< mal_read line
 
 repl_loop :: Env -> IO ()
 repl_loop env = do
@@ -185,7 +185,7 @@ re repl_env line = do
 
 defBuiltIn :: Env -> (String, Fn) -> IO ()
 defBuiltIn env (sym, f) =
-    env_set env sym $ MalFunction {fn=f, f_ast=Nil, f_params=[], macro=False, meta=Nil}
+    env_set env sym $ MalFunction (MetaData Nil) f
 
 evalFn :: Env -> Fn
 evalFn env [ast] = eval env ast
@@ -196,7 +196,7 @@ main = do
     args <- getArgs
     load_history
 
-    repl_env <- env_new []
+    repl_env <- env_repl
 
     -- core.hs: defined using Haskell
     mapM_ (defBuiltIn repl_env) Core.ns
diff --git a/impls/haskell/step9_try.hs b/impls/haskell/step9_try.hs
index e4834e66ba..d2c26837a1 100644
--- a/impls/haskell/step9_try.hs
+++ b/impls/haskell/step9_try.hs
@@ -1,17 +1,21 @@
 import System.IO (hFlush, stdout)
 import System.Environment (getArgs)
-import Control.Monad ((<=<))
-import Control.Monad.Except (runExceptT)
-import Control.Monad.Trans (liftIO)
+import Control.Monad.Except (liftIO, runExceptT)
 import Data.Foldable (foldlM, foldrM)
 
 import Readline (addHistory, readline, load_history)
 import Types
 import Reader (read_str)
-import Printer (_pr_str)
-import Env (env_new, env_bind, env_get, env_set)
+import Printer(_pr_list, _pr_str)
+import Env (Env, env_apply, env_get, env_let, env_put, env_repl, env_set)
 import Core (ns)
 
+--
+--  Set this to True for a trace of each call to Eval.
+--
+traceEval :: Bool
+traceEval = False
+
 -- read
 
 mal_read :: String -> IOThrows MalVal
@@ -19,8 +23,6 @@ mal_read = read_str
 
 -- eval
 
--- starts-with is replaced with pattern matching.
-
 qqIter :: MalVal -> MalVal -> IOThrows MalVal
 qqIter (MalSeq _ (Vect False) [MalSymbol "splice-unquote", x]) acc = return $ toList [MalSymbol "concat", x, acc]
 qqIter (MalSeq _ (Vect False) (MalSymbol "splice-unquote" : _)) _ = throwStr "invalid splice-unquote"
@@ -39,18 +41,14 @@ quasiquote ast@(MalHashMap _ _) = return $ toList [MalSymbol "quote", ast]
 quasiquote ast@(MalSymbol _)    = return $ toList [MalSymbol "quote", ast]
 quasiquote ast = return ast
 
--- is-macro-call is replaced with pattern matching.
-
 macroexpand :: Env -> MalVal -> IOThrows MalVal
 macroexpand env ast@(MalSeq _ (Vect False) (MalSymbol a0 : args)) = do
     maybeMacro <- liftIO $ env_get env a0
     case maybeMacro of
-        Just (MalFunction {fn=f, macro=True}) -> macroexpand env =<< f args
+        Just (MalMacro f)                     -> macroexpand env =<< f args
         _                                     -> return ast
 macroexpand _ ast = return ast
 
--- eval_ast is replaced with pattern matching.
-
 let_bind :: Env -> [MalVal] -> IOThrows ()
 let_bind _ [] = return ()
 let_bind env (MalSymbol b : e : xs) = do
@@ -58,116 +56,117 @@ let_bind env (MalSymbol b : e : xs) = do
     let_bind env xs
 let_bind _ _ = throwStr "invalid let*"
 
-unWrapSymbol :: MalVal -> IOThrows String
-unWrapSymbol (MalSymbol s) = return s
-unWrapSymbol _ = throwStr "fn* parameter must be symbols"
-
-newFunction :: MalVal -> Env -> [String] -> MalVal
-newFunction a env p = MalFunction {f_ast=a, f_params=p, macro=False, meta=Nil,
-    fn=(\args -> do
-        fn_env <- liftIO $ env_new env
-        ok <- liftIO $ env_bind fn_env p args
-        case ok of
-            True  -> eval fn_env a
-            False -> throwStr $ "actual parameters do not match signature " ++ show p)}
+apply_ast :: MalVal -> [MalVal] -> Env -> IOThrows MalVal
 
-apply_ast :: [MalVal] -> Env -> IOThrows MalVal
-
-apply_ast [] _ = return $ toList []
-
-apply_ast [MalSymbol "def!", MalSymbol a1, a2] env = do
+apply_ast (MalSymbol "def!") [MalSymbol a1, a2] env = do
     evd <- eval env a2
     liftIO $ env_set env a1 evd
     return evd
-apply_ast (MalSymbol "def!" : _) _ = throwStr "invalid def!"
+apply_ast (MalSymbol "def!") _ _ = throwStr "invalid def!"
 
-apply_ast [MalSymbol "let*", MalSeq _ _ params, a2] env = do
-    let_env <- liftIO $ env_new env
+apply_ast (MalSymbol "let*") [MalSeq _ _ params, a2] env = do
+    let_env <- liftIO $ env_let env
     let_bind let_env params
     eval let_env a2
-apply_ast (MalSymbol "let*" : _) _ = throwStr "invalid let*"
+apply_ast (MalSymbol "let*") _ _ = throwStr "invalid let*"
 
-apply_ast [MalSymbol "quote", a1] _ = return a1
-apply_ast (MalSymbol "quote" : _) _ = throwStr "invalid quote"
+apply_ast (MalSymbol "quote") [a1] _ = return a1
+apply_ast (MalSymbol "quote") _ _ = throwStr "invalid quote"
 
-apply_ast [MalSymbol "quasiquoteexpand", a1] _ = quasiquote a1
-apply_ast (MalSymbol "quasiquoteexpand" : _) _ = throwStr "invalid quasiquote"
+apply_ast (MalSymbol "quasiquoteexpand") [a1] _ = quasiquote a1
+apply_ast (MalSymbol "quasiquoteexpand") _ _ = throwStr "invalid quasiquote"
 
-apply_ast [MalSymbol "quasiquote", a1] env = eval env =<< quasiquote a1
-apply_ast (MalSymbol "quasiquote" : _) _ = throwStr "invalid quasiquote"
+apply_ast (MalSymbol "quasiquote") [a1] env = eval env =<< quasiquote a1
+apply_ast (MalSymbol "quasiquote") _ _ = throwStr "invalid quasiquote"
 
-apply_ast [MalSymbol "defmacro!", MalSymbol a1, a2] env = do
+apply_ast (MalSymbol "defmacro!") [MalSymbol a1, a2] env = do
     func <- eval env a2
     case func of
-        MalFunction {macro=False} -> do
-            let m = func {macro=True}
+        MalFunction _ f -> do
+            let m = MalMacro f
             liftIO $ env_set env a1 m
             return m
         _ -> throwStr "defmacro! on non-function"
-apply_ast (MalSymbol "defmacro!" : _) _ = throwStr "invalid defmacro!"
+apply_ast (MalSymbol "defmacro!") _ _ = throwStr "invalid defmacro!"
 
-apply_ast [MalSymbol "macroexpand", a1] env = macroexpand env a1
-apply_ast (MalSymbol "macroexpand" : _) _ = throwStr "invalid macroexpand"
+apply_ast (MalSymbol "macroexpand") [a1] env = macroexpand env  a1
+apply_ast (MalSymbol "macroexpand") _ _ = throwStr "invalid macroexpand"
 
-apply_ast [MalSymbol "try*", a1] env = eval env a1
-apply_ast [MalSymbol "try*", a1, MalSeq _ (Vect False) [MalSymbol "catch*", MalSymbol a21, a22]] env = do
+apply_ast (MalSymbol "try*") [a1] env = eval env a1
+apply_ast (MalSymbol "try*") [a1, MalSeq _ (Vect False) [MalSymbol "catch*", a21, a22]] env = do
     res <- liftIO $ runExceptT $ eval env a1
     case res of
         Right val -> return val
-        Left exc -> do
-            try_env <- liftIO $ env_new env
-            liftIO $ env_set try_env a21 exc
-            eval try_env a22
-apply_ast (MalSymbol "try*" : _) _ = throwStr "invalid try*"
+        Left exc -> case env_apply env [a21] [exc] of
+            Just try_env -> eval try_env a22
+            Nothing    -> throwStr "invalid catch*"
+apply_ast (MalSymbol "try*") _ _ = throwStr "invalid try*"
 
-apply_ast (MalSymbol "do" : args) env = foldlM (const $ eval env) Nil args
+apply_ast (MalSymbol "do") args env = foldlM (const $ eval env) Nil args
 
-apply_ast [MalSymbol "if", a1, a2, a3] env = do
+apply_ast (MalSymbol "if") [a1, a2, a3] env = do
     cond <- eval env a1
     eval env $ case cond of
         Nil              -> a3
         MalBoolean False -> a3
         _                -> a2
-apply_ast [MalSymbol "if", a1, a2] env = do
+apply_ast (MalSymbol "if") [a1, a2] env = do
     cond <- eval env a1
     case cond of
         Nil              -> return Nil
         MalBoolean False -> return Nil
         _                -> eval env a2
-apply_ast (MalSymbol "if" : _) _ = throwStr "invalid if"
-
-apply_ast [MalSymbol "fn*", MalSeq _ _ params, ast] env = newFunction ast env <$> mapM unWrapSymbol params
-apply_ast (MalSymbol "fn*" : _) _ = throwStr "invalid fn*"
-
-apply_ast ast env = do
-    evd <- mapM (eval env) ast
+apply_ast (MalSymbol "if") _ _ = throwStr "invalid if"
+
+apply_ast (MalSymbol "fn*") [MalSeq _ _ params, ast] env = return $ MalFunction (MetaData Nil) fn where
+    fn :: [MalVal] -> IOThrows MalVal
+    fn args = do
+        case env_apply env params args of
+            Just fn_env -> eval fn_env ast
+            Nothing -> do
+                p <- liftIO $ _pr_list True " " params
+                a <- liftIO $ _pr_list True " " args
+                throwStr $ "actual parameters: " ++ a ++ " do not match signature: " ++ p
+apply_ast (MalSymbol "fn*") _ _ = throwStr "invalid fn*"
+
+apply_ast first rest env = do
+    evd <- eval env first
     case evd of
-        MalFunction {fn=f, macro=False} : args -> f args
-        _ -> throwStr . (++) "invalid apply: " =<< liftIO (Printer._pr_str True (toList ast))
+        MalFunction _ f -> f =<< mapM (eval env) rest
+        MalMacro m      -> eval env =<< m rest
+        _               -> throwStr . (++) "invalid apply: " =<< liftIO (_pr_list True " " $ first : rest)
 
 eval :: Env -> MalVal -> IOThrows MalVal
 eval env ast = do
-    newAst <- macroexpand env ast
-    case newAst of
+    case traceEval of
+        True -> liftIO $ do
+            putStr "EVAL: "
+            putStr =<< _pr_str True ast
+            putStr "   "
+            env_put env
+            putStrLn ""
+            hFlush stdout
+        False -> pure ()
+    case ast of
         MalSymbol sym -> do
             maybeVal <- liftIO $ env_get env sym
             case maybeVal of
                 Nothing  -> throwStr $ "'" ++ sym ++ "' not found"
                 Just val -> return val
-        MalSeq _ (Vect False) xs -> apply_ast xs env
-        MalSeq m (Vect True)  xs -> MalSeq m (Vect True) <$> mapM (eval env) xs
-        MalHashMap m xs          -> MalHashMap m         <$> mapM (eval env) xs
-        _ -> return newAst
+        MalSeq _ (Vect False) (a1 : as) -> apply_ast a1 as env
+        MalSeq _ (Vect True)  xs        -> MalSeq (MetaData Nil) (Vect True) <$> mapM (eval env) xs
+        MalHashMap _ xs                 -> MalHashMap (MetaData Nil) <$> mapM (eval env) xs
+        _ -> return ast
 
 -- print
 
 mal_print :: MalVal -> IOThrows String
-mal_print = liftIO. Printer._pr_str True
+mal_print = liftIO . Printer._pr_str True
 
 -- repl
 
 rep :: Env -> String -> IOThrows String
-rep env = mal_print <=< eval env <=< mal_read
+rep env line = mal_print =<< eval env =<< mal_read line
 
 repl_loop :: Env -> IO ()
 repl_loop env = do
@@ -196,7 +195,7 @@ re repl_env line = do
 
 defBuiltIn :: Env -> (String, Fn) -> IO ()
 defBuiltIn env (sym, f) =
-    env_set env sym $ MalFunction {fn=f, f_ast=Nil, f_params=[], macro=False, meta=Nil}
+    env_set env sym $ MalFunction (MetaData Nil) f
 
 evalFn :: Env -> Fn
 evalFn env [ast] = eval env ast
@@ -207,7 +206,7 @@ main = do
     args <- getArgs
     load_history
 
-    repl_env <- env_new []
+    repl_env <- env_repl
 
     -- core.hs: defined using Haskell
     mapM_ (defBuiltIn repl_env) Core.ns
diff --git a/impls/haskell/stepA_mal.hs b/impls/haskell/stepA_mal.hs
index a392be6782..3e3517282d 100644
--- a/impls/haskell/stepA_mal.hs
+++ b/impls/haskell/stepA_mal.hs
@@ -1,17 +1,21 @@
 import System.IO (hFlush, stdout)
 import System.Environment (getArgs)
-import Control.Monad ((<=<))
-import Control.Monad.Except (runExceptT)
-import Control.Monad.Trans (liftIO)
+import Control.Monad.Except (liftIO, runExceptT)
 import Data.Foldable (foldlM, foldrM)
 
 import Readline (addHistory, readline, load_history)
 import Types
 import Reader (read_str)
-import Printer (_pr_str)
-import Env (env_new, env_bind, env_get, env_set)
+import Printer(_pr_list, _pr_str)
+import Env (Env, env_apply, env_get, env_let, env_put, env_repl, env_set)
 import Core (ns)
 
+--
+--  Set this to True for a trace of each call to Eval.
+--
+traceEval :: Bool
+traceEval = False
+
 -- read
 
 mal_read :: String -> IOThrows MalVal
@@ -19,8 +23,6 @@ mal_read = read_str
 
 -- eval
 
--- starts-with is replaced with pattern matching.
-
 qqIter :: MalVal -> MalVal -> IOThrows MalVal
 qqIter (MalSeq _ (Vect False) [MalSymbol "splice-unquote", x]) acc = return $ toList [MalSymbol "concat", x, acc]
 qqIter (MalSeq _ (Vect False) (MalSymbol "splice-unquote" : _)) _ = throwStr "invalid splice-unquote"
@@ -39,18 +41,14 @@ quasiquote ast@(MalHashMap _ _) = return $ toList [MalSymbol "quote", ast]
 quasiquote ast@(MalSymbol _)    = return $ toList [MalSymbol "quote", ast]
 quasiquote ast = return ast
 
--- is-macro-call is replaced with pattern matching.
-
 macroexpand :: Env -> MalVal -> IOThrows MalVal
 macroexpand env ast@(MalSeq _ (Vect False) (MalSymbol a0 : args)) = do
     maybeMacro <- liftIO $ env_get env a0
     case maybeMacro of
-        Just (MalFunction {fn=f, macro=True}) -> macroexpand env =<< f args
+        Just (MalMacro f)                     -> macroexpand env =<< f args
         _                                     -> return ast
 macroexpand _ ast = return ast
 
--- eval_ast is replaced with pattern matching.
-
 let_bind :: Env -> [MalVal] -> IOThrows ()
 let_bind _ [] = return ()
 let_bind env (MalSymbol b : e : xs) = do
@@ -58,116 +56,117 @@ let_bind env (MalSymbol b : e : xs) = do
     let_bind env xs
 let_bind _ _ = throwStr "invalid let*"
 
-unWrapSymbol :: MalVal -> IOThrows String
-unWrapSymbol (MalSymbol s) = return s
-unWrapSymbol _ = throwStr "fn* parameter must be symbols"
-
-newFunction :: MalVal -> Env -> [String] -> MalVal
-newFunction a env p = MalFunction {f_ast=a, f_params=p, macro=False, meta=Nil,
-    fn=(\args -> do
-        fn_env <- liftIO $ env_new env
-        ok <- liftIO $ env_bind fn_env p args
-        case ok of
-            True  -> eval fn_env a
-            False -> throwStr $ "actual parameters do not match signature " ++ show p)}
+apply_ast :: MalVal -> [MalVal] -> Env -> IOThrows MalVal
 
-apply_ast :: [MalVal] -> Env -> IOThrows MalVal
-
-apply_ast [] _ = return $ toList []
-
-apply_ast [MalSymbol "def!", MalSymbol a1, a2] env = do
+apply_ast (MalSymbol "def!") [MalSymbol a1, a2] env = do
     evd <- eval env a2
     liftIO $ env_set env a1 evd
     return evd
-apply_ast (MalSymbol "def!" : _) _ = throwStr "invalid def!"
+apply_ast (MalSymbol "def!") _ _ = throwStr "invalid def!"
 
-apply_ast [MalSymbol "let*", MalSeq _ _ params, a2] env = do
-    let_env <- liftIO $ env_new env
+apply_ast (MalSymbol "let*") [MalSeq _ _ params, a2] env = do
+    let_env <- liftIO $ env_let env
     let_bind let_env params
     eval let_env a2
-apply_ast (MalSymbol "let*" : _) _ = throwStr "invalid let*"
+apply_ast (MalSymbol "let*") _ _ = throwStr "invalid let*"
 
-apply_ast [MalSymbol "quote", a1] _ = return a1
-apply_ast (MalSymbol "quote" : _) _ = throwStr "invalid quote"
+apply_ast (MalSymbol "quote") [a1] _ = return a1
+apply_ast (MalSymbol "quote") _ _ = throwStr "invalid quote"
 
-apply_ast [MalSymbol "quasiquoteexpand", a1] _ = quasiquote a1
-apply_ast (MalSymbol "quasiquoteexpand" : _) _ = throwStr "invalid quasiquote"
+apply_ast (MalSymbol "quasiquoteexpand") [a1] _ = quasiquote a1
+apply_ast (MalSymbol "quasiquoteexpand") _ _ = throwStr "invalid quasiquote"
 
-apply_ast [MalSymbol "quasiquote", a1] env = eval env =<< quasiquote a1
-apply_ast (MalSymbol "quasiquote" : _) _ = throwStr "invalid quasiquote"
+apply_ast (MalSymbol "quasiquote") [a1] env = eval env =<< quasiquote a1
+apply_ast (MalSymbol "quasiquote") _ _ = throwStr "invalid quasiquote"
 
-apply_ast [MalSymbol "defmacro!", MalSymbol a1, a2] env = do
+apply_ast (MalSymbol "defmacro!") [MalSymbol a1, a2] env = do
     func <- eval env a2
     case func of
-        MalFunction {macro=False} -> do
-            let m = func {macro=True}
+        MalFunction _ f -> do
+            let m = MalMacro f
             liftIO $ env_set env a1 m
             return m
         _ -> throwStr "defmacro! on non-function"
-apply_ast (MalSymbol "defmacro!" : _) _ = throwStr "invalid defmacro!"
+apply_ast (MalSymbol "defmacro!") _ _ = throwStr "invalid defmacro!"
 
-apply_ast [MalSymbol "macroexpand", a1] env = macroexpand env a1
-apply_ast (MalSymbol "macroexpand" : _) _ = throwStr "invalid macroexpand"
+apply_ast (MalSymbol "macroexpand") [a1] env = macroexpand env  a1
+apply_ast (MalSymbol "macroexpand") _ _ = throwStr "invalid macroexpand"
 
-apply_ast [MalSymbol "try*", a1] env = eval env a1
-apply_ast [MalSymbol "try*", a1, MalSeq _ (Vect False) [MalSymbol "catch*", MalSymbol a21, a22]] env = do
+apply_ast (MalSymbol "try*") [a1] env = eval env a1
+apply_ast (MalSymbol "try*") [a1, MalSeq _ (Vect False) [MalSymbol "catch*", a21, a22]] env = do
     res <- liftIO $ runExceptT $ eval env a1
     case res of
         Right val -> return val
-        Left exc -> do
-            try_env <- liftIO $ env_new env
-            liftIO $ env_set try_env a21 exc
-            eval try_env a22
-apply_ast (MalSymbol "try*" : _) _ = throwStr "invalid try*"
+        Left exc -> case env_apply env [a21] [exc] of
+            Just try_env -> eval try_env a22
+            Nothing    -> throwStr "invalid catch*"
+apply_ast (MalSymbol "try*") _ _ = throwStr "invalid try*"
 
-apply_ast (MalSymbol "do" : args) env = foldlM (const $ eval env) Nil args
+apply_ast (MalSymbol "do") args env = foldlM (const $ eval env) Nil args
 
-apply_ast [MalSymbol "if", a1, a2, a3] env = do
+apply_ast (MalSymbol "if") [a1, a2, a3] env = do
     cond <- eval env a1
     eval env $ case cond of
         Nil              -> a3
         MalBoolean False -> a3
         _                -> a2
-apply_ast [MalSymbol "if", a1, a2] env = do
+apply_ast (MalSymbol "if") [a1, a2] env = do
     cond <- eval env a1
     case cond of
         Nil              -> return Nil
         MalBoolean False -> return Nil
         _                -> eval env a2
-apply_ast (MalSymbol "if" : _) _ = throwStr "invalid if"
-
-apply_ast [MalSymbol "fn*", MalSeq _ _ params, ast] env = newFunction ast env <$> mapM unWrapSymbol params
-apply_ast (MalSymbol "fn*" : _) _ = throwStr "invalid fn*"
-
-apply_ast ast env = do
-    evd <- mapM (eval env) ast
+apply_ast (MalSymbol "if") _ _ = throwStr "invalid if"
+
+apply_ast (MalSymbol "fn*") [MalSeq _ _ params, ast] env = return $ MalFunction (MetaData Nil) fn where
+    fn :: [MalVal] -> IOThrows MalVal
+    fn args = do
+        case env_apply env params args of
+            Just fn_env -> eval fn_env ast
+            Nothing -> do
+                p <- liftIO $ _pr_list True " " params
+                a <- liftIO $ _pr_list True " " args
+                throwStr $ "actual parameters: " ++ a ++ " do not match signature: " ++ p
+apply_ast (MalSymbol "fn*") _ _ = throwStr "invalid fn*"
+
+apply_ast first rest env = do
+    evd <- eval env first
     case evd of
-        MalFunction {fn=f, macro=False} : args -> f args
-        _ -> throwStr . (++) "invalid apply: " =<< liftIO (Printer._pr_str True (toList ast))
+        MalFunction _ f -> f =<< mapM (eval env) rest
+        MalMacro m      -> eval env =<< m rest
+        _               -> throwStr . (++) "invalid apply: " =<< liftIO (_pr_list True " " $ first : rest)
 
 eval :: Env -> MalVal -> IOThrows MalVal
 eval env ast = do
-    newAst <- macroexpand env ast
-    case newAst of
+    case traceEval of
+        True -> liftIO $ do
+            putStr "EVAL: "
+            putStr =<< _pr_str True ast
+            putStr "   "
+            env_put env
+            putStrLn ""
+            hFlush stdout
+        False -> pure ()
+    case ast of
         MalSymbol sym -> do
             maybeVal <- liftIO $ env_get env sym
             case maybeVal of
                 Nothing  -> throwStr $ "'" ++ sym ++ "' not found"
                 Just val -> return val
-        MalSeq _ (Vect False) xs -> apply_ast xs env
-        MalSeq m (Vect True)  xs -> MalSeq m (Vect True) <$> mapM (eval env) xs
-        MalHashMap m xs          -> MalHashMap m         <$> mapM (eval env) xs
-        _ -> return newAst
+        MalSeq _ (Vect False) (a1 : as) -> apply_ast a1 as env
+        MalSeq _ (Vect True)  xs        -> MalSeq (MetaData Nil) (Vect True) <$> mapM (eval env) xs
+        MalHashMap _ xs                 -> MalHashMap (MetaData Nil) <$> mapM (eval env) xs
+        _ -> return ast
 
 -- print
 
 mal_print :: MalVal -> IOThrows String
-mal_print = liftIO. Printer._pr_str True
+mal_print = liftIO . Printer._pr_str True
 
 -- repl
 
 rep :: Env -> String -> IOThrows String
-rep env = mal_print <=< eval env <=< mal_read
+rep env line = mal_print =<< eval env =<< mal_read line
 
 repl_loop :: Env -> IO ()
 repl_loop env = do
@@ -196,7 +195,7 @@ re repl_env line = do
 
 defBuiltIn :: Env -> (String, Fn) -> IO ()
 defBuiltIn env (sym, f) =
-    env_set env sym $ MalFunction {fn=f, f_ast=Nil, f_params=[], macro=False, meta=Nil}
+    env_set env sym $ MalFunction (MetaData Nil) f
 
 evalFn :: Env -> Fn
 evalFn env [ast] = eval env ast
@@ -207,7 +206,7 @@ main = do
     args <- getArgs
     load_history
 
-    repl_env <- env_new []
+    repl_env <- env_repl
 
     -- core.hs: defined using Haskell
     mapM_ (defBuiltIn repl_env) Core.ns