人気ブログランキング | 話題のタグを見る

ラムダ計算プログラム

ラムダ計算プログラムで、ラムダ式を変数に束縛できるようにした。また、出力にラムダ式の内部形式と評価値を両方表示できるようにした。英小文字の l でラムダ記号を代用することにして、教科書のラムダ式に近い形で入力できる。実行例は次のようになる。ラムダ計算の勉強に便利かもしれない。

$ runghc lambda.hs
lambda> ((lx.x) 2)
Right (App (Abs "x" (Var "x")) (Lit 2))
IntVal 2
lambda> (* (+ 1 2) (+ 3 4))
Right (Mul (Plus (Lit 1) (Lit 2)) (Plus (Lit 3) (Lit 4)))
IntVal 21
lambda> (= a (lx.(+ x x)))
Right (Bind "a" (Abs "x" (Plus (Var "x") (Var "x"))))
lambda> (a 3)
Right (App (Var "a") (Lit 3))
IntVal 6
lambda> (((lx.(x x)) (lx.x)) 2)
Right (App (App (Abs "x" (App (Var "x") (Var "x"))) (Abs "x" (Var "x"))) (Lit 2))
IntVal 2
lambda> quit

ソースコードは次のようになる。

ファイル名:lambda.hs

module Main where

import Control.Monad.Identity
import Control.Monad.Trans

import Data.Maybe
import Data.IORef
import qualified Data.Map as Map

import System.Console.Haskeline
import Text.Parsec

type Name = String

data Exp = Lit Integer
........ | Var Name
........ | Plus Exp Exp
........ | Sub Exp Exp
........ | Mul Exp Exp
........ | Div Exp Exp
........ | Mod Exp Exp
........ | Abs Name Exp
........ | App Exp Exp
........ | Bind Name Exp
........ deriving (Show)
data Value = IntVal Integer
.......... | FunVal Env Name Exp
.......... deriving (Show)

type Env = Map.Map Name Value

eval0 :: Env -> Exp -> Value
eval0 env (Lit i) = IntVal i
eval0 env (Var n) = fromJust (Map.lookup n env)
eval0 env (Plus e1 e2) = let IntVal i1 = eval0 env e1
............................ IntVal i2 = eval0 env e2
........................ in IntVal (i1 + i2)
eval0 env (Sub e1 e2) = let IntVal i1 = eval0 env e1
............................IntVal i2 = eval0 env e2
........................in IntVal (i1 - i2)
eval0 env (Mul e1 e2) = let IntVal i1 = eval0 env e1
............................IntVal i2 = eval0 env e2
........................in IntVal (i1 * i2)
eval0 env (Div e1 e2) = let IntVal i1 = eval0 env e1
............................IntVal i2 = eval0 env e2
........................in IntVal (div i1 i2)
eval0 env (Abs n e) = FunVal env n e
eval0 env (App e1 e2) = let val1 = eval0 env e1
............................val2 = eval0 env e2
........................in case val1 of
............................FunVal env' n body -> eval0 (Map.insert n val2 env') body

exampleExp = Lit 12 `Plus` (App (Abs "x" (Var "x")) (Lit 4 `Plus` Lit 2))

expr :: Parsec String () Exp
expr = lit <|> var <|> plus <|> minus <|> mul <|> divide <|> abstr <|> app <|> bnd
..where
....lit = try (do i <- many1 digit; spaces; return $ Lit ((read :: String -> Integer) i))
....var = try (do x <- many1 letter; spaces; return (Var x))
....plus = try (do string "(+"; spaces; x <- expr; y <- expr; string ")"; spaces; return (Plus x y))
....minus = try (do string "(-"; spaces; x <- expr; y <- expr; string ")"; spaces; return (Sub x y))
....mul = try (do string "(*"; spaces; x <- expr; y <- expr; string ")"; spaces; return (Mul x y))
....divide = try (do string "(div"; spaces; x <- expr; y <- expr; string ")"; spaces; return (Div x y))
....abstr = try (do string "(l"; x <- many1 letter;..string "."; y <- expr; string ")"; spaces; return (Abs x y))
....app = try (do string "("; spaces; x <- expr; y <- expr; string ")"; spaces; return (App x y))
....bnd = try (do string "(="; spaces; x <- many1 letter; spaces; y <- expr; string ")"; spaces; return (Bind x y))

parseExp :: String -> Either ParseError Exp
parseExp input = parse expr "lambda expression" input

main :: IO ()
main = do
..global <- newIORef Map.empty
..runInputT defaultSettings (loop global)
....where
......loop :: (IORef (Map.Map Name Value)) -> InputT IO ()
......loop global = do
........minput <- getInputLine "lambda> "
........case minput of
..........Nothing -> return ()
..........Just "quit" -> return ()
..........Just input -> do
............expression <- return $ parseExp input
............lift $ print expression
............env <- lift $ readIORef global
............case expression of
.............. Right (Bind x e) -> do
................ let val = eval0 env e
................ lift $ writeIORef global (Map.insert x val env)
.............. Right exp -> outputStrLn $ show $ eval0 env exp
.............. Left err -> outputStrLn $ show err
............loop global

by tnomura9 | 2019-08-31 05:30 | Haskell | Comments(0)
<< ラムダ計算プログラム(最終版) 整数計算のラムダ記法プログラム >>