48時間でSchemeを書こう/エラー処理と例外

現在のところ、コード中の様々な場所でエラーを無視するか、暗黙の内に#f0などの「デフォルト値」を与えています。いくつかの言語 - PerlやPHP等 - はこの方針で問題ないようです。しかしながら、それは大抵エラーが表面上は問題ないようにプログラム中を推移し、のちに大きな問題となって顕れるという、プログラマにとってデバッグしにくいものとなることを意味します。エラーが起こったその時にそれを報告し、直ちに実行を中止できればいいですね。

そのためには、第一に、Haskellの組み込みのエラー関数を使えるようControl.Monad.Errorをインポートする必要があります。

import Control.Monad.Error

Debianベースのシステムではlibghc6-mtl-devがインストールされていることが必要です。

次に、エラーを表すデータ型を定義しなくてはならないでしょう。

data LispError = NumArgs Integer [LispVal]
               | TypeMismatch String LispVal
               | Parser ParseError
               | BadSpecialForm String LispVal
               | NotFunction String String
               | UnboundVar String String
               | Default String

これらのコンストラクタは私たちがたった今必要とするよりは少し多いですが、インタプリタで今後どんな問題が起こり得るのか見ておくのもよいでしょう。次に、様々な型のエラーの表示方法を定義し、LispErrorShowのインスタンスにします。

showError :: LispError -> String
showError (UnboundVar message varname) = message ++ ": " ++ varname
showError (BadSpecialForm message form) = message ++ ": " ++ show form
showError (NotFunction message func) = message ++ ": " ++ show func
showError (NumArgs expected found) = "Expected " ++ show expected 
                                  ++ " args; found values " ++ unwordsList found
showError (TypeMismatch expected found) = "Invalid type: expected " ++ expected
                                       ++ ", found " ++ show found
showError (Parser parseErr) = "Parse error at " ++ show parseErr

instance Show LispError where show = showError

次のステップは私たちの定義したエラーの型を" Error型のインスタンスにすることです。これはGHCの組み込みのエラー処理関数の恩恵にあずかるには必須の手続きです。Errorのインスタンスとなるには、単にError型のインスタンスを前のエラーメッセージからかそれ自身で作る関数を提供すればいいだけです。

instance Error LispError where
     noMsg = Default "An error has occurred"
     strMsg = Default

そしてLispErrorを投げるか値を返す関数を表す型を定義します。 どのようにparseが例外を表現するのにEither型を使ったか覚えていますか?私たちもここで同じアプローチを取ります。

type ThrowsError = Either LispError

型コンストラクタは関数のようにカリー化され、関数のように部分適用することが出来ます。完全な型はEither LispError IntegerEither LispError LispValでしょうが、私たちはThrowsError LispValなどと書きたいのです。そこで、EitherLispErrorに部分適用して、どんな型にも使うことのできるThrowsError型コンストラクタを作ります。

Eitherはさらなるモナドの例の一つです。この場合、Eitherアクション間で持ち回られる「追加情報」はエラーが発生したかしなかったかです。bindはEitherアクションが通常の値を持っていれば与えられた関数を適用し、そうでなければ何もせずにそのままエラーを受け渡します。このような仕組みは他の言語では例外によって実現されていますが、Haskellは遅延評価するので、このために新たな制御構造を導入する必要がないのです。bindが値が既にエラーだと判断すれば、関数が呼ばれることはありません。

Eitherモナドは通常のモナドのための関数に加え、2つの特別な関数を提供します。

  1. throwError - エラーの値をとって、EitherLeftコンストラクタ(エラー)にliftします。
  2. catchError - Eitherアクションと、エラーを引数としてEitherアクションを返す関数を取って、アクションがエラーを表していれば与えられた関数を適用します。その関数では、例えばreturnを使ってエラーを普通の値に変えたり、違うエラーとして再度投げたりします。

私たちのプログラムでは、全てのエラーをその文字列表現に変えて、普通の値として返すことにします。そのためのヘルパー関数を作りましょう。

trapError action = catchError action (return . show)

trapErrorの結果は、常に非エラー値(Right)を持つEitherアクションです。他の関数から値を利用できるように、Eitherモナドから値を取り出す方法も用意しなくてはなりません。

extractValue :: ThrowsError a -> a
extractValue (Right val) = val

extractValueLeftコンストラクタに関して意図的に未定義にしてあります。Leftの時はHaskell側にエラーがあることを表すからです。extractValuecatchErrorの後にのみ使うことにしているので、変な値を残りのプログラム中に入れ込むよりはさっさと失敗する方がよいです。

これで基本的なインフラが整ったので、今度はエラー処理関数を使う段です。私たちのパーサがエラー時に単に"No match"という文字列を返していたことを覚えていますか?それをParseErrorにラップして投げるようにさせましょう。

readExpr :: String -> ThrowsError LispVal
readExpr input = case parse parseExpr "lisp" input of
    Left err -> throwError $ Parser err
    Right val -> return val

ここでは、まずParseErrorLispErrorのコンストラクタであるParserでラップし、組み込み関数throwErrorを使ってThrowsErrorモナドにして返します。readExprがモナド値を返すようになったので、もう一方の場合もreturnでラップしなければなりません(return val)。

次に、evalの型をモナドを返すように変え、戻り値をそれに合うように変えて、知らないパターンに出会ったときにエラーを投げる節を加えます。

eval :: LispVal -> ThrowsError LispVal
eval val@(String _) = return val
eval val@(Number _) = return val
eval val@(Bool _) = return val
eval (List [Atom "quote", val]) = return val
eval (List (Atom func : args)) = mapM eval args >>= apply func
eval badForm = throwError $ BadSpecialForm "Unrecognized special form" badForm

関数適用の節がeval(モナドを返す)を再帰的に呼ぶので、その節を変える必要があります。まず、mapmapM、モナドを扱う関数を値のリストにmapし、bindで結果の値を配列し、モナド中の値の結果をリストで返す関数に変えます。Errorモナドでは、この配列は全ての計算を順番に行いますが、その内のどれか一つでも失敗すればエラーを返し、Right [results]を成功時に、Left errorを失敗時に返します。そして、モナドのbindを使って部分適用されたapply funcにその結果を渡し、ここでも前の操作が失敗であったならばエラーを返します。

次に、与えられた関数を認識しなければエラーを投げるようにapply自身を変えます。

apply :: String -> [LispVal] -> ThrowsError LispVal
apply func args = maybe (throwError $ NotFunction "Unrecognized primitive function args" func)
                        ($ args)
                        (lookup func primitives)

私たちはreturnを関数適用($ args)に加えませんでした。代わりに、プリミティブの型を変え、lookupから返された関数自身ThrowsErrorアクションを返すようにします。

primitives :: [(String, [LispVal] -> ThrowsError LispVal)]

そして、もちろん、それらプリミティブを実装するnumericBinop関数を、一つしか引数が与えられなければエラーを投げるように変えなければいけません。

numericBinop :: (Integer -> Integer -> Integer) -> [LispVal] -> ThrowsError LispVal
numericBinop op singleVal@[_] = throwError $ NumArgs 2 singleVal
numericBinop op params = mapM unpackNum params >>= return . Number . foldl1 op

一引数のみの場合を捉えるには、@パターンを使います。エラー報告のために実際に渡された引数自体を使いたいからです。ここで、私たちは正確に一要素だけのリストを求めていて、かつその要素が何であるかは気にしません。また、私たちはunpackNumの結果を並べるのにmapMを使わねばならず、それはunpackNumの呼び出しそれぞれがTypeMismatchで失敗するかもしれないからです。

unpackNum :: LispVal -> ThrowsError Integer
unpackNum (Number n) = return n
unpackNum (String n) = let parsed = reads n in 
                          if null parsed 
                            then throwError $ TypeMismatch "number" $ String n
                            else return $ fst $ parsed !! 0
unpackNum (List [n]) = unpackNum n
unpackNum notNum = throwError $ TypeMismatch "number" notNum

最後に、この一連の巨大なエラーモナド群を使うためにmain関数を変える必要があります。これはIOErrorという二つのモナドを扱わなければいけなくなるので、ちょっと複雑になるかもしれません。なので、またdo記法を使うことにします。というのも一つのモナドが他のモナドに入れ子になっているときにpoint-free styleを使うのはほぼ不可能だからです。

main :: IO ()
main = do
    args <- getArgs
    evaled <- return $ liftM show $ readExpr (args !! 0) >>= eval
    putStrLn $ extractValue $ trapError evaled

この新たな関数がやっていることは以下の通りです。

  1. argsはコマンドライン引数のリスト
  2. evaledは以下の結果
    1. 最初の引数を取って(args !! 0)
    2. パースして(readExpr)
    3. evalに渡して(>>= eval - bind演算子は関数適用より高い優先順位を持つ)
    4. Errorモナドの中の値に対してshowを呼ぶ。アクション全体がIO (Either LispError String)型を持つので、evaledEither LispError String型を持つことに注意してください。trapError関数がエラーをStringにのみ変換でき、その型は普通の値の型に適合しなければならないので、そうでなくてはなりません。
  3. caughtは以下の結果
    1. trapErrorevaledに対して呼び、エラーをその文字列表現に変える
    2. extractValueを呼びStringEither LispError Stringアクションから取り出す
    3. putStrLnで結果を表示

新しいコードをコンパイル・実行して、いくつかエラーを投げさせてみてください。

% ghc -package parsec -o errorcheck [../code/listing5.hs listing5.hs]
% ./errorcheck "(+ 2 \"two\")"
Invalid type: expected number, found "two"
% ./errorcheck "(+ 2)"
Expected 2 args; found values 2
% ./errorcheck "(what? 2)"
Unrecognized primitive function args: "what?"

このコードをビルドするには--makeフラグと、予想されるように、これまでのlisting全てを加える必要があると何人かの読者から報告を受けました。これはGHCにimport文に記された依存関係全てを探し出して完全な実行ファイルをビルドするように指示します。上のコマンドは私のシステムでは上手くいきますが、あなたのところで駄目だった場合、--makeを試してみてください。