人気ブログランキング |

<   2019年 08月 ( 28 )   > この月の画像一覧

ラムダ計算プログラム

ラムダ計算プログラムで、ラムダ式を変数に束縛できるようにした。また、出力にラムダ式の内部形式と評価値を両方表示できるようにした。英小文字の 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)

整数計算のラムダ記法プログラム

前回のプログラムをトークン間の空白処理をするように変更した。また整数の四則演算も追加した。使い方は次のようになる。

Prelude> :l parseTrans.hs
[1 of 1] Compiling Transformers ( parseTrans.hs, interpreted )
Ok, modules loaded: Transformers.
*Transformers> main
lambda> (* (+ 1 2) (+ 3 4))
IntVal 21
lambda> ((lx.(div x (- 3 1))) 6)
IntVal 3
lambda> quit
*Transformers>

ソースファイルは次のようになる。

ファイル名: parseTrans.hs

module Transformers where

import Control.Monad.Identity

import Data.Maybe
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
........ 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
..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 <- many 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))

parseExp :: String -> String
parseExp input = case (parse expr "SourceName" input) of
....................Right out -> show $ eval0 Map.empty out
....................Left err -> show err

main :: IO ()
main = runInputT defaultSettings loop
..where
....loop :: InputT IO ()
....loop = do
......minput <- getInputLine "lambda> "
......case minput of
........Nothing -> return ()
........Just "quit" -> return ()
........Just input -> do outputStrLn $ parseExp input
........................ loop

by tnomura9 | 2019-08-30 02:41 | Haskell | Comments(0)

最小のラムダ記法プログラム言語

Monad Transformers Step by Step のサンプルプログラムは実際に実行できる最小のプログラム言語だ。これを、Parsec でパースできないかやってみたらできた。ラムダ記号は英小文字の l で代用した。使い方は次のようになる。Scheme のような使い方だ。

$ runghc parseTrans.hs
lambda> ((lx.x) 2)
IntVal 2
lambda> ((lx.(+ x x)) 2)
IntVal 4
lambda> ((lx.((ly.(+ x y)) 2)) 3)
IntVal 5
lambda> quit

プログラムのソースは次のようになる。ファイル名は parseTrans.hs にした。文頭の ... はスペースに置換して使う。

module Transformers where

import Control.Monad.Identity

import Data.Maybe
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
........ | Abs Name Exp
........ | App Exp 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 (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 <|> abstr <|> app
..where
....lit = try (do i <- many1 digit; return $ Lit ((read :: String -> Integer) i))
....var = try (do x <- many1 letter; return (Var x))
....plus = try (do string "(+ "; x <- expr; string " "; y <- expr; string ")"; return (Plus x y))
....abstr = try (do string "(l"; x <- many letter;..string "."; y <- expr; string ")"; return (Abs x y))
....app = try (do string "("; x <- expr; string " "; y <- expr; string ")"; return (App x y))

parseExp :: String -> String
parseExp input = case (parse expr "SourceName" input) of
....................Right out -> show $ eval0 Map.empty out
....................Left err -> show err

main :: IO ()
main = runInputT defaultSettings loop
..where
....loop :: InputT IO ()
....loop = do
......minput <- getInputLine "lambda> "
......case minput of
........Nothing -> return ()
........Just "quit" -> return ()
........Just input -> do outputStrLn $ parseExp input
........................ loop

by tnomura9 | 2019-08-29 01:07 | Haskell | Comments(0)

ラムダ計算のパーサ

Wikiepedia のラムダ計算ではラムダ式の BNF 記法は次のようになっている。

1. <expr> ::= <identifier>
2. <expr> ::= (λ<identifier>. <expr>)
3. <expr> ::= (<expr> <expr>)

そこで Parsec でラムダ式のパーサを作ってみた。ファイル名は lambda.hs にした。ラムダ記号は英小文字の l にした。

module Lambda where

import Text.Parsec

expr :: Parsec String () String
expr = ident <|>
.. try (string "(" <> string "l" <> ident <> string "." <> expr <> string ")") <|>
...... string "(" <> expr <> expr <> string ")"

ident :: Parsec String () String
ident = do x <- letter; return [x]

lambda :: String -> IO ()
lambda input = parseTest expr input

使い方は次のようになる。ラムダ式が機械的にパースされる分、その仕組みが分かりやすい。たった3行の文法でコンピュータで計算できるあらゆるプログラムを記述可能なのだからすごい。(もちろんこのパーサでは構文解析しかできないのでそれはできない。)

Prelude> :l lambda.hs
[1 of 1] Compiling Lambda ( lambda.hs, interpreted )
Ok, one module loaded.
*Lambda> lambda "x"
"x"
*Lambda> lambda "(lx.x)"
"(lx.x)"
*Lambda> lambda "(xy)"
"(xy)"
*Lambda> lambda "(lf.(lx.x))"
"(lf.(lx.x))"
*Lambda> lambda "(lf.(lx.(fx)))"
"(lf.(lx.(fx)))"
*Lambda> lambda "(lf.(lx.(f(fx))))"
"(lf.(lx.(f(fx))))"

Text.Parsec のバージョンによっては <> 演算子が使えないので <> 演算子を使わないプログラムも作ってみた。ファイル名は lambda0.hs にした。<> 演算子の使い勝手が良いのが分かる。

module Lambda where

import Text.Parsec

expr :: Parsec String () String
expr = ident <|> abstraction <|> application
..where
....abstraction = try (do
......x1 <- string "(l"
......x2 <- ident
......x3 <- string "."
......x4 <- expr
......x5 <- string ")"
......return (x1 ++ x2 ++ x3 ++ x4 ++ x5))
....
....application = do
......x1 <- string "("
......x2 <- expr
......x3 <- expr
......x4 <- string ")"
......return (x1 ++ x2 ++ x3 ++ x4)

ident :: Parsec String () String
ident = do x <- letter; return [x]

lambda :: String -> IO ()
lambda input = parseTest expr input

by tnomura9 | 2019-08-28 07:27 | Haskell | Comments(0)

csvParser.hs

GitHub で Parsec を使った CSV パーサ csvParser.hs を見つけた。

import Text.ParserCombinators.Parsec
import System.IO

csvFile = endBy line eol
line = sepBy cell (char ',')
cell = many (noneOf ",\n")
eol = char '\n'

parseCSV :: String -> Either ParseError [[String]]
parseCSV input = parse csvFile "(unknown)" input

main = do
....handle <- openFile "test.csv" ReadMode
....contents <- hGetContents handle
....case parseCSV contents of
........Left x -> print x
........Right results -> print results
....hClose handle

中心部分だけを抜き出すと次のようになる。再帰下降パーサの文法をそのまま並べただけだ。

module CSV where

import Text.Parsec

csvFile = endBy line eol
line = sepBy cell (char ',')
cell = many $ noneOf ",\n"
eol = char '\n'

parseCSV :: String -> Either ParseError [[String]]
parseCSV input = parse csvFile "(unknown)" input

実行例は次のようになる。

Prelude> :l csvParser.hs
[1 of 1] Compiling CSV ( csvParser.hs, interpreted )
Ok, modules loaded: CSV.
*CSV> parseCSV "ab,c d\nef,gh\n"
Right [["ab","c d"],["ef","gh"]]

これは、Data.List.Split モジュールの splitOn 関数を使ってもできる。

Prelude Data.List.Split> map (splitOn ",") $ lines "ab,c d\nef,gh\n"
[["ab","c d"],["ef","gh"]]


by tnomura9 | 2019-08-26 00:00 | Haskell | Comments(0)

Text.Parsec.Combinator

Text.Parsec のソースコード探索も Text.Parsec.Combinator モジュールを調べたら、その心臓部の解析は終わりだ。このモジュールには、たくさんのコンビネータが定義されているが、その殆どは do 記法によるモナドプログラミングだ。したがって、格段に解読が楽になる。ソースコードの解読が楽なので、コンビネータの動作を確認するには文書を読むよりソースコードを読んだほうが良いという逆転現象がおきている。

choice コンビネータ

choice :: (Stream s m t) => [ParsecT s u m a] -> ParsecT s u m a
choice ps = foldr (<|>) mzero ps

choice コンビネータはパーサのリスト ps を引数にとり、先頭からマッチングを行ってマッチングが成功した時点でマッチングの結果を返すパーサを作る。foldr を <|> 演算子に適用しているので、パターンマッチがリストの左端から順に行われる。

Prelude Text.Parsec> parseTest (choice [letter, digit]) "123"
'1'
Prelude Text.Parsec> parseTest (choice [string "foo", string "bar"]) "bar"
"bar"

option コンビネータ

option :: (Stream s m t) => a -> ParsecT s u m a -> ParsecT s u m a
option x p = p <|> return x

option コンビネータは option x p でパーサ p のパターンマッチが失敗したときにデフォールト値 x を返すパーサを作る。

Prelude Text.Parsec> parseTest (option "hello" (string "foo")) "bar"
"hello"

optionMaybe コンビネータ

optionMaybe :: (Stream s m t) => ParsecT s u m a -> ParsecT s u m (Maybe a)
optionMaybe p = option Nothing (liftM Just p)

optionMaybe コンビネータは optionMaybe p でパターンマッチの戻り値を Maybe モナドにラッピングして返す。

Prelude Text.Parsec> parseTest (optionMaybe letter) "123"
Nothing
Prelude Text.Parsec> parseTest (optionMaybe letter) "foo"
Just 'f'

optional コンビネータ

optional :: (Stream s m t) => ParsecT s u m a -> ParsecT s u m ()
optional p = do{ _ <- p; return ()} <|> return ()

optional コンビネータは optional p でパーサ p がパターンマッチを成功してもしなくても () を返すパーサを作る。

Prelude Text.Parsec> parseTest (optional letter) "foo"
()
Prelude Text.Parsec> parseTest (optional letter) "123"
()

パターンマッチが消費を伴う場合消費のみを行うことになる。

Prelude Text.Parsec> parseTest (optional letter *> getInput) "foo"
"oo"

between コンビネータ

between :: (Stream s m t) => ParsecT s u m open -> ParsecT s u m close
............-> ParsecT s u m a -> ParsecT s u m a
between open close p
....................= do{ _ <- open; x <- p; _ <- close; return x }

between コンビネータは between open close p で open パターンと close パターンに挟まれた部分が p パターンにマッチした場合にそれを取り出すパーサを作る。言葉で説明するより、ソースコードを読んだほうが分かりやすい。

Prelude Text.Parsec> parseTest (between (char '{') (char '}') (many letter)) "{foo}"
"foo"

skipMany1 コンビネータ

skipMany1 :: (Stream s m t) => ParsecT s u m a -> ParsecT s u m ()
skipMany1 p........ = do{ _ <- p; skipMany p }

skipMany1 コンビネータは skipMany1 p でパーサ p にマッチする部分を1回以上の繰り返しで読み飛ばすパーサを作る。最初に p パーサのパターンマッチを行った後、skipMany コンビネータでパターン p の0回以上の繰り返しにマッチするパーサを作る。

Prelude Text.Parsec> parseTest (skipMany (char 'a') *> getInput) "aaaaaabc"
"bc"

many1 コンビネータ

many1 :: (Stream s m t) => ParsecT s u m a -> ParsecT s u m [a]
many1 p = do{ x <- p; xs <- many p; return (x:xs) }

many1 コンビネータは many1 p でパターン p の1回以上の繰り返しにマッチするパーサを作る。

Prelude Text.Parsec> parseTest (many1 (char 'a')) "aaaaaabc"
"aaaaaa"

sepBy コンビネータ

sepBy :: (Stream s m t) => ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
sepBy p sep = sepBy1 p sep <|> return []

sepBy コンビネータは sepBy p sep でセパレータ sep で区切られた0個以上の p パターンのリストを返すパーサを作る。内部的に sepBy1 コンビネータを利用している。

Prelude Text.Parsec> parseTest (sepBy (many letter) (char ',')) "foo,bar"
["foo","bar"]

sepBy1 コンビネータ

sepBy1 :: (Stream s m t) => ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
sepBy1 p sep........= do{ x <- p
........................; xs <- many (sep >> p)
........................; return (x:xs)
........................}

sepBy1 コンビネータは sepBy1 p sep でセパレータ sep で区切られた1個以上のパターン p にマッチするものリストを作る。パーサを作る。do 記法で定義されており、最初にパターンマッチを行い、続いて many (sep >> p) でパターンマッチを繰り返している。

Prelude Text.Parsec> parseTest (sepBy1 (many letter) (char ',')) "foo,bar"
["foo","bar"]

sepEndBy1 コンビネータ

sepEndBy1 :: (Stream s m t) => ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
sepEndBy1 p sep.... = do{ x <- p
........................; do{ _ <- sep
............................; xs <- sepEndBy p sep
............................; return (x:xs)
............................}
..........................<|> return [x]
........................}

sepEndBy1 コンビネータは sepEndby1 p sep でパターン p をパターンに続くのセパレータできりわけパターンのリストにして返すパーサを作る。sepEndBy1 コンビネータのプログラムは do 記法で記述されている。最初に p のパターンマッチを行い、その後にセパレータ sp のパターンマッチを行っている。最初のパターンマッチのリターン値 x は sepEndBy1 の recursive case の戻り値 xs と (x:xs) で連結されて return 関数で返される。base case がないが、パターンマッチエラー時の return [x] がその役割を果たしている。

Prelude Text.Parsec> parseTest (sepEndBy1 (many letter) (char ';')) "foo;bar;"
["foo","bar",""]
Prelude Text.Parsec> parseTest (sepEndBy1 (many letter) (char ';')) "foo;bar"
["foo","bar"]

sepEndBy コンビネータ

sepEndBy :: (Stream s m t) => ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
sepEndBy p sep = sepEndBy1 p sep <|> return []

sepEndBy コンビネータは、sepEndBy p sep で最初からパターンマッチが失敗した場合も [] を返すパーサを作る。

Prelude Text.Parsec> parseTest (sepEndBy (many letter) (char ';')) "123"
[""]

endBy1 コンビネータ

endBy1 :: (Stream s m t) => ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
endBy1 p sep........= many1 (do{ x <- p; _ <- sep; return x })

endBy1 コンビネータは endBy1 p sep で末尾を sep で区切られたパターン p を取り出して、配列にして返すパーサを作る。

Prelude Text.Parsec> parseTest (endB1y (many letter) (char ';')) "foo;bar;"
["foo","bar"]

endBy コンビネータ

endBy :: (Stream s m t) => ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
endBy p sep........ = many (do{ x <- p; _ <- sep; return x })

endBy コンビネータは、パターンマッチが1回も起きなかった場合も動作する。

Prelude Text.Parsec> parseTest (endBy (many letter) (char ';')) "123"
[]

count コンビネータ

count :: (Stream s m t) => Int -> ParsecT s u m a -> ParsecT s u m [a]
count n p.......... | n <= 0....= return []
....................| otherwise = sequence (replicate n p)

count コンビネータは count n p でパターン p の n 回の繰り返しにマッチする。ソースコードではパーサ p の n 個の配列を作り、sequence で実行している。

Prelude Text.Parsec> parseTest (count 2 (string "foo")) "foofoobar"
["foo","foo"]

replicate 関数、sequence 関数の動作は次のようになる。

Prelude Text.Parsec> sequence (replicate 3 (putStrLn "hello"))
hello
hello
hello
[(),(),()]

chainl1 :: (Stream s m t) => ParsecT s u m a -> ParsecT s u m (a -> a -> a) -> ParsecT s u m a
chainl1 p op........= do{ x <- p; rest x }
....................where
......................rest x....= do{ f <- op
....................................; y <- p
....................................; rest (f x y)
....................................}
................................<|> return x

chainl1 p op 関数は連続する左結合の2項演算 (1 + 2 + 3 など)の演算をパターンマッチで行うパーサを記述する。chainl1 のパーサ p のリターン値は数値を、op パーサのリターン値は2項演算にする必要がある。演算の繰り返しは rest が再帰関数なので実現できる。

Prelude Text.Parsec> parseTest (chainl1 (do x <- many1 digit; return ((read :: String -> Int) x)) (do char '+'; return (+))) "1+2+3"
6

chainr1 コンビネータ

chainr1 コンビネータは連続する右結合の2項演算 (1^2^3) などの演算をパターンマッチで行うパーサを記述する。chainr1 p op の引数の意味は chainrl のものと同じだが、再帰関数 scan の定義の仕方が異なる。

chainr1 :: (Stream s m t) => ParsecT s u m a -> ParsecT s u m (a -> a -> a) -> ParsecT s u m a
chainr1 p op........= scan
....................where
......................scan......= do{ x <- p; rest x }

......................rest x....= do{ f <- op
....................................; y <- scan
....................................; return (f x y)
....................................}
................................<|> return x

chainl コンビネータ

chainl :: (Stream s m t) => ParsecT s u m a -> ParsecT s u m (a -> a -> a) -> a -> ParsecT s u m a
chainl p op x...... = chainl1 p op <|> return x

chainl コンビネータは chainl1 コンビネータと同じように連続する2項演算の値を計算するが、2項演算がない場合はデフォールト値の x を返す。

Prelude Text.Parsec> parseTest (chainl (do x <- many1 digit; return ((read :: String -> Int) x)) (do char '+'; return (+)) 0) "foo"
0

chainr コンビネータ

chainr :: (Stream s m t) => ParsecT s u m a -> ParsecT s u m (a -> a -> a) -> a -> ParsecT s u m a
chainr p op x...... = chainr1 p op <|> return x

chainr コンビネータは連続する左結合の2項演算に対応しているが、2項演算がないときデフォールト値の x を返す。

anyToken パーサ

anyToken :: (Stream s m t, Show t) => ParsecT s u m t
anyToken............= tokenPrim show (\pos _tok _toks -> pos) Just

anyToken パーサはトークン(文字など)がない状態にマッチする。notFollwedBy コンビネータに利用されている。

Prelude Text.Parsec> parseTest anyToken "hello"
'h'

eof パーサ

eof :: (Stream s m t, Show t) => ParsecT s u m ()
eof................ = notFollowedBy anyToken <?> "end of input"

eof は input の終了にマッチする。

Prelude Text.Parsec> parseTest eof ""
()

notFollowedBy コンビネータ

notFollowedBy :: (Stream s m t, Show a) => ParsecT s u m a -> ParsecT s u m ()
notFollowedBy p.... = try (do{ c <- try p; unexpected (show c) }
.......................... <|> return ()

notoFollowedBy コンビネータは次の input を空読みして、それがパターン p でなければパターンマッチと判断するパーサを作る。

Prelude Text.Parsec> parseTest (notFollowedBy digit) "123"
parse error at (line 1, column 2):
unexpected '1'
Prelude Text.Parsec> parseTest (notFollowedBy letter) "123"
()

manyTill コンビネータ

manyTill :: (Stream s m t) => ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
manyTill p end......= scan
....................where
......................scan..= do{ _ <- end; return [] }
............................<|>
..............................do{ x <- p; xs <- scan; return (x:xs) }

manyTill p コンビネータは manyTill p end で end パターンが来るまでパターン p のマッチングを行うパーサを作る。

Prelude Text.Parsec> parseTest (manyTill letter (char 'Z')) "abcdefZhijk"
"abcdef"

parsarTreace コンビネータ

デバッグ関係の関数で Debug.Trace モジュールの知識がないとわからないので省略。(宿題)

parserTraced コンビネータ

同上

Text.Parsec.Combinator モジュールのコンビネータのソースコードを一通り見てみた。モナドプログラミングで書かれているのでコンビネータの動作を知るためには、Hackage のソースコードを参照するのが一番はやいようだ。

Text.Parsec モジュールを活用するためのソースコード解読はこれで一旦終了とする。何も知らない状態からの解読との同時進行的な記事だったので整理されていないが、力尽きたのでこれでやめる。

by tnomura9 | 2019-08-25 17:21 | Haskell | Comments(0)

継続渡しスタイルプログラミングの例2

Text.Parsec.Prim の継続渡しプログラミングの例の続き。

label コンビネータ

label :: ParsecT s u m a -> String -> ParsecT s u m a
label p msg
.. = labels p [msg]

label コンビネータはパーサ p がパターンマッチに失敗したときのエラーメッセージを第2引数のメッセージで置き換える。プログラムは、エラーメッセージを引数として与えたメッセージのリストと置き換える labels コンビネータを利用している。

Prelude Text.Parsec> parseTest digit "foo"
parse error at (line 1, column 1):
unexpected "f"
expecting digit
Prelude Text.Parsec> parseTest (label digit "bar") "foo"
parse error at (line 1, column 1):
unexpected "f"
expecting bar

labels コンビネータ

labels :: ParsecT s u m a -> [String] -> ParsecT s u m a
labels p msgs =
.... ParsecT $ \s cok cerr eok eerr ->
.... let eok' x s' error = eok x s' $ if errorIsUnknown error
.................. then error
.................. else setExpectErrors error msgs
........ eerr' err = eerr $ setExpectErrors err msgs

.... in unParser p s cok cerr eok' eerr'

. where
... setExpectErrors err []........ = setErrorMessage (Expect "") err
... setExpectErrors err [msg]......= setErrorMessage (Expect msg) err
... setExpectErrors err (msg:msgs)
....... = foldr (\msg' err' -> addErrorMessage (Expect msg') err')
......... (setErrorMessage (Expect msg) err) msgs

labels コンビネータはパーサ p がパターンマッチに失敗したときにエラーメッセージを第2引数で与えるメッセージリストと置き換える。ParsecT s u m a パーサのフィールドの無名関数の body 部分が unParser p s cok cerr eok' eerr' になっている。パターンマッチの結果が cok と cerr の場合はパーサ p の結果をそのまま返すが、eok と eerr のときはパターンマッチの結果が eok と eerr ではなく eok' と eerr' に渡される。どちらもパーサ p から返されるパラメータの err を引数として与えたメッセージリストに置き換えている。このことから labels コンビネータはパーサ p から継続に渡されるデータが Empty のときだけ p の動作を変えることが分かる。

Prelude Text.Parsec> parseTest (labels digit ["foo", "bar", "baz"]) "hello"
parse error at (line 1, column 1):
unexpected "h"
expecting bar, baz or foo

Prelude Text.Parsec> parseTest (labels (string "hi") ["foo", "bar", "baz"]) "hello"
parse error at (line 1, column 1):
unexpected "e"
expecting "hi"

try コンビネータ

try :: ParsecT s u m a -> ParsecT s u m a
try p =
.... ParsecT $ \s cok _ eok eerr ->
.... unParser p s cok eerr eok eerr

try コンビネータは引数のパーサ p のパターンマッチの結果が cerr のときのみパラメータを eerr 継続に渡す。cerr の行動を eerr の行動に置き換えることになる。eerr に渡されるパーサ状態はパーサ p のパターンマッチの前の s なので、パーサ位置が変わらず、入力文字列の消費が起きない。

Prelude Text.Parsec> parseTest (string "hi") "hello"
parse error at (line 1, column 1):
unexpected "e"
expecting "hi"

Prelude Text.Parsec> parseTest (try (string "hi")) "hello"
parse error at (line 1, column 1):
unexpected "e"
expecting "hi"

Prelude Text.Parsec> parseTest (string "hi" <|> string "hello") "hello"
parse error at (line 1, column 1):
unexpected "e"
expecting "hi"

Prelude Text.Parsec> parseTest (try (string "hi") <|> string "hello") "hello"
"hello"

lookAhead コンビネータ

lookAhead :: (Stream s m t) => ParsecT s u m a -> ParsecT s u m a
lookAhead p =
....ParsecT $ \s _ cerr eok eerr -> do
........let eok' a _ _ = eok a s (newErrorUnknown (statePos s))
........unParser p s eok' cerr eok' eerr

lookAhead コンビネータでは unParser p s eok' cerr eok' eerr だから、パーサ p のパターンマッチが失敗した場合はパーサ p の cerr eerr 継続がそのまま使われる。cok eok の場合はどちらも eok' 継続が使われる。eok に渡されるパラメータはパーサ状態はパーサ p によるパターンマッチが行われる前のパーサ状態 s でエラーメッセージは UnknownError になる。

Prelude Text.Parsec> parseTest (string "foo" *> getPosition) "foo bar"
(line 1, column 4)
Prelude Text.Parsec> parseTest (lookAhead (string "foo") *> getPosition) "foo bar"
(line 1, column 1)

manyAccum コンビネータ

manyAccum :: (a -> [a] -> [a])
..........-> ParsecT s u m a
..........-> ParsecT s u m [a]
manyAccum acc p =
....ParsecT $ \s cok cerr eok _eerr ->
....let walk xs x s' _err =
............unParser p s'
..............(seq xs $ walk $ acc x xs)..-- consumed-ok
..............cerr........................-- consumed-err
..............manyErr.................... -- empty-ok
..............(\e -> cok (acc x xs) s' e) -- empty-err
....in unParser p s (walk []) cerr manyErr (\e -> eok [] s e)

manyErr :: a
manyErr = error "Text.ParserCombinators.Parsec.Prim.many: combinator 'many' is applied to a parser that accepts an empty string."

manyAccum コンビネータはパーサ p が消費マッチする間、パーサ p のパターンマッチを繰り返す。manyAccum acc p で作られるパーサのフィールドの関数の body 部分が unParser p s (walk []) cerr manyErr (e->eok[] s e) なので、パーサ p でパターンマッチした結果が ConsumedOK の場合はパラメータが eok ではなく walk [] に渡される。walk xs x s' _eerr 関数はパターン p の ConsumedOk マッチが繰り返される間再帰的に呼び出されその戻り値の集積が xs に積まれる。最後に EmptyErro になったときパラメータが (\e -> eok (acc x xs) s' e) に渡されて xs の値が eok に戻される。

Prelude Text.Parsec> parseTest (manyAccum (:) letter) "foo bar"
"oof"

"foo" が逆順になっているが、再帰呼出しの結果だ。

この manyAccum を使って、many コンビネータと skipMany コンビネータは定義されている。

many :: ParsecT s u m a -> ParsecT s u m [a]
many p
..= do xs <- manyAccum (:) p
...... return (reverse xs)

skipMany :: ParsecT s u m a -> ParsecT s u m ()
skipMany p
..= do _ <- manyAccum (\_ _ -> []) p
...... return ()

manyAccum acc p の戻り値は ParsecT s u m a モナドなので many と skipMany は do 記法でプログラムできる。実行例は次のようになる。

Prelude Text.Parsec> parseTest (many letter) "hello, world"
"hello"

Prelude Text.Parsec> parseTest (skipMany letter *> getInput) "hello, world"
", world"

updateParserState コンビネータ

updateParserState :: (State s u -> State s u) -> ParsecT s u m (State s u)
updateParserState f =
....ParsecT $ \s _ _ eok _ ->
....let s' = f s
....in eok s' s' $ unknownError s'

updateParserState コンビネータはパーサ状態に関数を適用する。パーサの状態に f を関数適用しそれを eok 継続に渡すだけの動作だ。これを利用して、getParserState, getInput などがプログラムされている。

getParserState :: (Monad m) => ParsecT s u m (State s u)
getParserState = updateParserState id

getInput :: (Monad m) => ParsecT s u m s
getInput = do state <- getParserSta
..............return (stateInput state)

getInput の実行例は次のようになる。

Prelude Text.Parsec> parseTest (getInput) "hello, world"
"hello, world"

Text.Parsec.Prim で使われている継続渡しスタイルプログラミングはこれで全部だ。その他のコンビネータは、コンビネータの戻り値が Parsec s u m a モナドであることを利用して、do 記法でプログラムされている。

継続渡しスタイルプログラミングとひとくくりにすると抽象的でわかりにくいが、要するに、パーサ p は条件の判断と分岐だけを行う抽象的な関数であり、分岐後の処理は、継続(関数)をプログラムすることによって実動するプログラムを作っていくというやり方のようだ。

by tnomura9 | 2019-08-23 07:43 | Haskell | Comments(0)

継続渡しスタイルプログラミングの例

Text.Parsec.Prim モジュールのコンビネータプログラムは、継続渡しスタイルプログラミングでプログラムされている。ParsecT s u m パーサのフィールドの関数が継続渡しスタイルの関数なので、パーサを引数にとり新しいパーサを作るコンビネータのプログラムは、パーサに渡す継続(関数)をプログラムすることで行われる。

継続をプログラムすることで複雑な動作がプログラム可能なのは、parserBind 関数のプログラムが全て継続(関数)のプログラムで行われていることでも分かる。m >>= k のように、パーサ m のパタンマッチの結果をモナド関数 k に渡し、そのリターン値 x を使って (k x) パーサのパターンマッチを行うのも、全て継続をプログラムすることによって実現している。

このように Text.Parsec.Prim モジュールのコンビネータがどのように継続渡しプログラミングスタイルを活用しているかを調べてみた。

unexpected コンビネータ

unexpected :: (Stream s m t) => String -> ParsecT s u m a
unexpected msg
.... = ParsecT $ \s _ _ _ eerr ->
...... eerr $ newErrorMessage (UnExpect msg) (statePos s)

unexpected コンビネータは、引数に State s u m a パーサはとらない。メッセージの文字列を引数にとり、Unexpected エラーメッセージとして返すエラー処理パーサを作る。unexpected コンビネータの作るパーサは err 継続のみを使用し、err に Unexpceted エラーメッセージを渡す。実際の動作は次のようになる。

Prelude> :m Text.Parsec
Prelude Text.Parsec> parseTest (unexpected "hello") "world"
parse error at (line 1, column 1):
unexpected hello

parsecMap コンビネータ

parsecMap :: (a -> b) -> ParsecT s u m a -> ParsecT s u m b
parsecMap f p
.... = ParsecT $ \s cok cerr eok eerr ->
...... unParser p s (cok . f) cerr (eok . f) eerr

parserMap コンビネータは ParsecT s u m モナドの Functor クラスの fmap 関数の本体だ。引数にリターン値を加工する関数 f とパーサ p を取り、パターンマッチが成功した場合に使われる cok と cok 継続を、(cok . f) と (eok . f) に変更している。このため、parserMap コンビネータを適用されたモナドのリターン値は (f x) になる。

Prelude Text.Parsec> parseTest (parsecMap ("hello, " ++) (string "foo")) "foo bar"
"hello, foo"

parserReturn コンビネータ

parserReturn :: a -> ParsecT s u m a
parserReturn x
.... = ParsecT $ \s _ _ eok _ ->
...... eok x s (unknownError s)

Parsec s u m モナドの return 関数の本体だ。引数にモナドのリターン値のみをとる。継続のうち eok だけを用いて、eok 継続にリターン値 x とパーサ状態 s と unknownError エラーを返す。

Prelude Text.Parsec> parseTest (parserReturn "hello") "world"
"hello"

parserBind コンビネータ

parserBind :: ParsecT s u m a -> (a -> ParsecT s u m b) -> ParsecT s u m b
parserBind m k
.. = ParsecT $ \s cok cerr eok eerr ->
.... let
........ mcok x s err =
............ let
................ pcok = cok
................ pcerr = cerr
................ peok x s err' = cok x s (mergeError err err')
................ peerr err' = cerr (mergeError err err')
............ in..unParser (k x) s pcok pcerr peok peerr
........ meok x s err =
............ let
................ pcok = cok
................ peok x s err' = eok x s (mergeError err err')
................ pcerr = cerr
................ peerr err' = eerr (mergeError err err')
............ in..unParser (k x) s pcok pcerr peok peerr
........ mcerr = cerr
........ meerr = eerr

.... in unParser m s mcok mcerr meok meerr

ParsecT s u m モナドの >>= 演算子の本体。parserBind 関数については動作が複雑なのと以前の記事でも調べたので読解を省略するが、全て継続のプログラムのみで記述されている。

Prelude Text.Parsec> parseTest (parserBind (string "hello") (\x -> return (x ++ ", world"))) "hello"
"hello, world"

parserFail コンビネータ

parserFail :: String -> ParsecT s u m a
parserFail msg
.... = ParsecT $ \s _ _ _ eerr ->
...... eerr $ newErrorMessage (Message msg) (statePos s)

unexpected コンビネータと同じくエラー終了するパーサを作る。err 継続のみが使われている。eerrr 継続に渡されるエラーは Message 型である。

Prelude Text.Parsec> parseTest (parserFail "hello, world") "foo"
parse error at (line 1, column 1):
hello, world

parserZero コンビネータ

parserZero :: ParsecT s u m a
parserZero
.... = ParsecT $ \s _ _ _ eerr ->
...... eerr $ unknownError s

unexpected コンビネータと同じくエラー終了するパーサを作る。eerr 継続のみが使われている。eerr 継続に渡されるエラーは unknown エラーである。

Prelude Text.Parsec> parseTest (parserZero) "hello"
parse error at (line 1, column 1):unknown parse error

parserPlus コンビネータ

parserPlus m n
.... = ParsecT $ \s cok cerr eok eerr ->
...... let
.......... meerr err =
.............. let
.................. neok y s' err' = eok y s' (mergeError err err')
.................. neerr err' = eerr $ mergeError err err'
.............. in unParser n s cok cerr neok neerrs
...... in unParser m s cok cerr eok meerr

ParsecT s u m モナドの MonadPlus クラスの演算子 <|> の本体。m パーサのパターンマッチが失敗したときだけ n パーサのパターンマッチが行われる。

unParser m s cok cerr eok merr でパターンマッチが行われ。eerr 以外の継続ではそのまま終了するが、eerr が発生したときは、パラメータが meerr に渡される。

merr では unParser n s cok cerr neok neerr でパーサ n のパターンマッチが行われ、eok と eerr 継続が利用される場合に merr と meerr へパラメータが渡される。渡されるパラメータは m パーサと n パーサのパターマッチエラーを合成したものだ。

Prelude Text.Parsec> parseTest (parserPlus (string "foo") (string "bar")) "foo"
"foo"
Prelude Text.Parsec> parseTest (parserPlus (string "foo") (string "bar")) "bar"
"bar"
Prelude Text.Parsec> parseTest (parserPlus (string "foo") (string "bar")) "quux"
parse error at (line 1, column 1):
unexpected "q"
expecting "foo" or "bar"

Text.Parsec.Prim の継続渡しスタイルで記述されたコンビネータはまだまだ続くが今回はここまでにする。

by tnomura9 | 2019-08-21 02:18 | Haskell | Comments(0)

継続渡しスタイルプログラミングの考え方

ParsecT s u m a 型モナド p の構造は次のようになっている。

p = ParsecT { unParser = \s cok cerr eok eerr -> some body function }

このとき、モナド p のフィールドのデータは unParser アクセサで呼び出すことができるので、

unParser p = \s cok cerr eok eerr -> some body function

だ。したがって、パーサ p の働きは上の右辺の無名関数が担っていることになる。この関数がどのような働きをするのかを理解すれば Text.Parsec.Prim モジュールのいろいろなプログラムの意味が分かる。関数の性質を調べるには、引数の性質を調べるのがよい。この関数の引数はパーサ状態 s と継続 cok eerr eok eerr の5つからなっている。まず、パーサ状態 s についてだが、そのデータ構造は次のようになっている。

data State s u = State {
......stateInput :: s,
......statePos.. :: !SourcePos,
......stateUser..:: !u
....}

stateInpu フィールドのデータはユーザが与える入力の文字列だ。また、statePos はパーサがパターンマッチを行う位置の情報だ。更に stateUser はユーザ用の状態だ。したがって、パーサ p はこのパーサ状態に対しパターンマッチのテストを行い、その結果によって処理した情報、新しいパーサ位置、ユーザ状態などのデータを返すことになる。

また、この関数の残り4つの引数の値は関数だ。したがってパーサの無名関数は高階関数である。これらの関数はパーサの関数によってパラメータを与えられて呼び出される。パターンマッチの処理の条件分岐によってその後の処理のためにこれらの関数が呼び出されるため、これらの関数は分岐後の処理を担当する「継続」関数である。どの関数が使われるかはパーサの条件分岐にの結果によってパーサ関数の中でプログラムされている。このような形式のプログラムを、継続渡しスタイルプログミングという。

したがって、パーサ関数は、パーサ状態に対してパターンマッチのテストを行い、その条件分岐の結果によって継続の関数に処理を委嘱するという抽象的な動作をする。言い換えると、パーサ関数とは条件のテストと分岐という抽象的な動作のみを行う関数だ。

このようなプログラムの設計のため、パーサ関数のパターンマッチが具体的な値を返すためには、cok cerr eok eerr という継続の変数に外部のプログラムから実引数である関数を渡さなければならない。その継続の実体の関数を渡す働きをしているのが runParsecT 関数で、次のように定義されている。

runParsecT p s = unParser p s cok cerr eok eerr
....where cok a s' err = return . Consumed . return $ Ok a s' err
..........cerr err = return . Consumed . return $ Error err
..........eok a s' err = return . Empty . return $ Ok a s' err
..........eerr err = return . Empty . return $ Error err

この定義で注目すべきは、cok などの継続がどのような引数をとっているかということだ。そこだけを抜き出すと次のようになる。

cok a s' err
cerr err
eok a s' err
eerr err

これらの関数の引数のうち a はリターン値だ。たとえば string "hello" というパターンマッチが成功すれば a = "hello" だ。s’ はパターンマッチの結果として変化したパーサ状態だ。パーサプログラムではパターンマッチが成功した場合に入力文字の先頭からマッチした文字列を消去して次のパターンマッチに備える動作をすることがあり、これを「消費」という。パターンマッチの際にこの消費が行われた場合パターン状態が変化するのでその変化後のパーサ状態が s' だ。err はここでは詳しくは述べないが、パーサ関数で作成する ParseError 型のマッチエラー情報だ。

上の関数の引数をよく見ると、cok と eok は a s' err を受け取るが、cerr と eerr は err のみだ。これはパターンマッチエラーが発生したらそこで処理が中断するので、cerr と eerr は err 情報のみが必要なのである。

パーサ関数の継続は、このように外部から与えられるので、外部から与える継続のプログラムを変えることで、パーサ p には全く手を入れることなくパターンマッチ後の動作をプログラムすることができる。継続渡しスタイルのプログラムは、したがって、引数に渡す継続をプログラムするという形式になるものが多い。

例えば parserRetun 関数は引数の値を ParsecT s u m モナドにラッピングして返すだけの関数だが、次のように定義されている。

parserReturn x = ParsecT $ \s _ _ eok _ -> eok x s (unknownError s)

継続の引数は eok だけしか受け取らずあとは無視するが、それは parserRetun 関数では文字列の消費もなく、また、パターンマッチエラーも発生しないからだ。したがって、この場合のパーサ関数の戻り値は eok x s (unknownError s) になる。parserReturn 関数は ParsecT s u m モナドの return 関数の実体である。

parserBind 関数は ParsecT s u m モナドの >>= 演算子の実体だが次のように、継続のプログラムのみで定義されている。

parserBind m k
..= ParsecT $ \s cok cerr eok eerr ->
....let
........ mcok x s err =
............let
................ pcok = cok
................ pcerr = cerr
................ peok x s err' = cok x s (mergeError err err')
................ peerr err' = cerr (mergeError err err')
............in..unParser (k x) s pcok pcerr peok peerr
........meok x s err =
............let
................pcok = cok
................peok x s err' = eok x s (mergeError err err')
................pcerr = cerr
................peerr err' = eerr (mergeError err err')
............in..unParser (k x) s pcok pcerr peok peerr
........mcerr = cerr
........meerr = eerr
....in unParser m s mcok mcerr meok meerr

parserBind については、このブログの以前の記事で詳しく調べたのでここでは述べないが大体の処理の流れを概観すると次のようになる。

1. m >>= k に対し最初に unParser m s mcok mcerr meok meer が実行される。これはパーサ m のパターンマッチが行われその結果が mcok mcerr meok meer のどれかに引き継がれることを示している。

2.例えばパターンマッチが成功し、文字列の消費がおこり、状態が変化した場合のことを考える。このときは mcok に a s' u が渡されるが、mcok = unParser (k x) s pcok pcerr peok peerr であるから、パーサ (k x) のパターンマッチが行われる。(k x) はモナド m のリターン値 x がモナド関数 k に渡され、(k x) というモナドが得られることを示している。モナド (k x) のパターンマッチの結果はその条件分岐によって pcok pcerr peok peerr のどれかに渡され、m >>= k の最終結果が計算されることになる。

3.m パーサと (k x) パーサの起こり得るマッチングの結果は 4 × 4 = 16 通りになるが、上のプログラムはその全ての場合について継続のプログラムのみで対応している。したがって、このプログラムは m と k がどのような値であっても動作する汎用のプログラムである。

継続渡しスタイルのプログラムは、条件分岐のみをプログラムした抽象的プログラムであることが分かれば、その他のパーサコンビネータのソースコードの解読が楽になる。次回からは、Text.Parsec.Prim モジュールに現れたそのような継続渡しプログラムの解読を個々の例についてやってみる。

by tnomura9 | 2019-08-19 06:44 | Haskell | Comments(0)

Text.Parsec.Prim: <?> のソースコード

Text.Parsec.Prim の <?> コンビネータのソースコードは次のようになる。

(<?>) :: (ParsecT s u m a) -> String -> (ParsecT s u m a)
p <?> msg = label p msg

-- | A synonym for @\<?>@, but as a function instead of an operator.
label :: ParsecT s u m a -> String -> ParsecT s u m a
label p msg
.. = labels p [msg]

labels :: ParsecT s u m a -> [String] -> ParsecT s u m a
labels p msgs =
.... ParsecT $ \s cok cerr eok eerr ->
.... let eok' x s' error = eok x s' $ if errorIsUnknown error
.................. then error
.................. else setExpectErrors error msgs
........ eerr' err = eerr $ setExpectErrors err msgs

.... in unParser p s cok cerr eok' eerr'

. where
.. setExpectErrors err [] = setErrorMessage (Expect "") err
.. setExpectErrors err [msg] = setErrorMessage (Expect msg) err
.. setExpectErrors err (msg:msgs)
...... = foldr (\msg' err' -> addErrorMessage (Expect msg') err')
........ (setErrorMessage (Expect msg) err) msgs

<?> コンビネータが label 関数の中置記法であることがつぎのコードから分かる。

p <?> msg = label p msg

また、label 関数は labels 関数を利用している。labels 関数の第2引数に [msg] シングルトンリストを与えるだけだ。

label p msg = labels p [msg]

labels 関数のソースコードをトップダウンで見ると次のようになる。

labels p msgs = ParsecT $ \s cok cerr eok eerr -> unParser p s cok cerr eok' eerr'

ParsecT のフィールドの無名関数の body の部分を抜き出すと、

unParser p s cok cerr eok' eerr'

unPerser p はパーサ p のフィールドの無名関数だから、上の関数はそれにパーサ状態 s と継続 cok cerr eok' eerr' が与えられる。eok', eerr' が let 句で定義されているので、パーサ p のマッチングの結果が Empty Ok のときと、Empty Error のときだけ継続の処理が変わるのが分かる。cok cerr はそのままなので、パーサ p のマッチングの結果が Consumed OK と Consumed Error のときはパーサ p の結果がそのまま返されることが分かる。

eok' のコードは次のようになる。パーサ p のマッチの結果は x s' error が eok' に返される。error がエラーメッセージのない Unkown エラーの場合はそのまま error をかえし、そうでないときは setExpectError error msgs で error のエラーメッセージをエラーメッセージリストの msg で置き換える。x と s' はそのまま eok に渡される。

eok' x s' error = eok x s' $ if errorIsUnknown error
............. then error
............. else setExpectErrors error msgs

eerr' のコードは次のようになる。eerr に setExpectErrors err msgs でエラーメッセージを書き換えた ParseError を渡す。

eerr' err = eerr $ setExpectErrors err msgs

ParseError 型の error のメッセージを書き換える setExpectErrors 関数は次のようになる。パターンを使った定義で、第2引数のメッセージリストが空リスト [] の場合とシングルトンリスト [msg] と要素が2つ以上のリスト (msg:msgs) の3つの場合について定義されている。複数の要素の処理には foldr 畳み込みが使われている。

.. setExpectErrors err [] = setErrorMessage (Expect "") err
.. setExpectErrors err [msg] = setErrorMessage (Expect msg) err
.. setExpectErrors err (msg:msgs)
...... = foldr (\msg' err' -> addErrorMessage (Expect msg') err')
........ (setErrorMessage (Expect msg) err) msgs

ParsecT 関連のプログラムは、トップダウンに調べて、また、継続の変化に注意して読むと分かりやすい。


by tnomura9 | 2019-08-17 01:40 | Haskell | Comments(0)