ラムダ計算プログラムで、ラムダ式を変数に束縛できるようにした。また、出力にラムダ式の内部形式と評価値を両方表示できるようにした。英小文字の 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)
|
カテゴリ
新型コロナウイルス 主インデックス Haskell 記事リスト 圏論記事リスト 考えるということのリスト 考えるということ ラッセルのパラドックス Haskell Prelude Ocaml ボーカロイド 圏論 jQuery デモ HTML Python ツールボックス XAMPP Ruby ubuntu WordPress 脳の話 話のネタ リンク 幸福論 キリスト教 心の話 メモ 電子カルテ Dojo JavaScript C# NetWalker ed と sed HTML Raspberry Pi C 言語 命題論理 以前の記事
最新のトラックバック
最新のコメント
ファン
記事ランキング
ブログジャンル
画像一覧
|
ファン申請 |
||