「環境とクロージャを用いた、より効率的な関数型プログラミング言語の定義＆実装の仕方の例」をHaskellで実装してみた ref: http://qiita.com/nobsun/items/cbb780ffb68634873639

EnvironmetClos

module EnvironmentClos where

import AbstractSyntax

-- |
-- 環境
type Env = [(String, Value)]

emptyEnv :: Env
emptyEnv = []

lookupEnv :: String -> Env -> Maybe Value
lookupEnv = lookup

insertEnv :: String -> Value -> Env -> Env
insertEnv x v env = (x,v) : env

-- |
-- 値
data Value = VInt Integer             -- ^ 整数
           | VClosure String Exp Env  -- ^ 関数
             deriving (Show)

EvaluatorClos.hs

module EvaluatorClos where

import AbstractSyntax
import EnvironmentClos

-- |
-- 評価器
-- プログラム例1：たしざん
-- >>> let one_plus_two = Sub (Int 1) (Sub (Int 0) (Int 2))
-- >>> eval one_plus_two []
-- VInt 3
--
-- プログラム例2：関数定義・適用と条件分岐の例
-- >>> let _Let x e1 e2 = App (Fun x e2) e1
-- >>> let _Abs = _Let "abs" (Fun "x" (If (Var "x") (Int 0) (Sub (Int 0) (Var "x")) (Var "x"))) (App (Var "abs") (Int (-42)))
-- >>> eval _Abs []
-- VInt 42
--
-- プログラム例3：無限ループ
-- >>> let fix = Fun "f" (App (Fun "x" (App (Var "f") (Fun "y" (App (App (Var "x") (Var "x")) (Var "y"))))) (Fun "x" (App (Var "f") (Fun "y" (App (App (Var "x") (Var "x")) (Var "y"))))))
-- >>> let _Rec f x e1 e2 = App (App fix (Fun f (Fun x e1))) e2
-- >>> let loop = _Rec "f" "x" (App (Var "f") (Var "x")) (Int 0)
--
-- ghci> eval loop []
--   C-c C-cInterrupted.
--
-- プログラム例4：1から10000までの整数の和
-- >>> let sum10000 = _Rec "sum" "n" (If (Var "n") (Int 0) (Int 0) (Sub (App (Var "sum") (Sub (Var "n") (Int 1))) (Sub (Int 0) (Var "n")))) (Int 10000)
-- >>> eval sum10000 []
-- VInt 50005000
--
-- プログラム例5：クロージャ
-- >>> let clo = _Let "y" (Int 3) (_Let "f" (Fun "x" (Sub (Var "x") (Var "y"))) (_Let "y" (Int 7) (Sub (App (Var "f") (Int 42)) (Var "y"))))
-- >>> clo
-- App (Fun "y" (App (Fun "f" (App (Fun "y" (Sub (App (Var "f") (Int 42)) (Var "y"))) (Int 7))) (Fun "x" (Sub (Var "x") (Var "y"))))) (Int 3)
-- >>> eval clo emptyEnv
-- VInt 32
eval :: Exp -> Env -> Value
eval expr env = case expr of
  Int i     -> VInt i
  Var x     -> maybe (error (x ++ " : unbound variable")) id (lookupEnv x env)
  Sub e1 e2 -> VInt (i - j)
               where VInt i = eval e1 env
                     VInt j = eval e2 env
  If e1 e2 e3 e4 -> if i <= j then eval e3 env else eval e4 env
                    where VInt i = eval e1 env
                          VInt j = eval e2 env
  Fun x e   -> VClosure x e env
  App e1 e2 -> eval e env''
               where VClosure x e env' = eval e1 env
                     v                 = eval e2 env 
                     env''             = insertEnv x v env'