前回のラムダ計算プログラムで評価エラーのときはプログラムがストップしていたのを、エラーメッセージを表示して継続するように変更した。疲れたのでこれが最終版。コマンドラインからインタラクティブに自作のプログラムをコントロールする手順がわかったような気がする。次の4段階に区分してプログラムを作るとよいようだ。 1.自作プログラム言語のモデルを作る。本プログラムの Exp データ構造がそれに当たる。記号論で言う構文論だ。 2.モデルの評価プログラムを作る。本プログラムの eval 関数。記号論で言う意味論。 3.入力のインターフェースとしてパーサを作る。これに Parsec を使う。パーサは意外に出番が多い。 4.コマンドライン編集ができるように System.Console.Haskeline を利用する。コマンドラインでの入力の編集は必須。 この4つの層は結合がゆるいので、モジュールに分離してモジュラーなプログラムにすることができる。つまりそれぞれの層のプログラムを再利用可能であるということだ。 自作のプログラムを作ったときに各機能をコマンドラインで結合して使いたいときがよくある。上の4つの層をもつプログラムをひとつ作ってみれば、そのようなときに使いまわしが可能なような気がする。 最終盤は lambda2.hs という名前のファイルに作成した。一本のプログラムにせずにモジュールにすればよかったかもしれない。デバッグが随分楽になる。プログラムの使い方は次のようになる。ラムダ記号は l (小文字のl)で代用している。ラムダ抽象とボディの部分はコロンで区切る。また、式は必ず括弧でくくる。 $ runghc lambda2.hs lambda> (* (+ 1 2) (+ 3 4)) Right (Mul (Plus (Lit 1) (Lit 2)) (Plus (Lit 3) (Lit 4))) IntVal 21 lambda> (= f (lx.(+ x x))) Right (Bind "f" (Abs "x" (Plus (Var "x") (Var "x")))) lambda> (f 3) Right (App (Var "f") (Lit 3)) IntVal 6 lambda> ((lx.(x x)) (lx.x)) Right (App (Abs "x" (App (Var "x") (Var "x"))) (Abs "x" (Var "x"))) FunVal (fromList [("f",FunVal (fromList []) "x" (Plus (Var "x") (Var "x")))]) "x" (Var "x") 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 ソースは次のようになる。 ファイル名:lambda2.hs module Transformers where
import Control.Monad.Identity import Control.Monad.Except import Control.Monad.Reader import Control.Monad.State import Control.Monad.Writer 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 type Eval2 a = ExceptT String Identity a runEval2 :: Eval2 a -> Either String a runEval2 ev = runIdentity (runExceptT ev) eval2..................:: Env -> Exp -> Eval2 Value eval2 env (Lit i)......= return $ IntVal i eval2 env (Var n)......= case Map.lookup n env of .......................... Nothing -> throwError ("unbound variable: " ++ n) .......................... Just val -> return val eval2 env (Plus e1 e2) = do e1' <- eval2 env e1 ............................e2' <- eval2 env e2 ............................case (e1', e2') of ..............................(IntVal i1, IntVal i2) -> ................................ return $ IntVal (i1 + i2) .............................._ -> throwError "type error in addition" eval2 env (Sub e1 e2) = do e1' <- eval2 env e1 .......................... e2' <- eval2 env e2 .......................... case (e1', e2') of ..............................(IntVal i1, IntVal i2) -> ................................ return $ IntVal (i1 - i2) .............................._ -> throwError "type error in subtraction" eval2 env (Mul e1 e2) = do e1' <- eval2 env e1 .......................... e2' <- eval2 env e2 .......................... case (e1', e2') of ..............................(IntVal i1, IntVal i2) -> ................................ return $ IntVal (i1 * i2) .............................._ -> throwError "type error in multiplication" eval2 env (Div e1 e2) = do e1' <- eval2 env e1 .......................... e2' <- eval2 env e2 .......................... case (e1', e2') of ..............................(IntVal i1, IntVal i2) -> ................................ return $ IntVal (i1 + i2) .............................._ -> throwError "type error in division" eval2 env (Abs n e)....= return $ FunVal env n e eval2 env (App e1 e2)..= do val1 <- eval2 env e1 ............................val2 <- eval2 env e2 ............................case val1 of ..............................FunVal env' n body -> ................................eval2 (Map.insert n val2 env') body .............................._ -> throwError "type error in application" 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 $ putStrLn (show expression) ............env <- lift $ readIORef global ............case expression of .............. Right (Bind x e) -> do ................ let Right val = runEval2 (eval2 env e) ................ lift $ writeIORef global (Map.insert x val env) .............. Right exp -> let val = runEval2 (eval2 env exp) ............................in case val of .............................. Right value -> ................................ outputStrLn $ show value .............................. Left err -> ................................ outputStrLn $ show err .............. Left err -> outputStrLn $ show err ............loop global
by tnomura9
| 2019-09-01 00:00
| Haskell
|
Comments(0)
|
カテゴリ
新型コロナウイルス 主インデックス Haskell 記事リスト 圏論記事リスト 考えるということのリスト 考えるということ ラッセルのパラドックス Haskell Prelude Ocaml ボーカロイド 圏論 jQuery デモ HTML Python ツールボックス XAMPP Ruby ubuntu WordPress 脳の話 話のネタ リンク 幸福論 キリスト教 心の話 メモ 電子カルテ Dojo JavaScript C# NetWalker ed と sed HTML Raspberry Pi C 言語 命題論理 以前の記事
最新のトラックバック
最新のコメント
ファン
記事ランキング
ブログジャンル
画像一覧
|
ファン申請 |
||