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

Environment.hs

module Environment where

import Value

-- |
-- 環境
--
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

EvaluatorEnv.hs

module EvaluatorEnv where

import Data.List
import AbstractSyntax
import Value
import Environment

-- |
-- 評価器
-- プログラム例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   -> VFun (\ a -> eval e (insertEnv x a env))
  App e1 e2 -> f v
               where VFun f = eval e1 env
                     v      = eval e2 env 

Value.hs

module Value where

data Value = VInt Integer
           | VFun (Value -> Value)

instance Show Value where
  show (VInt i) = "VInt: " ++ show i
  show (VFun _) = "VFun: <function>"