48時間でSchemeを書こう/エラー処理と例外
現在のところ、コード中の様々な場所でエラーを無視するか、暗黙の内に#f
や0
などの「デフォルト値」を与えています。いくつかの言語 - 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
これらのコンストラクタは私たちがたった今必要とするよりは少し多いですが、インタプリタで今後どんな問題が起こり得るのか見ておくのもよいでしょう。次に、様々な型のエラーの表示方法を定義し、LispError
をShow
のインスタンスにします。
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 Integer
かEither LispError LispVal
でしょうが、私たちはThrowsError LispVal
などと書きたいのです。そこで、Either
をLispError
に部分適用して、どんな型にも使うことのできるThrowsError
型コンストラクタを作ります。
Either
はさらなるモナドの例の一つです。この場合、Either
アクション間で持ち回られる「追加情報」はエラーが発生したかしなかったかです。bindはEither
アクションが通常の値を持っていれば与えられた関数を適用し、そうでなければ何もせずにそのままエラーを受け渡します。このような仕組みは他の言語では例外によって実現されていますが、Haskellは遅延評価するので、このために新たな制御構造を導入する必要がないのです。bindが値が既にエラーだと判断すれば、関数が呼ばれることはありません。
Either
モナドは通常のモナドのための関数に加え、2つの特別な関数を提供します。
- throwError - エラーの値をとって、
Either
のLeft
コンストラクタ(エラー)にliftします。 - catchError -
Either
アクションと、エラーを引数としてEither
アクションを返す関数を取って、アクションがエラーを表していれば与えられた関数を適用します。その関数では、例えばreturn
を使ってエラーを普通の値に変えたり、違うエラーとして再度投げたりします。
私たちのプログラムでは、全てのエラーをその文字列表現に変えて、普通の値として返すことにします。そのためのヘルパー関数を作りましょう。
trapError action = catchError action (return . show)
trapError
の結果は、常に非エラー値(Right
)を持つEither
アクションです。他の関数から値を利用できるように、Either
モナドから値を取り出す方法も用意しなくてはなりません。
extractValue :: ThrowsError a -> a
extractValue (Right val) = val
extractValue
はLeft
コンストラクタに関して意図的に未定義にしてあります。Leftの時はHaskell側にエラーがあることを表すからです。extractValue
をcatchError
の後にのみ使うことにしているので、変な値を残りのプログラム中に入れ込むよりはさっさと失敗する方がよいです。
これで基本的なインフラが整ったので、今度はエラー処理関数を使う段です。私たちのパーサがエラー時に単に"No match"
という文字列を返していたことを覚えていますか?それをParseError
にラップして投げるようにさせましょう。
readExpr :: String -> ThrowsError LispVal
readExpr input = case parse parseExpr "lisp" input of
Left err -> throwError $ Parser err
Right val -> return val
ここでは、まずParseError
をLispError
のコンストラクタである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
(モナドを返す)を再帰的に呼ぶので、その節を変える必要があります。まず、map
をmapM、モナドを扱う関数を値のリストに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
関数を変える必要があります。これはIO
とError
という二つのモナドを扱わなければいけなくなるので、ちょっと複雑になるかもしれません。なので、またdo記法を使うことにします。というのも一つのモナドが他のモナドに入れ子になっているときにpoint-free styleを使うのはほぼ不可能だからです。
main :: IO ()
main = do
args <- getArgs
evaled <- return $ liftM show $ readExpr (args !! 0) >>= eval
putStrLn $ extractValue $ trapError evaled
この新たな関数がやっていることは以下の通りです。
args
はコマンドライン引数のリストevaled
は以下の結果- 最初の引数を取って(
args !! 0
) - パースして(
readExpr
) eval
に渡して(>>= eval
- bind演算子は関数適用より高い優先順位を持つ)Error
モナドの中の値に対してshow
を呼ぶ。アクション全体がIO (Either LispError String)
型を持つので、evaled
がEither LispError String
型を持つことに注意してください。trapError
関数がエラーをString
にのみ変換でき、その型は普通の値の型に適合しなければならないので、そうでなくてはなりません。
- 最初の引数を取って(
caught
は以下の結果trapError
をevaled
に対して呼び、エラーをその文字列表現に変えるextractValue
を呼びString
をEither LispError String
アクションから取り出す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
を試してみてください。