「Write Yourself a Scheme in 48 Hours」 を写経してみる(9) : 変数の追加と割り当て

• Write Yourself a Scheme in 48 Hours/Adding Variables and Assignment
• http://jonathan.tang.name/files/scheme_in_48/code/listing8.hs

まず、評価をするeval関数から見ていきます。

eval :: Env -> LispVal -> IOThrowsError LispVal
eval env val@(String _) = return val
eval env val@(Number _) = return val
eval env val@(Bool _) = return val
-- Atom を評価したときに　getVar が呼ばれる。
eval env (Atom id) = getVar env id
eval env (List [Atom "quote", val]) = return val
eval env (List [Atom "if", pred, conseq, alt]) = 
    do result <- eval env pred
       case result of
         Bool False -> eval env alt
         otherwise -> eval env conseq
eval env (List [Atom "set!",   Atom var, form]) = eval env form >>= setVar env var
eval env (List [Atom "define", Atom var, form]) = eval env form >>= defineVar env var
eval env (List (Atom func : args)) = mapM (eval env) args >>= liftThrows . apply func
eval env badForm = throwError $ BadSpecialForm "Unrecognized special form" badForm

set! 関数と define 関数が増えています。

-- set! を評価すると eval env form によりformの部分が評価され
-- setVar により　var を key として評価された値が IORefに書き込まれる。
eval env (List [Atom "set!",   Atom var, form]) = eval env form >>= setVar env var

-- define を評価するとを評価すると eval env form によりformの部分が評価され
-- defineVar により　var を key として評価された値が IORefに書き込まれる。
eval env (List [Atom "define", Atom var, form]) = eval env form >>= defineVar env var

それと、引数の型に Env が加わっています。

旧・・・eval :: LispVal -> ThrowsError LispVal
新・・・eval :: Env -> LispVal -> IOThrowsError LispVal

Gauche で define と set! のおさらい。

$ rlwrap gosh
gosh> (define a 100)
;; => a
gosh> a
;; => 100
gosh> (set! a "Hello")
;; => "Hello"
gosh> a
;; => "Hello"

set!、define は定義した値を環境に記憶させ、記憶させた値を名前から引き出せるようにするためのものです。
setVar は環境 env から変数 var を探して writeIORef で書き込んでいるようです。
var が見つからなかったら、例外を投げています。

getVar :: Env -> String -> IOThrowsError LispVal
getVar envRef var  =  do env <- liftIO $ readIORef envRef
                         maybe (throwError $ UnboundVar "Getting an unbound variable" var)
                               (trace("getVar: "++show var )
                                    (liftIO . readIORef))
                               (lookup var env)

setVar :: Env -> String -> LispVal -> IOThrowsError LispVal
setVar envRef var value = do env <- trace("setVar: "++show var ++" : "++show value)
                                          (liftIO $ readIORef envRef)
                             maybe (throwError $ UnboundVar "Setting an unbound variable" var) 
                                   (liftIO . (flip writeIORef value))
                                   (lookup var env)
                             return value

defineVar :: Env -> String -> LispVal -> IOThrowsError LispVal
defineVar envRef var value = do 
    alreadyDefined <- trace("defineVar: "++show var ++" : "++show value)
                           (liftIO $ isBound envRef var) -- IORef にvarが記録されているか読み出す。
    if alreadyDefined 
       then setVar envRef var value >> return value -- 既に登録されているときは　setVar を呼ぶ。
       else liftIO $ do 
          valueRef <- newIORef value    -- 値の IORef を作る
          env      <- readIORef envRef  -- envRef のリストを読み出す
          writeIORef envRef ((var, valueRef) : env) -- 読み出したリストに作ったIORefを追加して、それを書き込む
          return value

set!、define が書き込むIORefは key となるStringと(IORef LispVal)のタプルのリスト。nullEnvで空っぽのリストを持つIORefが作成されます。

type Env = IORef [(String, IORef LispVal)]

nullEnv :: IO Env
nullEnv = newIORef []

liftIO って何だ・・・Orz

$ rlwrap runghc listing8.hs

Lisp>>> (define x 123)
defineVar: "x" : Number 123
Number 123
Lisp>>> x
getVar: "x"
Number 123
Lisp>>> (+ x 123)
getVar: "x"
Number 246
Lisp>>> (set! x 999)
setVar: "x" : Number 999
Number 999
Lisp>>> x
getVar: "x"
Number 999
Lisp>>> quit

うーん、分からないところをメモして先に進みます。

parseNumber :: Parser LispVal
parseNumber = liftM (Number . read) $ many1 digit

> ( liftM read (return "123")) :: IO Integer
-- > 123

-- (Number . read) ???
> ( liftM (Number . read) (return "123")) :: IO LispVal
-- > Number 123

-- Number って関数じゃないんですけど・・・Orz
> ( liftM Number (return 123)) 
-- > Number 123

-- でも関数と同等。
> :t Number
Number :: Integer -> LispVal

> :i Number
data LispVal = ... | Number Integer | ...
  	-- Defined at listing8.hs:32:15-20

-- こうは書けるけど
> ( Number ( 123)) -- > Number 123

-- こうは書けないので liftM を使っている。
> ( Number (return 123)) 

<interactive>:1:10:
    Couldn't match expected type `Integer' against inferred type `m t'
    In the first argument of `Number', namely `(return 123)'
    In the expression: (Number (return 123))
    In the definition of `it': it = (Number (return 123))

変数を保存、読み込みするための IORef を受け取って文字列を評価する部分。
パースに失敗すると例外。

> env <- nullEnv -- 初期化した IORef
> runIOThrows $ liftM show $ (liftThrows $ readExpr "(+ 1 2)") >>= eval env
-- > "Number 3"

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

> runIOThrows $ liftM show $ (liftThrows $ readExpr "(+ 1 2)") 
-- > "List [Atom \"+\",Number 1,Number 2]"

> runIOThrows $ liftM show $ (liftThrows $ readExpr "(+ 1 2") 
-- > "Parse error at \"lisp\" (line 1, column 7):\nunexpected end of input\nexpecting space or \")\""

あと一息だけど・・・。

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

> runErrorT (trapError (liftM show $ (liftThrows $ readExpr "(+ 1 2)")))
-- > Right "List [Atom \"+\",Number 1,Number 2]"

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

モナドのすべて / Error モナド このあたりの理解が必要なようです。

> env <- nullEnv
> evalString env "(define z 987)"
defineVar: "z" : Number 987
"Number 987"

> evalString env "z"
getVar: "z"
"Number 987"

> evalString env "(set! z 123)"
setVar: "z" : Number 123
"Number 123"

> evalString env "z"
getVar: "z"
"Number 123"