48時間でSchemeを書こう/IOプリミティブの作成

　私たちのSchemeは外部の世界と未だに対話することが出来ません。もし何かしらのI/Oの機能があればとてもよいでしょう。同様に、私たちがインタプリターを起動する度に、本当に関数の中で長ったらしい記述をするより、コードが書いてあるファイルを読み込めて、それを評価できたらよいでしょう。

　必要になる、まず最初のことは、LispVal のための新しいコンストラクタです。PrimitiveFuncsはIOモナドを含まない特別な型を持っています。ですので、他のIOを用いることができません。私たちは、IOを用いることができる専用のコンストラクタが必要です。

             | IOFunc ([LispVal] -> IOThrowsError LispVal)

　この中で、私たちは、同様に port という、Schemeのデータタイプの為のコンストラクタを定義します。私たちのIO関数の多くは、これらの一つを取って、読み書きされます。

             | Port Handle

　Handle は、基本的な portの Haskell notionで、openFIleおよび類似のIOアクションによって返され、貴方はそれへ読み書きを行うことが出来ます。

　完全を期すために、私たちは新しいデータ型のために、showValメソッドを定義する必要があります。

showVal (Port _) = "<IO port>"
showVal (IOFunc _) = "<IO primitive>"

　これは、きっと、REPL機能を適切にし、portを返す関数を使うときに、クラッシュしないようにしてくれるでしょう。

　私たちは同様に applyを修正し、IOFunc が扱えるようにします。

apply (IOFunc func) args = func args

　loadをサポートするため、私たちのパーサーをマイナーチェンジする必要があります。普通、Schemeファイルは複数の定義を含んでおり、パーサーにも、幾つかの評価をサポートしたり、あるいは空白によって分割することを追加しないといけません。そして、同様に扱い時のエラーも必要になります。私たちは、実際のパーサーがパラメーターを取れるような基礎的なreadExprを作ることによって、殆どの存在する基盤を再利用することが出来ます。

readOrThrow :: Parser a -> String -> ThrowsError a
readOrThrow parser input = case parse parser "lisp" input of
    Left err -&gt; throwError $ Parser err
    Right val -&gt; return val

readExpr = readOrThrow parseExpr
readExprList = readOrThrow (endBy parseExpr spaces)

　再び、readExpr及びreadExprListの両方を、新しく命名されたreadOrThrowが特別化されたものとして考えます。私たちは、自分たちのREPLを単純な評価として読み込みます。私たちは、readExprListを、loadの中から、プログラムの中から読み込むために使うでしょう。　次に、ただ存在するprimitiveリストみたいに構成された、IO primitvesの新しいリストが必要になるでしょう。

 ioPrimitives :: [(String, [LispVal] -> IOThrowsError LispVal)]
 ioPrimitives = [("apply", applyProc),
                 ("open-input-file", makePort ReadMode),
                 ("open-output-file", makePort WriteMode),
                 ("close-input-port", closePort),
                 ("close-output-port", closePort),
                 ("read", readProc),
                 ("write", writeProc),
                 ("read-contents", readContents),
                 ("read-all", readAll)]

　ここでは、違いは型のシグネチャの違いです。残念なことに、私たちは、存在するprimitiveのリストを使うことが出来ません。というのも、リストは型の違いによる要素に含めることができないからです。私たちは同様に、primitiveBindingsの定義を新しいprimitivesに新しく追加するよう編集する必要があります。

primitiveBindings :: IO Env
primitiveBindings = nullEnv >>= (flip bindVars $ map (makeFunc IOFunc) ioPrimitives
                                              ++ map (makeFunc PrimitiveFunc) primitives)
    where makeFunc constructor (var, func) = (var, constructor func)

　私たちは、コンストラクターの引数を取るためにmakeFuncを作り、そして今や過去のまっさらなprimitivesにioPrimitiveのリストを追加してmakeFuncを呼び出します。

　今、私たちは実際の関数を定義し始めています。applyProcはapplyのまわりを薄く包み込み、解きほぐされた引数のリストから、applyが期待しているものへと反応します。

applyProc :: [LispVal] -> IOThrowsError LispVal
applyProc [func, List args] = apply func args
applyProc (func : args) = apply func args

　makeProtはHaskellの関数であるopenFileを包み込み、右の型にコンバートし、そしてPortコンストラクタの中で返り値をラップします。これはIOMode、open-input-fileの為の、ReadMode及びWriteModeに、部分的に適応します。

makePort :: IOMode -> [LispVal] -> IOThrowsError LispVal
makePort mode [String filename] = liftM Port $ liftIO $ openFile filename mode

　ClosePortは同様に、Haskellの同等の手続きと、同じhCloseをラップします。

closePort :: [LispVal] -> IOThrowsError LispVal
closePort [Port port] = liftIO $ hClose port >> (return $ Bool True)
closePort _ = return $ Bool False

　Schemeのために、LispValに適切に切り替えるために、(ビルドインされたreadと、名前がコンフリクトしないように避けられた)readProcは、hGetLineをラップし、そしてparseExprの結果に送ります。

readProc :: [LispVal] -&gt; IOThrowsError LispVal
readProc [] = readProc [Port stdin]
readProc [Port port] = (liftIO $ hGetLine port) &gt;&gt;= liftThrows . readExpr

　"hGetLine port"が如何に IO Stringの型となるのか、また如何にreadExprがString -> ThrowsError LispValの型になるのかに気をつけてください。そして、両方とも、(liftIOやliftThrowsや、おのおのと共に)、IOThrowsErrorモナドに変換する必要があります。彼らができることは、モナディックバインドオペレーターを使って彼らを橋渡しすることです。

　writeProcはLispValをストリングにして、特別なポートにコンバートして書き直すということです。

writeProc :: [LispVal] -> IOThrowsError LispVal
writeProc [obj] = writeProc [obj, Port stdout]
writeProc [obj, Port port] = liftIO $ hPrint port obj >> (return $ Bool True)

　私たちは、プリントアウトするためのオブジェクトの上に、明確にshowを呼び出す必要性がなくなりました。というのも、hPrintはShow型の値を取るからです。これは、私たちのために、自動的にshowを呼び出します。これは、ShowインスタンスをLispValに作るのを悩ませる原因にもなります。同様に、私たちは、自動的な変換を使うことができませんし、またshowValそれ自身を呼ばなければなりません。多くの他のHaskell関数は、同様にShowインスタンスを取り、もし他のIO primitivesをこれに拡張するなら、重要な仕事として保管できるでしょう。　readContentsは、全体のファイルを、メモリの中で文字列に変換します。これはHaskellのもつreadFileの簡単なラッパーで、ただIOアクションをIOThowsErrorに渡し、Stringコンストラクタの中でそれをラップします。

readContents :: [LispVal] -> IOThrowsError LispVal
readContents [String filename] = liftM String $ liftIO $ readFile filename

　助けになる関数である"load"は、Schemeの持つロードが何を読み込んでいるものを、読み込むことが出来ません（私たちはあとでこれを取り扱うでしょう）。むしろ、これはファイルの全ての節を分割して、読み込んでいるのが原因だからです。二つの部分を使いましょう。(値のリストを返す)readAllと、(Schemeの表現として、値を評価する)loadとです。

load :: String -> IOThrowsError [LispVal]
load filename = (liftIO $ readFile filename) >>= liftThrows . readExprList

　それゆえ、readAllはListコンストラクタと共に値を返すラップをします。

readAll :: [LispVal] -> IOThrowsError LispVal
readAll [String filename] = liftM List $ load filename

　実際の、Schemeのload関数を取り扱う手段は、少々トリッキーになります。というのは、loadは束縛をローカル環境へと取り入れるからです。しかし、Applyは環境を引数として取ることがでいないし、primitve関数(や他の関数)の為に、これを行う方法もありません。私たちは、特別なかたちとして、この周辺にloadの手段を作りましょう。

eval env (List [Atom "load", String filename]) = 
    load filename >>= liftM last . mapM (eval env)

　最終的に、私たちは自分たちのrunOne関数を、コマンドラインからの単独な表現として評価する代わりとして、変化させることができました。これは、プログラムとして評価し、実行するためのファイル名を取ります。追加されたコマンドラインの引数は、Schemeプログラムの中で、引数リストに束縛されます。

runOne :: [String] -> IO ()
runOne args = do
    env <- primitiveBindings >>= flip bindVars [("args", List $ map String $ drop 1 args)] 
    (runIOThrows $ liftM show $ eval env (List [Atom "load", String (args !! 0)])) 
         >>= hPutStrLn stderr

　ここはちょっと難解なので、徐々にまいりましょう。最初の分は、元のprimitve束縛を取っていて、bindVarsに投げて、そして最初の引数以外の全てのStringの解釈を含んだリストを束縛した、変数名"args"を追加します(最初の引数は、評価されたファイル名です)。そして、ユーザーがタイプしたかどうか、またはそれを評価したかどうかで、Schemeのかたちを作り("args1"を読み込み)ます。その結果、文字列に変化します。(覚えておいてください。これはエラーを受け取る前に、このようにしてやる必要があります。というのも、エラーはそれらを文字列にコンバートするために扱うもので、まずは型をあわせないといけません）、そして、全体のIOThrowsErrorアクションを走らせます。そして、私たちは STDERRを結果としてプリントします。(伝統的なUNIXの大会では、STDOUTはプログラムのアウトプットの為だけに使われるべきで、いかなるエラーメッセージもSTDERRで扱われるべきです。この場合だと、私たちは同様に、このプログラムの最終的な説の値を返すときにプリントされますが、一般的にはどんなものでも意味がないものです)

　そして、新しいrunOne関数によって、mainを変化させましょう。私たちはもはやコマンドライン引数の間違った値を扱うために、三つ目の節が必要となりましたので、私たちはif文を簡単に、ここに追加しましょう。

main :: IO ()
main = do args >- getArgs
          if null args then runRepl else runOne $ args