やっと、我々は便利なものを手にします。変数です。変数は評価の結果を保存したり、あとから参照出来るようにしてくれます。Schemeの中では、変数は新しい値でリセットすることができますし、またプログラムの実行によって、その値は変化します。これは、Haskellにとっては複雑に見えます。というのも、Haskellの実行モデルは、値を返す関数の上に構築されており、それらを変えることが出来ないからです。

 にも関わらず、Haskellでは同じ状態をシミュレートする方法がいくつかあり、全てモナドに関係します。一番シンプルなのは、おそらくState モナドです。このモナドは、任意の状態をモナドの中に隠しておいて、舞台裏で周囲に渡します。貴方は、パラメータとして、状態のタイプをこのモナドに記入し、普通はdoブロックの中から、get と putの機能を使って、アクセスすることができます(もし関数がIntegerを返してきて、でもStringの二組のリストに変更するなら、それは State [(String,String)] Integerという型を持ちます)。貴方は、戻り値と最終状態を含んだペアを返すrunState myStateAction initialListを通じて、初期状態を記述します。

 残念なことに、このStateモナドは私たちのためには上手く動いてはくれません。というのも、私たちが格納しておきたいデータの型というのは、かなり複雑だからです。もっともシンプルな環境では、変数名から値にマッピングするのを格納することによって、[(String, LispVal)]でやり通すことができますが、しかし、私たちが関数の呼び出しを扱い始めると、これらのマッピングは、任意の深さの、入れ子になった環境のスタックになるでしょう。そして、私たちがクロージャーを追加したとき、この環境はきっと任意の関数の値に保存され、そしてプログラム全体から返されるかもしれません。事実、容認できなくなるまで、値を保存し、runStateモナドは完全に潰されるでしょう。

 代わりに、私たちはState スレッドと呼ばれるものを使って、私たちの為に、この集合状態をHaskellに管理させましょう。これは変数を得たり、設定する為の機能を使って、他のプログラム言語と同じように、可変変数を扱うことができるようになります。Stateスレッドには二つの種類があります。 ST monad は残りのプログラムへ状態を回避させることなしに、単体で実行されるような、ステートフルな変数を作り出すSTモナドです。また、IORef モジュールは、IO monadの中で、私たちにステートフルな変数を使わせてくれます。状態を、どんな方法でもいいので、仲介する必要がありますので(REPLの中で、行間を持続させ、最終的に、言語自身にIO functionを持つとしても)、私たちはIO Refsを扱います。

 Data.IORefをimportすることから始めましょう。そして、状態のための、型を決定します。

import Data.IORef

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

 これで、変化が多いLispValを文字列として対応した、IORefが持つリストとして、Envを定義できます。リストかそれ自身両方のための、そして個々の値のために、IO Refsが必要です。というのも、Schemeが環境を変化させるためには、二つの方法があるからです。まず一つに、個々の変数の値を変化させ、明らかな変化を、この環境で共有するためのいくつかの機能を、set!で使えます(Schemeはスコープを入れ子にすることを許可しています。なので、外のスコープにある変数も、全ての内部スコープから見えています)。また、全てのサブシークエントの式から見えるべきである、新しい変数を追加するためのdefineも使うことができます。

 IORefs は ただ、IOモナドの内部の中でのみ使うことができます。空の環境を作るアクションのための手伝いを欲しがるでしょう。ただ、空のリストである [] は使うことができません。というのは、IORefsにアクセスするときは、必ず順番が決まっていなければならないからで、だから私たちの空っぽな環境の型は、ただの空のEnvの代わりに、IO Envになります。

nullEnv :: IO Env
nullEnv = newIORef []

 ここから、ちょっとだけ複雑になります。というのも同時に二つのモナドを扱わないといけないからです。未束縛の変数のようなエラーを扱うため、Errorモナドが必要だったことを思い出して下さい。IO機能が必要な部分、および例外を投げることができる部分が入り組んでいるので、単純に全ての例外をキャッチして、IOモナドにノーマルな値を返すだけでは上手くいきません。

 Haskellは、モナド変換子として知られる、複数のモナドの機能を結合させる仕組みを提供しています。私たちは、その一つである - ErrorT - を使うことになるでしょう。これを使って、IOモナドの上にエラー処理の階層を与えます。私たちの最初のステップでは、結合したモナドのために、型の別名を作ります。

type IOThrowsError = ErrorT LispError IO

 ThrowsError同様、IOThrowsErrorは実際には型のコンストラクタです。関数の戻り値の型を渡すための最後の引数が省かれています。また、ErrorT は、前の素朴な Either 型と違い、もう1つの引数を取ります。この引数には、エラー処理のレイヤーで覆うモナドの型を渡します。これで、LispErrorをスローし、IOアクションを含むモナドを作れます。

 私たちは、IOThrowsErrorとThrowsErrorを混用します。しかし違う型によるアクションは同じdoブロックの中に含めることが出来ません。それが、たとえ本質的には同じ機能を提供していたとしてもです。Haskellには、既に、下位の型(IO)の値を合成モナドへ入れるための仕組みがあります。 liftingです。残念なことに、未変換の上位型の値を、合成モナドの中へと入れる関数はありません。自分でそういうものを書く必要があります。

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

 これは、Either型のコンストラクタに応じて、エラーを投げ返すか、正常な値を返しています。型クラスのメソッドは、式の型に基づいて解決されます。そのため、throwErrorreturn (それぞれ、 MonadErrorMonad のメンバー) は、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に渡され、そして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が要求するのは、ただの値ではなく、結果を実行する関数だからです)。最後に値をIOモナドに持ち上げるためreturnを使います。ここでは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モナドを使います。というのも、これは、エラー処理が必要だからです。結局、readIORefを合成モナドに持ち上げるため liftIO関数を使う必要が出てきました。同じように値を返す時にも、検索されたIORefを読み込むようなIOThrowsErrorアクションを生成するため liftIO . readIORef を使います。しかし、エラーを投げるために、liftIOを使う必要はありません。というのも、throwErrorはMonadError typeclassに定義されているからで、ErrorTはこのインスタンスだからです。

 関数に、値をセットする関数を作りましょう。

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アクションは、これらの意味を供給してくれますが、引数の順序が逆です(value -> ref ではなく ref -> value である)。そこで、ビルトイン関数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記法を使って、ひとつのIOアクションを作っています。このアクションは、新しい変数を保持する新しいIORefを作り、環境の現在の値を読み込み、その先頭に、新しい変数の (key,変数) ペアを追加して、その新しいリストを書き戻しています。そして、このdoブロック全体をliftIOを使って、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 を作り、(name,value)のペアを返します。extendEnvは bindings (mapM) の各要素に対し、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が必要になります。というのも、ThrowsErrorからIOThrowsErrorに変化させることができるからです。同様に、私たちはreadExprをIOThrowsErrorモナドに運ぶためのliftThrowsが必要になります。

 次に、私たちは、プログラムが始まる前に、null変数で環境を初期化しましょう。

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

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

 単一の式を実行するため、新しい関数、runOneを追加しました。というのは、今やただevalAndPrintをただ走らせるよりも複雑になっているからです。runReplの書き換えは、ちょっとだけとらえがたいものです。evalAndPrintの前に、オペレーターを構成する関数を如何に追加したか、思い出してください。今や、evalAndPrintは、nullEnv を開始とするEnvパラメーターが追加されているからです。この関数合成は、until_ がアクションとして前の素朴なevalAndPrintを取る代わりに、モナディックパイプラインを下って来るもの、この場合ならnullEnvの結果を、最初にこの合成関数に適用するようにしています。従って、それぞれの入力ラインに適用する実際の関数は(evalAndPrint env)で、これは、私たちが求めるものです。

 最後に、私たちはevalAndPrintを直接評価する代わりに、runOneを呼び出すように、main関数を変えてやる必要があります。

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"

 そして、コンパイルしたあとに、プログラムをテストしてみましょう。

debian:/home/jdtang/haskell_tutorial/code# ghc -package parsec -o lisp [../code/listing8.hs listing8.hs]
 debian:/home/jdtang/haskell_tutorial/code# ./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