超似非G-Machineを実装してみた

http://www.jaist.ac.jp/~kiyoshiy/writing/
http://www.jaist.ac.jp/~kiyoshiy/writing/gmachine.pdf
前半だけ読んで、ざっと書いてみました。

Graph-Reductionとか正直分からなかったので、それを考慮して書こうと思ったのですが、普通にちっこいλ式解釈機になってしましました・・・。
ここに書いている様なβ簡約とかδ簡約は書けていませんが、Call-by-needな感じになりました。

data Exp = Var String | Lit Int | Lam Exp Exp | App Exp Exp | Add Exp Exp deriving Show

get_varg (Lam (Var str) _) = str
get_body (Lam _ body)      = body

eval_exp (App (Lam (Var str) body) arg) env = let varg = str
                                                  env' = (varg,arg):env
                                              in eval_exp body env' 
                                             
eval_exp (App (App a b) c) env = do (intern,env') <- eval_exp (App a b) env
                                    eval_exp (get_body intern) ((get_varg intern,c):env')

eval_exp (Var s) env = do exp <- lookup_var (Var s) env
                          env' <- (do return $ modify_env (Var s) exp env) -- call-by-need
                          return (exp,env')

eval_exp (Lit l) env = return (Lit l,env)

eval_exp (Add l r) env = do (Lit l',_) <- eval_exp l env
                            (Lit r',_) <- eval_exp r env
                            return (Lit(l'+r'),env)

eval_exp (Lam (Var str) body) env  = Just (Lam (Var str) body,env)

lookup_var :: Exp -> [(String,Exp)] -> Maybe Exp
lookup_var (Var s) ((name,val):res)
    | s == name  = eval_exp val [] >>= return.fst
    | null res   = Nothing
    | otherwise  = lookup_var (Var s) res

modify_env :: Exp -> Exp -> [(String,Exp)] -> [(String,Exp)]
modify_env (Var s) exp ((name,val):res)
    | s == name  = (s,exp):res
    | otherwise  = (name,val):(modify_env (Var s) exp res)

{-
eval_exp (App (Lam (Var "x") (Add (Var "x") (Lit 10))) (Lit 100)) []

eval_exp (App (Lam (Var "x") (Lam (Var "y") (Add (Var "x") (Var "y")))) (Lit 1)) []

eval_exp (App (App (Lam (Var "x") (Lam (Var "y") (Add (Var "x") (Var "y")))) (Lit 1)) (Lit 2)) []

eval_exp (App (Lam (Var "x") (Add (App (Lam (Var "y") (Var "y")) (Lit 1)) (Var "x"))) (Lit 2)) []

eval_exp (Add (App (Lam (Var "x") (Var "x")) (Lit 1)) (App (Lam (Var "x") (Var "x")) (Lit 2))) []

eval_exp (App (App (Lam (Var "x") (Lam (Var "y") (Add (Var "x") (Var "x")))) (Lit 10)) (Lit 50)) []

eval_exp (App (Lam (Var "x") (Add (Var "x") (Var "x"))) (Add (Lit 10) (Lit 20))) []

eval_exp (App (App (Lam (Var "x") (Lam (Var "y") (Add (Var "x") (Var "x")))) (Add (Lit 1) (Lit 2))) (Add (Lit 10) (Lit 20))) []

eval_exp (App (Lam (Var "x") (Var "x")) (Add (Lit 10) (Lit 20))) []
-}

環境の扱いが気持ち悪いのと、間接ノードを導入しないで、環境内を書き換えています。(最後の例を実行すると、環境の中に(Lit 30)とか見えたり)

このpaperはこの後もあるので、一通りちゃんと読めたらもう一度書き直してみようかと。