Haskellでの変数と関数のevalの実装方法
48時間でSchemeを書こうを参考に関数の定義と呼び出しの実装をしよう
↑では、エラー処理などが含まれていて仰々しいので今回はもっとシンプルに核の部分だけを実装する
今回作るのは1引数のみを取る関数
この変数束縛でできないこと
未定義への変数へアクセスしたときのエラー処理
この関数定義でできないこと
関数1の中で、外部で定義した関数2、を呼べない
外部で定義した変数も参照できない
こっちに関しては純粋ならコレで良いかもだが
複数の引数を取ることができない
目次
ASTは作っている前提
ref 関数のAST
変数の定義
変数の参照
関数の定義
関数の呼び出し
ASTは作っている前提
なので、入力した1+2のような文字列を解釈できるわけではない
変数の定義
diff
emptyEnvで環境の初期化をする
envBindで、既にその変数が束縛されているなら上書き、そうでないなら新しく登録する
isBoundで既に束縛れているかどうかを判定
setVarで実際に登録する
本当はx=1と入力したら、x=1と返してあげたいねmrsekut.icon
今は1と返している
code:hs
envBind :: String -> AST -> Env -> IO AST
envBind var ast env = do
hasVar <- isBound var env
if hasVar
then setVar var ast env >> return ast
else do
a <- newIORef ast
e <- readIORef env
writeIORef env ((var, a) : e)
return ast
where
isBound :: String -> Env -> IO Bool
isBound var env = isJust . lookup var <$> readIORef env
setVar :: String -> AST -> Env -> IO AST
setVar var ast env = do
e <- readIORef env
case lookup var e of
Just v -> writeIORef v ast
Nothing -> return ()
return ast
#わかった
isBoundの返り値はなんでIO Bool？Boolでええやんmrsekut.icon
fmapの型的にムリ
fmap (isJust . lookup var) (readIORef env)のところ
isJust . lookup var :: [([Char], a)] -> Bool
readIORef env :: IO a
変数の参照
diff
Varを見かけたときに、envの中から登録したものを参照して返す
getVarでenvから検索して返す
なかった場合は、-1を返す
これは本来は良くないが停止しなくなるのでしゃぁなしの特殊対応とするmrsekut.icon
code:hs
getVar :: String -> Env -> IO AST
getVar var env = do
e <- readIORef env
case lookup var e of
Just v -> readIORef v
Nothing -> return (Var "error") -- error
関数の定義
diff
特に変わったことはない。変数の定義のときと同じ
関数の呼び出し
diff
bindVarsで局所的な新しい環境を作成する
code:hs
bindVars :: (String, AST) -> Env -> IO Env
bindVars bindings envRef = readIORef envRef >>= extendEnv bindings >>= newIORef
where
extendEnv
:: (String, AST) -> (String, IORef AST) -> IO (String, IORef AST)
extendEnv bindings env = liftM (++ env) (mapM addBinding bindings)
addBinding :: (String, AST) -> IO (String, IORef AST)
addBinding (var, value) = do
ref <- newIORef value
return (var, ref)
f 2を実行したときのEnvの動き
code:hs
f x = x + 1 -- 定義
f 2 -- 実行
code:hs
eval (App f x) = do -- App "f" (Nat 2)
exp <- getVar f -- exp == Lambda PVar "x" (BinOp Add (Var "x") (Nat 1))
case exp of --
Lambda args body -> do -- args == PVar "x", body == (BinOp Add (Var "x") (Nat 1))
x' <- eval x -- x' == ENat 2
bindVars (args2key args, evaled2exp x') -- ("x", Nat 2)を追加
eval body -- body == (BinOp Add (Nat 2) (Nat 1)) を評価して Nat 3を得る
_ -> return $ EString "app" --
f [1,2,3]を実行したときのEnvの動き
code:hs
f (x:xs) = x + 1 -- 定義
f 1,2,3 -- 実行
code:hs
eval (App f x) = do -- App "f" (List Nat 1,Nat 2,Nat 3)
exp <- getVar f -- exp == Lambda [PList PVar "x",PVar "xs"] (BinOp Add (Var "x") (Nat 1))
case exp of --
Lambda args body -> do -- args == [PList PVar "x",PVar "xs"], body == (BinOp Add (Var "x") (Nat 1))
x' <- eval x -- x' == EList ENat 1,ENat 2,ENat 3
bindVars (args2key args, evaled2exp x') -- [("x", Nat 1), ("xs", (List Nat 2, Nat 3))]を追加
eval body -- body == (BinOp Add (Nat 1) (Nat 1)) を評価して Nat 2を得る
_ -> return $ EString "app" --