トップ > Haskell > 「Write Yourself a Scheme in 48 Hours」 を写経してみる(12) : 「エラーチェックと例外」をもっと

「Write Yourself a Scheme in 48 Hours」 を写経してみる(12) : 「エラーチェックと例外」をもっと

Haskell scheme

Env の内容が表示出来るようになったところで、 defineVarを動かしてみたいのですが Show インスタンスがないので表示できません。

> env <- nullEnv
> showEnv env  -- > []
> defineVar env "y" (Number 9)

<interactive>:1:0:
    No instance for (Show (IOThrowsError LispVal))
      arising from a use of `print' at <interactive>:1:0-27
    Possible fix:
      add an instance declaration for
      (Show (IOThrowsError LispVal))
    In a stmt of a 'do' expression: print it

いちばん分かりやすく実行できるのは evalString です。

> env <- nullEnv

> evalString env "(define q 99)"
defineVar: var=q value=Number 99
"Number 99"

> showEnv env
-- > [("q",Number 99)]

evalString が把握出来れば動きが理解できそうです。

evalString :: Env -> String -> IO String
evalString env expr = runIOThrows $ liftM show $ (liftThrows $ readExpr expr) >>= eval env

readExpr でS式の文字列を読み込んでパース、その結果を表示するまでを追ってみます。
readExpr の返す型は ThrowsError LispVal です。

> :t readExpr "(+ 1 2)"
readExpr "(+ 1 2)" :: ThrowsError LispVal

ThrowsError LispVal は以下のように定義されいています。

type ThrowsError = Either LispError

readExpr "(+ 1 2)" :: Either LispError LispVal
-- Right LispVal  -- パースに成功したとき
-- Left LispError -- パースに失敗したとき

readExpr の返す値は liftThrows へ渡されます。

type IOThrowsError = ErrorT LispError IO

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

> :t readExpr "(+ 1 2)"
readExpr "(+ 1 2)" :: ThrowsError LispVal

> :t liftThrows $ readExpr "(+ 1 2)"
liftThrows $ readExpr "(+ 1 2)" :: IOThrowsError LispVal

-- ThrowsError LispVal から IOThrowsError LispVal へ型を変換しています。

-- ThrowsError   は Either LispError
-- IOThrowsError は ErrorT LispError IO ですから、
-- Either LispError a -> ErrorT LispError IO a の型変換。少し長くなりますが、分かりやすいように書き換えてしまいます。

次は LispVal を引数として ErrorT LispError IO b を返す関数 eval 

> :t ((liftThrows $ readExpr "(+ 1 2)") >>=)
((liftThrows $ readExpr "(+ 1 2)") >>=) :: (LispVal -> ErrorT LispError IO b) -> ErrorT LispError IO b

> :t ((liftThrows $ readExpr "(+ 1 2)") >>= eval env)
-- > ((liftThrows $ readExpr "(+ 1 2)") >>= eval env)  :: ErrorT LispError IO LispVal

eval の結果は liftM show によって文字列に変換されます。(ErrorT LispError IO LispValから ErrorT LispError IO String)

> :t liftM show $ (liftThrows $ readExpr "(+ 1 2)") >>= eval env
-- > liftM show $ (liftThrows $ readExpr "(+ 1 2)") >>= eval env :: ErrorT LispError IO String

次に runIOThrows に渡される訳ですが、ここが例外処理のポイントのようです。

runIOThrows :: ErrorT LispError IO String -> IO String
runIOThrows action = runErrorT (trapError action) >>= return . extractValue

-- trapError action は別に定義してありますが、分かりやすい catchError action (return . show) に戻します。
-- return . extractValue も分かりやすい \(Right val)-> return val にします。

runIOThrows :: ErrorT LispError IO String -> IO String
runIOThrows action = runErrorT (action `catchError` (return . show)) >>= \(Right val)-> return val
> return val

-- catchError は action が成功したときは結果（evalの結果を文字列にしたもの）を返し、
-- 失敗したときはエラーを文字列に変換したものを返します。
> :t (liftM show $ (liftThrows $ readExpr "(+ 1 2)") >>= eval env) `catchError` (return . show)
-- >
(liftM show $ (liftThrows $ readExpr "(+ 1 2)") >>= eval env) `catchError` (return . show)
  :: ErrorT LispError IO String

runErrorT は何でしょう。

> :i runErrorT
-- > newtype ErrorT e m a = ErrorT {runErrorT :: m (Either e a)}
       -- Defined in Control.Monad.Trans.Error

> :t runErrorT
-- > runErrorT :: ErrorT e m a -> m (Either e a)

つまり、runErrorT は ErrorT LispError IO String から IO (Either LispError String) へ型変換する関数。さらに \(Right val)-> return val の部分でRightが取り除かれて文字列になります。

runIOThrows で ErrorT LispError IO Stringを返す関数の結果を表示してみます。

-- パース結果を文字列に
> runIOThrows $ liftM show $ (liftThrows $ readExpr "(+ 1 2)")
"List [Atom \"+\",Number 1,Number 2]"

-- 評価結果を文字列に
> runIOThrows $ liftM show $ (liftThrows $ readExpr "(+ 1 2)") >>= eval env
"Number 3"

-- パースエラーを文字列に
> runIOThrows $ liftM show $ (liftThrows $ readExpr "(+ 1 2")
"Parse error at \"lisp\" (line 1, column 7):\nunexpected end of
input\nexpecting space or \")\""

> runIOThrows $ liftM show $ (liftThrows $ readExpr "(+ 1 2") >>= eval env
"Parse error at \"lisp\" (line 1, column 7):\nunexpected end of input\nexpecting space or \")\""
  • liftThrows は Either LispError a から ErrorT LispError IO a へ変換する関数
  • runErrorT は ErrorT LispError IO a から IO (Either LispError a) へ変換する関数

ですから相互に変換が可能です。

> :t readExpr "(+ 1 2)"
-- > readExpr "(+ 1 2)" :: Either LispError LispVal
> :t liftThrows $ readExpr "(+ 1 2)"
-- > liftThrows $ readExpr "(+ 1 2)" :: ErrorT LispError IO LispVal

> :t runErrorT $ liftThrows $ readExpr "(+ 1 2)"
-- > runErrorT $ liftThrows $ readExpr "(+ 1 2)" :: IO (Either LispError LispVal)

> f <- (runErrorT $ liftThrows $ readExpr "(+ 1 2)")
> :t liftThrows f
-- > liftThrows f :: ErrorT LispError IO LispVal

runIOThrows は ErrorT LispError IO String を受け取って例外を捕捉して文字列を返します。

runIOThrows :: ErrorT LispError IO String -> IO String

> env <- nullEnv 

> runIOThrows $ liftM show $ (setVar env "y" (Number 9))
-- > "Settingan unbound variable: y"

> runIOThrows $ liftM show $ (defineVar env "y" (Number 9))
defineVar: var=y value=Number 9
-- > "Number 9"

> runIOThrows $ liftM show $ (defineVar env "y" (Number 9))
defineVar: var=y value=Number 9
-- > "Number 9"

> runIOThrows $ liftM show $ (getVar env "y" )
-- > "Number 9"

isBound は 変数が登録されているかどうか確認する関数。
bindVars は [(String, LispVal)]の書式で変数を追加する関数です。

> isBound env "y" -- > True
> isBound env "x" -- > False

> env <- bindVars env [("a",(String "a"))]
> showEnv env
-- > [("y",String "Hello,Scheme!"),("a",String "a")]

ErrorT LispError IO a を表示する関数を作ってみます。

> runErrorT ((liftM show $ (liftThrows $ readExpr "(+ 1 2)") >>= eval env) `catchError` (return . show)) 
-- > Right "Number 3"

> runErrorT ((liftM show $ defineVar env "abc" (Number 9))  `catchError` (return . show)) 
-- > Right "Number 9"

> runErrorT ((liftM show $ (liftThrows $ readExpr "(+ 1 2") >>= eval env) `catchError` (return . show)) 
-- > Right "Parse error at \"lisp\" (line 1, column 7):\nunexpected end of input\nexpecting space or \")\""

-- 以上から
showIOThrowsError a = runErrorT ((liftM show a)  `catchError` (return . show)) 

> env <- nullEnv
> showIOThrowsError $ defineVar env "abc" (Number 9)
-- >　Right "Number 9"

> showIOThrowsError $ getVar env "abc" 
-- >　Right "Number 9"

> showIOThrowsError $ liftThrows $ readExpr "(+ 1 2)"
-- >　Right "List [Atom \"+\",Number 1,Number 2]"

これで listing8.hs までほぼ把握出来たので先に進みます。(liftIO はまだですが・・・)