- Write Yourself a Scheme in 48 Hours/Error Checking and Exceptions
- http://jonathan.tang.name/files/scheme_in_48/code/listing5.hs
-- readExpr は (Right) パースに成功するとパースした値を返す。 -- 失敗のときは (Parser err) の例外を投げる。 readExpr :: String -> ThrowsError LispVal readExpr input = case parse parseExpr "lisp" input of Left err -> throwError $ Parser err Right val -> return val
data LispError = NumArgs Integer [LispVal] | TypeMismatch String LispVal -- 期待した型と一致しない | Parser ParseError -- パースエラー | BadSpecialForm String LispVal -- eval パーターンにマッチしない | NotFunction String String -- func が見つからない | UnboundVar String String | Default String 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 instance Error LispError where noMsg = Default "An error has occurred" strMsg = Default type ThrowsError = Either LispError trapError :: (MonadError e m, Show e) => m String -> m String trapError action = catchError action (return . show) -- :t catchError -- catchError :: MonadError e m => -- m a -> -- エラー -- (e -> m a) -> -- エラーを返値に変換する関数 -- m a extractValue :: ThrowsError a -> a extractValue (Right val) = val
main を部分的に実行してその様子を見てみます。
main :: IO () main = do args <- getArgs evaled <- return $ liftM show $ readExpr (args !! 0) >>= eval putStrLn $ extractValue $ trapError evaled
パースエラーと例外
S式の文字列をパースして内部データに変換する readExpr の返す型は ThrowsError LispVal です。
> ghci listing5.hs > :t readExpr "(+ 1 2)" readExpr "(+ 1 2)" :: ThrowsError LispVal > readExpr "(+ 1 \"two\")" Right (+ 1 "two") > readExpr "(add 1 \"two\")" Right (add 1 "two") -- パースに失敗すると例外を投げます。 > readExpr "((add 1 \"two\")" Left Parse error at "lisp" (line 1, column 15): unexpected end of input expecting space or ")"
評価エラーと例外
eval は正常に評価出来たときは LispVal を返し、評価に失敗すると LispError を返します。
> :t readExpr "(+ 1 2)" >>= eval -- > readExpr "(+ 1 2)" >>= eval :: Either LispError LispVal -- eval のパーターンにマッチしないとき -- BadSpecialForm 型のエラーを返す。 > readExpr "abc" >>= eval -- > Left Unrecognized special form: abc -- apply 関数の中で primitives の中から lookup にて func を探したけれども見つからなかった。 -- maybe が NotFunction 型のエラーを返す。 > readExpr "(add 1 2)" >>= eval -- > Left Unrecognized primitive function args: "add" -- 引数となるリストを展開しているとき、期待した型以外のデータにあたった。 > readExpr "(+ 1 \"two\")" >>= eval -- > Left Invalid type: expected number, found "two"
show を適用することにより文字列に変換。
> readExpr "(+ 1 2)" >>= eval -- > Right 3 > liftM show $ readExpr "(+ 1 2)" >>= eval -- > Right "3"
trapError により例外を捕捉し、エラーメッセージを文字列に。
> return $ liftM show $ readExpr "(+ 1 \"two\")" >>= eval -- > Left Invalid type: expected number, found "two" > trapError =<< (return $ liftM show $ readExpr "(+ 1 \"two\")" >>= eval ) -- > Right "Invalid type: expected number, found \"two\"" > trapError =<< (return $ liftM show $ readExpr "(+ 1 2)" >>= eval ) -- > Right "3"
extractValue で Right を外している。
> extractValue $ trapError =<< (return $ liftM show $ readExpr "(+ 1 2)" >>= eval ) -- > "3" > extractValue $ trapError =<< (return $ liftM show $ readExpr "(+ 1 \"two\")" >>= eval ) -- > "Invalid type: expected number, found \"two\""
