原文。
https://en.wikibooks.org/wiki/Write_Yourself_a_Scheme_in_48_Hours/Adding_Variables_and_Assignment

最后，我们来看点有趣的东西：变量。变量让我们能够暂时存储表达式的结果然后在之后使用它们。在Scheme里，变量能够被重置成新的值因此它在程序执行的过程中可能会收到改变。这似乎对Haskell来说有点困难，因为Haskell的编程模型是基于返回值而不是改变值的函数构建的。

然而，我们还是有一些方法能够来在Haskell中模拟状态，都是通过Monad来实现的。最简单的也许就是State Monad了，它允许你将任意的状态隐藏在Monad中然后在幕后将它们进行传递。你需要指定一个状态类型作为参数传递给这个Monad（例如，一个返回整型但会改变一个字符串Pair列表的函数，它的类型就是State [(String, String)] Integer），然后通过get和put函数在一个do代码块中来对状态进行访问。你需要像这样runState myStateAction initialList来指定初始状态，而它会返回一个由返回值和最终状态组成的Pair。

不幸的是，State Monad并不能完全满足我们的要求，因为我们需要存储的数据类型是非常复杂的。对一个简单的顶层环境来说，我们可以通过[(String, LispVal)]的方式将变量名和实际的值对应起来进行存储。然而，当我们在处理函数调用的时候，嵌套的环境就会让这些对应关系变成一个任意深度的的栈。当我们在程序中添加闭包时，环境就会被存储成一个随意的函数值然后在整个程序中传递。事实上，整个环境需要被存储到一个变量里然后再传递给runState Monad，而这是不被允许的。

所以我们这里使用一个叫做State Threads的功能，让Haskell能够帮助我们管理这些聚合的状态。它让我们能够像是在其他编程语言里那样通过函数读写那样操纵变量。这里有两种State Threads：ST Monad会创建一个有状态的计算单元，并保证这个状态不会逃逸到程序的其他部分中。IORef module则让你能够在IO Monad之中使用状态化的变量。由于我们显然需要同时处理状态以及IO这两件事情（在REPL里我们已经用到了，并且我们最后也会给语言本身提供IO的功能）因此我们这里就使用IORef。

我们能从导入Data.IORef并为我们的环境定义一个类型开始：

import Data.IORef

type Env = IORef [(String, IORef LispVal)]

这里我们声明Env为一个IORef，它包含了一个从字符串映射到可变LispVals值的列表。对于这个列表里面的每个值以及它本身，我们都需要使用IORef因为程序可能通过两种方式来对环境进行改变。它可能使用set!来改变单个变量的值，被更新的值对所有共享这个环境的函数来说都是可见的。（Scheme允许嵌套的范围，因此外部范围的变量在所有内部范围内都是可见的）。它也允许你使用define来添加一个变量，同样你在随后的声明中就可以使用这个变量。

由于IORefs只能在IO Monad的范围内使用，我们需要一个辅助操作来创建一个空的环境。显然我们不能简单的使用一个空列表list[]因为所有对IORefs的访问都需要按顺序进行，因此我们的空环境的类型也应该是IO Env而不是一个单纯的Env：

nullEnv :: IO Env
nullEnv = newIORef []

从这里开始，事情变得有点复杂了，因为我们会同时处理两个Monads。记住我们还需要一个Error Monad来处理一些类似未绑定变量的错误情况。需要IO功能的部分和可能会抛出异常的部分现在重叠了，因此我们这里不能仅仅将所有异常捕获然后传递普通值给IO Monad。

Haskell提供了一种叫做Monad变换的机制，让你能够将多种Monad的功能结合起来。我们这里会用到其中的一种，ErrorT，这让我们从将错误处理的功能放在IO Monad的上层。接下来让我们先为我们的组合Monad创建一个类型别名：

type IOThrowsError = ErrorT LispError IO

和ThrowsError一样，IOThrowsError是一个类型构造器：我们留下了代表函数返回值类型的最后一个参数。然而，ErrorT比之前我们遇到的Either类型还要多读取一个参数：我们需要指定在错误处理功能层之下的Monad的类型。因此，我们这里创建的是一个会包含可能会抛出LispError错误的IO操作的Monad。

我们现在能将ThrowsError和IOThrowsError的函数混合在一起了，但是不同类型的操作是不能包含在同一个do代码块里的，即使它们实质上功能相同。Haskell提供了机制让我们能将底层的IO类型lifting成组合形式的Monad。然后很不幸我们却没法通过类似的方法将我们的高阶类型ThrowsError转变成组合过后的Monad形式，因此我们只好自己来写一个：

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 = runErrorT (trapError action) >>= return . extractValue

这里用到了我们之前定义的trapError函数，它会读取任意的错误类型的值作为参数然后将它们转换成对应的字符串表达的形式，我们通过runErrorT函数来执行整个计算过程。计算的结果会传递给extractValue函数然后通过return作为一个IO Monad进行返回。

现在我们是时候回到我们的环境处理的部分了。我们会从一个判断变量是否已经与环境绑定的函数开始，我们之后的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来将结果lift成IO Monad。因为我们现在只对True/False值有兴趣，我们不需要对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 Monad，因为它也包含了一些错误处理。所以我们这里需要使用liftIO函数来将readIORef操作lift成组合形式的Monad。类似的，当我们返回值的时候我们也使用liftIO . readIORef来构造一个会读取返回的IORef的IOThrowsError操作。然而，由于throwError实际是MonadError类型类中定义的方法而ErrorT是它的一个实例，我们这里并不需要使用liftIO来抛出错误。

现在来创建一个设置值的函数：

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

第二种变量没有在环境中被绑定的情况其实蛮有趣的。我们（通过do代码块）创建一个会创建新的IORef来包裹变量的IO操作，我们用它来读取现在的环境值，然后再将一个将新的(key, variable)对添加到头部的列表写入这个变量。然后我们将整个do代码块通过liftIO函数lift成IOThrowsError Monad。

最后一个用户的环境相关的函数：一次性将一大捆变量进行绑定，这在函数定义中会非常有用。虽然我们现在还用不到它，不过在下一章的时候我们会需要它的：

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)

它也许比之前的其他函数更加复杂，因为它使用了Monad管道（而不是之前我们熟悉的do表示法）以及一系列辅助函数。我们来从辅助函数开始看。addBinding函数读入一个变量名和一个值，然后创建一个会包裹这个变量的IORef值，然后再返回这个键值对。extendEnv函数通过mapM对bindings参数的每一个成员调用addBinding函数来创建一个(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是因为现在的Monad类型已经从ThrowsError变为IOThrowsError了。同样，我们需要使用liftThrows来让readExpr函数成为一个IOThrowsError Monad。

接下来，我们在程序运行之前通过一个空得变量来初始化环境：

runOne :: String -> IO ()
runOne expr = nullEnv >>= flip evalAndPrint expr

runRepl :: IO ()
runRepl = nullEnv >>= until_ (== "quit") (readPrompt "Lisp>>> ") . evalAndPrint

我们这里创建了一个用来处理单个表达式的辅助函数runOne，因为现在这种情况不仅仅只需要运行一次evalAndPrint了。runRepl的改变则有点微妙：注意到我们在evalAndPrint之前加了一个函数组合符了吗？这是因为现在evalAndPrint函数还需要读取一个额外的环境参数，我们首先传递给了它一个nullEnv。这个函数组合符告诉until_不要将现在evalAndPrint当做老版的操作那样直接使用，我们首先需要将从Monad管道里取的值对它进行应用，就是我们传递给它的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