在 48 小时内编写自己的 Scheme/添加变量和赋值
最后，我们终于要接触到真正的精华部分：变量。变量允许我们保存表达式的结果，并在以后引用它。在 Scheme 中，变量也可以被重置为新值，因此它的值会随着程序的执行而改变。这给 Haskell 带来了一些复杂性，因为它的执行模型是建立在返回值的函数基础上的，而这些函数永远不会改变值。
尽管如此，在 Haskell 中模拟状态的方法有很多，它们都涉及到单子。最简单的可能就是 状态单子，它允许你在单子中隐藏任意状态，并在幕后传递它。你可以将状态类型指定为单子的参数（例如，如果一个函数返回一个整数，但修改了一个字符串对的列表，它的类型将为 State [(String, String)] Integer），并通过 get 和 put 函数访问它，通常在 do 块中。你可以通过 runState myStateAction initialList 指定初始状态，它将返回一个包含返回值和最终状态的元组。
不幸的是，状态单子不适合我们，因为我们需要存储的数据类型相当复杂。对于一个简单的顶级环境，我们可以用 [(String, LispVal)] 来存储变量名到值的映射。但是，当我们开始处理函数调用时，这些映射变成了一个任意深度的嵌套环境堆栈。当我们添加闭包时，环境可能会被保存在一个任意的 Function 值中，并在整个程序中传递。事实上，它们可能被保存在一个变量中，并完全从 runState 单子中传递出去，而我们不允许这样做。
相反，我们使用一个称为 *状态线程* 的功能，让 Haskell 为我们管理聚合状态。这让我们能够像在任何其他编程语言中一样对待可变变量，使用函数来获取或设置变量。状态线程有两种形式：ST 单子 创建一个有状态的计算，它可以作为一个单元执行，而状态不会泄漏到程序的其余部分。IORef 模块 允许你在 IO 单子中使用有状态的变量。由于我们的状态必须与 IO 交织在一起（它在 REPL 的行之间持久存在，并且我们最终会在语言本身中拥有 IO 函数），我们将使用 IORef。
我们可以先导入 Data.IORef 并为我们的环境定义一个类型
import Data.IORef
type Env = IORef [(String, IORef LispVal)]
这将 Env 声明为一个 IORef，它包含一个将 String 映射到可变 LispVal 的列表。我们需要 IORef 来表示列表本身和单个值，因为程序可以通过 *两种* 方式来修改环境。它可以使用 set! 来改变单个变量的值，这种改变对于任何共享该环境的函数都是可见的（Scheme 允许嵌套作用域，因此外部作用域中的变量对于所有内部作用域都是可见的）。或者它可以使用 define 来添加一个新变量，该变量应该对所有后续语句可见。
由于 IORef 只能在 IO 单子中使用，因此我们需要一个辅助操作来创建一个空环境。我们不能直接使用空列表 []，因为对 IORef 的所有访问都必须按顺序进行，因此空环境的类型为 IO Env，而不是简单的 Env
nullEnv :: IO Env
nullEnv = newIORef []
从这里开始，事情变得更加复杂，因为我们将同时处理 *两个* 单子。记住，我们还需要一个 Error 单子来处理未绑定变量等问题。需要 IO 功能的部分和可能抛出异常的部分是交织在一起的，因此我们不能只捕获所有异常，并将仅正常值返回给 IO 单子。
Haskell 提供了一种称为 *单子转换器* 的机制，它允许你组合多个单子的功能。我们将使用其中之一，ExceptT，它允许我们在 IO 单子的顶部添加错误处理功能。我们的第一步是为组合的单子创建一个类型别名
type IOThrowsError = ExceptT LispError IO
与 ThrowsError 相似，IOThrowsError 实际上是一个类型构造器：我们省略了最后一个参数，即函数的返回值类型。但是，ExceptT 比普通的 Either 多了一个参数：我们必须指定要在其上叠加错误处理功能的单子类型。我们创建了一个单子，它可能包含可能抛出 LispError 的 IO 操作。
我们有一系列 ThrowsError 和 IOThrowsError 函数，但不同类型的操作不能包含在同一个 do 块中，即使它们提供了基本上相同的功能。Haskell 已经提供了一种机制，提升，将较低类型（IO）的值带入组合的单子中。不幸的是，没有类似的支持将未转换的较高类型的值带入组合的单子中，因此我们需要自己编写它
liftThrows :: ThrowsError a -> IOThrowsError a
liftThrows (Left err) = throwError err
liftThrows (Right val) = return val
这将解构 Either 类型，要么重新抛出错误类型，要么返回普通值。类型类中的方法根据表达式的类型来解析，因此 throwError 和 return（分别为 MonadError 和 Monad 的成员）将采用它们的 IOThrowsError 定义。顺便说一下，这里提供的类型签名不是完全通用的：如果我们省略它，编译器将推断 liftThrows :: (MonadError m a) => Either e a -> m a。
我们还需要一个辅助函数来运行整个顶级 IOThrowsError 操作，并返回一个 IO 操作。我们无法从 IO 单子中逃逸，因为执行 IO 的函数会对外部世界产生影响，而你不希望在惰性求值的纯函数中出现这种情况。但是你可以运行错误计算并捕获错误。
runIOThrows :: IOThrowsError String -> IO String
runIOThrows action = runExceptT (trapError action) >>= return . extractValue
这使用我们之前定义的 trapError 函数来获取任何错误值，并将它们转换为它们的字符串表示形式，然后通过 runExceptT 运行整个计算。结果被传递给 extractValue，并在 IO 单子中返回一个值。
现在我们可以回到环境处理了。我们将从一个函数开始，该函数用于确定给定变量是否已经绑定在环境中，这对于正确处理 define 是必要的
isBound :: Env -> String -> IO Bool
isBound envRef var = readIORef envRef >>= return . maybe False (const True) . lookup var
这首先通过 readIORef 从 IORef 中提取实际的环境值。然后我们将它传递给 lookup，以搜索我们感兴趣的特定变量。lookup 返回一个 Maybe 值，因此如果该值为 Nothing，我们将返回 False，否则返回 True（我们需要使用 const 函数，因为 maybe 期望一个用于对结果执行的函数，而不仅仅是一个值）。最后，我们使用 return 将该值提升到 IO 单子中。由于我们只对真/假值感兴趣，因此我们不需要处理 lookup 返回的实际 IORef。
接下来，我们需要定义一个函数来检索变量的当前值
getVar :: Env -> String -> IOThrowsError LispVal
getVar envRef var = do env <- liftIO $ readIORef envRef
maybe (throwError $ UnboundVar "Getting an unbound variable" var)
(liftIO . readIORef)
(lookup var env)
与前面的函数类似，这首先从 IORef 中检索实际的环境。但是，getVar 使用 IOThrowsError 单子，因为它还需要执行一些错误处理。因此，我们需要使用 liftIO 函数将 readIORef 操作提升到组合的单子中。类似地，当我们返回该值时，我们使用 liftIO . readIORef 来生成一个 IOThrowsError 操作，它读取返回的 IORef。但是，我们不需要使用 liftIO 来抛出错误，因为 throwError 是为 MonadError 类型类 定义的，ExceptT 是该类型类的实例。
现在我们创建一个函数来设置值
setVar :: Env -> String -> LispVal -> IOThrowsError LispVal
setVar envRef var value = do env <- liftIO $ readIORef envRef
maybe (throwError $ UnboundVar "Setting an unbound variable" var)
(liftIO . (flip writeIORef value))
(lookup var env)
return value
同样，我们首先从 IORef 中读取环境，并对其运行 lookup。但是这次，我们想要改变变量，而不是只读取它。writeIORef 操作提供了一种方法来实现这一点，但它以错误的顺序获取参数（ref -> value 而不是 value -> ref）。因此，我们使用内置函数 flip 来交换 writeIORef 的参数，然后将值传递给它。最后，为了方便起见，我们返回我们刚刚设置的值。
我们需要一个函数来处理 define 的特殊行为，它在变量已经绑定时设置它，或者在没有绑定时创建一个新的变量。由于我们已经定义了一个函数来设置值，因此我们可以在前一种情况下使用它
defineVar :: Env -> String -> LispVal -> IOThrowsError LispVal
defineVar envRef var value = do
alreadyDefined <- liftIO $ isBound envRef var
if alreadyDefined
then setVar envRef var value >> return value
else liftIO $ do
valueRef <- newIORef value
env <- readIORef envRef
writeIORef envRef ((var, valueRef) : env)
return value
有趣的是后一种情况，即变量未绑定。我们创建一个 IO 操作（通过 do 符号），它创建一个新的 IORef 来保存新变量，读取环境的当前值，然后将一个新的列表写回该变量，该列表由添加到列表前面的新（键，变量）对组成。然后，我们使用 liftIO 将整个 do 块提升到 IOThrowsError 单子中。
还有一个有用的环境函数：能够一次绑定多个变量，就像函数被调用时发生的那样。我们不妨现在就构建这个功能，尽管我们直到下一节才会使用它
bindVars :: Env -> [(String, LispVal)] -> IO Env
bindVars envRef bindings = readIORef envRef >>= extendEnv bindings >>= newIORef
where extendEnv bindings env = liftM (++ env) (mapM addBinding bindings)
addBinding (var, value) = do ref <- newIORef value
return (var, ref)
这可能比其他函数更复杂，因为它使用了单子管道（而不是 do 语法）和一对辅助函数来完成工作。最好从辅助函数开始。`addBinding` 接收一个变量名和值，创建一个 `IORef` 来保存新变量，然后返回名称 - 值对。`extendEnv` 对 `bindings` 的每个成员调用 `addBinding`（mapM）以创建一个 `(String, IORef LispVal)` 对列表，然后将当前环境附加到该列表的末尾 (`++ env`)。最后，整个函数将这些函数连接在一个管道中，首先从其 `IORef` 中读取现有环境，然后将结果传递给 `extendEnv`，然后返回一个包含扩展环境的新 `IORef`。
现在我们已经拥有了所有环境函数，我们需要开始在求值器中使用它们。由于 Haskell 没有全局变量，因此我们必须将环境作为参数传递给求值器。我们也可以在此添加 set! 和 define 特殊形式。
eval :: Env -> LispVal -> IOThrowsError LispVal
eval env val@(String _) = return val
eval env val@(Number _) = return val
eval env val@(Bool _) = return val
eval env (Atom id) = getVar env id
eval env (List [Atom "quote", val]) = return val
eval env (List [Atom "if", pred, conseq, alt]) =
do result <- eval env pred
case result of
Bool False -> eval env alt
otherwise -> eval env conseq
eval env (List [Atom "set!", Atom var, form]) =
eval env form >>= setVar env var
eval env (List [Atom "define", Atom var, form]) =
eval env form >>= defineVar env var
eval env (List (Atom func : args)) = mapM (eval env) args >>= liftThrows . apply func
eval env badForm = throwError $ BadSpecialForm "Unrecognized special form" badForm
由于单个环境会贯穿整个交互式会话，因此我们需要更改一些 IO 函数以接受环境。
evalAndPrint :: Env -> String -> IO ()
evalAndPrint env expr = evalString env expr >>= putStrLn
evalString :: Env -> String -> IO String
evalString env expr = runIOThrows $ liftM show $ (liftThrows $ readExpr expr) >>= eval env
我们需要在 `evalString` 中使用 `runIOThrows`，因为单子的类型已从 `ThrowsError` 变为 `IOThrowsError`。同样，我们需要一个 `liftThrows` 来将 `readExpr` 带入 `IOThrowsError` 单子。
接下来，我们在启动程序之前用一个空变量初始化环境。
runOne :: String -> IO ()
runOne expr = nullEnv >>= flip evalAndPrint expr
runRepl :: IO ()
runRepl = nullEnv >>= until_ (== "quit") (readPrompt "Lisp>>> ") . evalAndPrint
我们创建了一个额外的辅助函数 `runOne` 来处理单表达式情况，因为它现在比仅仅运行 `evalAndPrint` 更加复杂。对 `runRepl` 的更改更为细微：请注意我们在 `evalAndPrint` 之前添加了一个函数组合运算符。这是因为 `evalAndPrint` 现在接受一个额外的 `Env` 参数，该参数从 `nullEnv` 中提供。函数组合告诉 `until_`，它不应该将普通的 `evalAndPrint` 作为操作，而应该首先将其应用于通过单子管道传下来的任何内容，在本例中是从 `nullEnv` 的结果。因此，应用于每行输入的实际函数是 `(evalAndPrint env)`，正如我们所期望的那样。
最后，我们需要更改主函数以调用 `runOne`，而不是直接评估 `evalAndPrint`。
main :: IO ()
main = do args <- getArgs
case length args of
0 -> runRepl
1 -> runOne $ args !! 0
otherwise -> putStrLn "Program takes only 0 or 1 argument"
我们可以编译并测试我们的程序。
$ ghc -package parsec -o lisp [../code/listing8.hs listing8.hs] $ ./lisp Lisp>>> (define x 3) 3 Lisp>>> (+ x 2) 5 Lisp>>> (+ y 2) Getting an unbound variable: y Lisp>>> (define y 5) 5 Lisp>>> (+ x (- y 2)) 6 Lisp>>> (define str "A string") "A string" Lisp>>> (< str "The string") Invalid type: expected number, found "A string" Lisp>>> (string<? str "The string") #t