「関数型プログラミング言語の定義＆実装の仕方の例」をHaskellで実装してみた ref: http://qiita.com/nobsun/items/5a88d37745e8d89a154a

AbstractSyntax.hs

module AbstractSyntax where

-- |
-- 構文
--
data Exp = Int Integer
         | Var String
         | Sub Exp Exp
         | If Exp Exp Exp Exp
         | Fun String Exp
         | App Exp Exp
           deriving (Eq,Show)

Evaluator.hs

module Evaluator where

import AbstractSyntax
-- |
-- 評価器
--
-- プログラム例1：たしざん
-- >>> let one_plus_two = Sub (Int 1) (Sub (Int 0) (Int 2))
-- >>> eval one_plus_two
-- Int 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
-- Int 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
-- Int 50005000
eval :: Exp -> Exp
eval e = case e of
  Int _     -> e
  Sub e1 e2 -> Int (i-j)
    where
      Int i = eval e1
      Int j = eval e2
  If e1 e2 e3 e4 -> if i <= j then eval e3 else eval e4
    where
      Int i = eval e1
      Int j = eval e2
  Fun _ _   -> e
  App e1 e2 -> case eval e1 of
    Fun x e3 -> case eval e2 of
      v    -> eval e'
        where  
          e' = subst e3 x v

-- |
-- 代入
--
subst :: Exp -> String -> Exp -> Exp
subst e x v = case e of
  Int _                -> e
  Var y | x == y       -> v
        | otherwise    -> e
  Sub e1 e2            -> Sub (subst e1 x v) (subst e2 x v)
  If e1 e2 e3 e4       -> If (subst e1 x v) (subst e2 x v) (subst e3 x v) (subst e4 x v)
  Fun y e1 | x == y    -> e
           | otherwise -> Fun y (subst e1 x v)
  App e1 e2            -> App (subst e1 x v) (subst e2 x v)