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

最后，我們來看點有趣的東西：變量。變量讓我們能夠暫時存儲表達式的結(jié)果然后在之后使用它們。在Scheme里梭域，變量能夠被重置成新的值因此它在程序執(zhí)行的過程中可能會收到改變。這似乎對Haskell來說有點困難，因為Haskell的編程模型是基于返回值而不是改變值的函數(shù)構(gòu)建的蹲嚣。

然而，我們還是有一些方法能夠來在Haskell中模擬狀態(tài)祟牲，都是通過Monad來實現(xiàn)的。最簡單的也許就是State Monad了抖部，它允許你將任意的狀態(tài)隱藏在Monad中然后在幕后將它們進行傳遞说贝。你需要指定一個狀態(tài)類型作為參數(shù)傳遞給這個Monad（例如，一個返回整型但會改變一個字符串Pair列表的函數(shù)慎颗，它的類型就是State [(String, String)] Integer）乡恕，然后通過get和put函數(shù)在一個do代碼塊中來對狀態(tài)進行訪問。你需要像這樣runState myStateAction initialList來指定初始狀態(tài)俯萎，而它會返回一個由返回值和最終狀態(tài)組成的Pair傲宜。

不幸的是，State Monad并不能完全滿足我們的要求夫啊，因為我們需要存儲的數(shù)據(jù)類型是非常復(fù)雜的函卒。對一個簡單的頂層環(huán)境來說，我們可以通過[(String, LispVal)]的方式將變量名和實際的值對應(yīng)起來進行存儲撇眯。然而报嵌，當我們在處理函數(shù)調(diào)用的時候，嵌套的環(huán)境就會讓這些對應(yīng)關(guān)系變成一個任意深度的的棧熊榛。當我們在程序中添加閉包時锚国，環(huán)境就會被存儲成一個隨意的函數(shù)值然后在整個程序中傳遞。事實上玄坦，整個環(huán)境需要被存儲到一個變量里然后再傳遞給runState Monad血筑，而這是不被允許的。

所以我們這里使用一個叫做State Threads的功能，讓Haskell能夠幫助我們管理這些聚合的狀態(tài)豺总。它讓我們能夠像是在其他編程語言里那樣通過函數(shù)讀寫那樣操縱變量车伞。這里有兩種State Threads：ST Monad會創(chuàng)建一個有狀態(tài)的計算單元，并保證這個狀態(tài)不會逃逸到程序的其他部分中园欣。IORef module則讓你能夠在IO Monad之中使用狀態(tài)化的變量帖世。由于我們顯然需要同時處理狀態(tài)以及IO這兩件事情（在REPL里我們已經(jīng)用到了，并且我們最后也會給語言本身提供IO的功能）因此我們這里就使用IORef沸枯。

我們能從導(dǎo)入Data.IORef并為我們的環(huán)境定義一個類型開始：

import Data.IORef

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

這里我們聲明Env為一個IORef日矫，它包含了一個從字符串映射到可變LispVals值的列表。對于這個列表里面的每個值以及它本身绑榴，我們都需要使用IORef因為程序可能通過兩種方式來對環(huán)境進行改變哪轿。它可能使用set!來改變單個變量的值，被更新的值對所有共享這個環(huán)境的函數(shù)來說都是可見的翔怎。（Scheme允許嵌套的范圍窃诉，因此外部范圍的變量在所有內(nèi)部范圍內(nèi)都是可見的）。它也允許你使用define來添加一個變量赤套，同樣你在隨后的聲明中就可以使用這個變量飘痛。

由于IORefs只能在IO Monad的范圍內(nèi)使用，我們需要一個輔助操作來創(chuàng)建一個空的環(huán)境容握。顯然我們不能簡單的使用一個空列表list[]因為所有對IORefs的訪問都需要按順序進行宣脉，因此我們的空環(huán)境的類型也應(yīng)該是IO Env而不是一個單純的Env：

nullEnv :: IO Env
nullEnv = newIORef []

從這里開始，事情變得有點復(fù)雜了剔氏，因為我們會同時處理兩個Monads塑猖。記住我們還需要一個Error Monad來處理一些類似未綁定變量的錯誤情況。需要IO功能的部分和可能會拋出異常的部分現(xiàn)在重疊了谈跛，因此我們這里不能僅僅將所有異常捕獲然后傳遞普通值給IO Monad羊苟。

Haskell提供了一種叫做Monad變換的機制，讓你能夠?qū)⒍喾NMonad的功能結(jié)合起來感憾。我們這里會用到其中的一種蜡励，ErrorT，這讓我們從將錯誤處理的功能放在IO Monad的上層吹菱。接下來讓我們先為我們的組合Monad創(chuàng)建一個類型別名：

type IOThrowsError = ErrorT LispError IO

和ThrowsError一樣巍虫，IOThrowsError是一個類型構(gòu)造器：我們留下了代表函數(shù)返回值類型的最后一個參數(shù)。然而鳍刷，ErrorT比之前我們遇到的Either類型還要多讀取一個參數(shù)：我們需要指定在錯誤處理功能層之下的Monad的類型占遥。因此，我們這里創(chuàng)建的是一個會包含可能會拋出LispError錯誤的IO操作的Monad输瓜。

我們現(xiàn)在能將ThrowsError和IOThrowsError的函數(shù)混合在一起了瓦胎，但是不同類型的操作是不能包含在同一個do代碼塊里的芬萍，即使它們實質(zhì)上功能相同。Haskell提供了機制讓我們能將底層的IO類型lifting成組合形式的Monad搔啊。然后很不幸我們卻沒法通過類似的方法將我們的高階類型ThrowsError轉(zhuǎn)變成組合過后的Monad形式柬祠，因此我們只好自己來寫一個：

liftThrows :: ThrowsError a -> IOThrowsError a
liftThrows (Left err) = throwError err
liftThrows (Right val) = return val

這里我們將Either類型的數(shù)據(jù)進行分解，然后要么重新拋出錯誤负芋，要么將原始值返回漫蛔。類型類中的方法會根據(jù)表達式中定義的類型進行解析，因此這里throwError和return函數(shù)（分別是MonadError和Monad的成員）會基于IOThrowsError的定義進行返回旧蛾。另外莽龟，這里我們給出的類型簽名并不是最通用的形式：如果我們將它遺漏了，編譯器會替我們推導(dǎo)出liftThrows :: (MonadError m a) => Either e a -> m a锨天。

我們還需要一個能夠幫助我們執(zhí)行整個頂層IOThrowsError操作并返回一個IO操作的輔助函數(shù)毯盈。最終我們還是無法逃避IO，因為一個產(chǎn)生IO操作的函數(shù)最終會對整個外部世界產(chǎn)生作用病袄，而你絕對不會希望它發(fā)生在一個純粹的搂赋，會被延遲計算的函數(shù)中。但是你可以嘗試運行計算并且捕獲發(fā)生的錯誤益缠。

runIOThrows :: IOThrowsError String -> IO String
runIOThrows action = runErrorT (trapError action) >>= return . extractValue

這里用到了我們之前定義的trapError函數(shù)脑奠，它會讀取任意的錯誤類型的值作為參數(shù)然后將它們轉(zhuǎn)換成對應(yīng)的字符串表達的形式，我們通過runErrorT函數(shù)來執(zhí)行整個計算過程幅慌。計算的結(jié)果會傳遞給extractValue函數(shù)然后通過return作為一個IO Monad進行返回捺信。

現(xiàn)在我們是時候回到我們的環(huán)境處理的部分了。我們會從一個判斷變量是否已經(jīng)與環(huán)境綁定的函數(shù)開始欠痴，我們之后的define函數(shù)的定義會用到它：

isBound :: Env -> String -> IO Bool
isBound envRef var = readIORef envRef >>= return . maybe False (const True) . lookup var

這里首先通過readIORef函數(shù)將環(huán)境值從IORef中分解了出來。然后我們將它傳遞給lookup函數(shù)來對我們有興趣的特定名稱進行搜尋秒咨。lookup函數(shù)會返回一個Maybe類型的值喇辽，如果我們得到得值是Nothing，我們這里就返回False雨席，反之我們就返回True（我們這里需要使用一個const函數(shù)因為maybe函數(shù)需要接受一個根據(jù)結(jié)果計算的函數(shù)而不僅僅是一個指定的值）菩咨。最后，我們使用return來將結(jié)果lift成IO Monad陡厘。因為我們現(xiàn)在只對True/False值有興趣抽米，我們不需要對lookup實際返回的IORef值進行處理。

接下來糙置，我們來創(chuàng)建一個從當前已經(jīng)定義過得變量中獲取值的函數(shù)：

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)

和之前的函數(shù)一樣云茸，首先從IORef中獲取我們實際需要的環(huán)境值。不同的是getVar函數(shù)返回的是一個IOThrowsError Monad谤饭，因為它也包含了一些錯誤處理标捺。所以我們這里需要使用liftIO函數(shù)來將readIORef操作lift成組合形式的Monad懊纳。類似的，當我們返回值的時候我們也使用liftIO . readIORef來構(gòu)造一個會讀取返回的IORef的IOThrowsError操作亡容。然而嗤疯，由于throwError實際是MonadError類型類中定義的方法而ErrorT是它的一個實例，我們這里并不需要使用liftIO來拋出錯誤闺兢。

現(xiàn)在來創(chuàng)建一個設(shè)置值的函數(shù)：

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

同樣我們首先將環(huán)境從IORef中讀出然后對它運行一個lookup函數(shù)茂缚。然而這次我們不僅僅是讀出變量的值，我們還想要修改它屋谭。writeIORef操作提供了方法脚囊，但它讀入?yún)?shù)的順序錯了（ref -> value而不是value -> ref）。我們使用內(nèi)置的flip函數(shù)來交換參數(shù)的位置然后再傳遞給writeIORef戴而。最后凑术，方便起見我們將設(shè)置成功的值返回。

我們還需要一個特殊的函數(shù)來處理define所意，它會在變量已經(jīng)存在的時候更新它而在名稱不存在的時候創(chuàng)建一個新的變量淮逊。由于我們已經(jīng)有了更新值得函數(shù)了，我們可以用它來處理第一種情況：

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

第二種變量沒有在環(huán)境中被綁定的情況其實蠻有趣的扶踊。我們（通過do代碼塊）創(chuàng)建一個會創(chuàng)建新的IORef來包裹變量的IO操作泄鹏，我們用它來讀取現(xiàn)在的環(huán)境值，然后再將一個將新的(key, variable)對添加到頭部的列表寫入這個變量秧耗。然后我們將整個do代碼塊通過liftIO函數(shù)lift成IOThrowsError Monad备籽。

最后一個用戶的環(huán)境相關(guān)的函數(shù)：一次性將一大捆變量進行綁定，這在函數(shù)定義中會非常有用分井。雖然我們現(xiàn)在還用不到它车猬，不過在下一章的時候我們會需要它的：

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)

它也許比之前的其他函數(shù)更加復(fù)雜，因為它使用了Monad管道（而不是之前我們熟悉的do表示法）以及一系列輔助函數(shù)尺锚。我們來從輔助函數(shù)開始看珠闰。addBinding函數(shù)讀入一個變量名和一個值，然后創(chuàng)建一個會包裹這個變量的IORef值瘫辩，然后再返回這個鍵值對伏嗜。extendEnv函數(shù)通過mapM對bindings參數(shù)的每一個成員調(diào)用addBinding函數(shù)來創(chuàng)建一個(String, IORef LispVal)對的列表，然后再將當期的環(huán)境添加到這個列表的最后(++ env)伐厌。最后承绸，整個函數(shù)將這些函數(shù)串聯(lián)成一個管道，從將當前的環(huán)境從對應(yīng)的IORef值中讀取開始挣轨，然后將結(jié)果傳遞給extendEnv军熏，最后再將擴展后的環(huán)境傳遞給一個新的IORef。

現(xiàn)在既然我們有了所有的環(huán)境處理函數(shù)刃唐，我們可以開始在求值器中使用它們了羞迷。由于Haskell并沒有全局變量界轩，我們必須讓我們的環(huán)境作為參數(shù)在貫穿于整個求值器中。同時衔瓮，我們不妨將需要的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

由于會有一個特定的環(huán)境貫穿我們的整個交互的會話，我們需要修改幾個IO相關(guān)的函數(shù)讓它們能夠讀取到我們的環(huán)境热鞍。

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函數(shù)中我們需要runIOThrows是因為現(xiàn)在的Monad類型已經(jīng)從ThrowsError變?yōu)镮OThrowsError了葫慎。同樣，我們需要使用liftThrows來讓readExpr函數(shù)成為一個IOThrowsError Monad薇宠。

接下來偷办，我們在程序運行之前通過一個空得變量來初始化環(huán)境：

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

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

我們這里創(chuàng)建了一個用來處理單個表達式的輔助函數(shù)runOne，因為現(xiàn)在這種情況不僅僅只需要運行一次evalAndPrint了澄港。runRepl的改變則有點微妙：注意到我們在evalAndPrint之前加了一個函數(shù)組合符了嗎椒涯？這是因為現(xiàn)在evalAndPrint函數(shù)還需要讀取一個額外的環(huán)境參數(shù)，我們首先傳遞給了它一個nullEnv回梧。這個函數(shù)組合符告訴until_不要將現(xiàn)在evalAndPrint當做老版的操作那樣直接使用废岂，我們首先需要將從Monad管道里取的值對它進行應(yīng)用，就是我們傳遞給它的nullEnv狱意。所以湖苞，現(xiàn)在實際對每行輸入應(yīng)用的函數(shù)是(evalAndPrint env)，就和我們想要的一樣详囤。

最后财骨，我們需要修改主函數(shù)讓它調(diào)用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