feature image

2023年9月5日 | ブログ記事

Haskellでパーサコンビネータ

Haskell 構文解析 パーサコンビネータ 夏のブログリレー
season1618 icon season1618

2023年夏のブログリレー16日目の記事です。

学部3年のseasonです。最近は将来のこと考えたくなくてずっと小説読んだりアニメ見たりしてます。

パーサコンビネータとは

パーサを文字列(トークン列)から構文木への関数と見ると、部品となる単純なパーサを合成して複雑なパーサを作ることができます。このような仕組みをパーサコンビネータと言います。

Haskellでパーサコンビネータを作ってみます。コンパイラはGHC9.0.1です。

簡単な書き方

一文字パーサ

Haskellの関数は純粋なので、解析対象の文字列を引数に取り、結果と残りの文字列を返すことになります。失敗したらエラーメッセージを返します。

type Parser a = String -> Either String (a, String)

disp :: Show a => Either String (a, String) -> IO ()
disp (Right (res, _)) = print res
disp (Left err) = print $ "error: " ++ err

文字を一つだけパースする関数は以下のようになります。

anyChar :: Parser Char
anyChar (x:xs) = Right (x, xs)
anyChar _ = Left "empty string"

main :: IO ()
main = do
    disp $ anyChar "abc" -- 'a'
    disp $ anyChar ""    -- "error: empty string"

数字やアルファベットを一つだけパースする関数も同様。

digit :: Parser Char
digit (x:xs) | isDigit x = Right (x, xs)
digit _ = Left "expect digit"

letter :: Parser Char
letter (x:xs) | isLetter x = Right (x, xs)
letter _ = Left "expect letter"

連結

S = A B C ...

という文脈自由文法があったとき、Sのパーサはどのようになるでしょうか。

右辺の全てのパーサが受理したときに限り左辺のパーサも受理となります。aのパーサのリストを取り、aのリストのパーサを返します。Eitherモナドを<-で取り出すようにすると、失敗した時点でその値が返ります。

sequence' :: [Parser a] -> Parser [a]
sequence' [] s = Right ([], s)
sequence' (p:ps) s = do
    (x, s') <- p s
    (xs, s'') <- sequence' ps s'
    Right (x:xs, s'')

main :: IO ()
main = do
    disp $ sequence' [letter, digit] "a23" -- "a2"
    disp $ sequence' [letter, digit] "ab3" -- "error: expect digit"

繰り返し

0回以上の繰り返し

S = A*

aのパーサを取り、aのリストのパーサを返します。エラーが出た時点で空文字列を返すのでエラーは返しません。

many :: Parser a -> Parser [a]
many p s = case p s of
    Left _ -> Right ([], s)
    Right (x, s') -> case many p s' of
        Right (xs, s'') -> Right (x:xs, s'')

main :: IO ()
main = do
    disp $ many digit "123" -- "123"
    disp $ many digit "abc" -- ""

1回以上の繰り返し

S = A A*

many1 :: Parser a -> Parser [a]
many1 p s = do
    (x, s') <- p s
    (xs, s'') <- many p s'
    Right (x:xs, s'')

main :: IO ()
main = do
    disp $ many digit "123" -- "123"
    disp $ many digit "abc" -- "error: expect digit"

選択

選択

S = A | B

2つのパーサを取り、どちらかを受理するパーサを返します。

(<|>) :: Parser a -> Parser a -> Parser a
(p1 <|> p2) s = (p1 s) <|> (p2 s) where
    Left a <|> Left b = Left $ a ++ " or " ++ b
    Left _ <|> b = b
    a <|> _ = a

main :: IO ()
main = do
    disp $ (digit <|> letter) "a23" -- 'a'
    disp $ (digit <|> letter) "123" -- '1'
    disp $ (digit <|> letter) ""    -- "error: expect digit or expect letter"

全体のコード

import Data.Char

type Parser a = String -> Either String (a, String)

disp :: Show a => Either String (a, String) -> IO ()
disp (Right (res, _)) = print res
disp (Left err) = print $ "error: " ++ err

sequence' :: [Parser a] -> Parser [a]
sequence' [] s = Right ([], s)
sequence' (p:ps) s = do
    (x, s') <- p s
    (xs, s'') <- sequence' ps s'
    Right (x:xs, s'')

many :: Parser a -> Parser [a]
many p s = case p s of
    Left _ -> Right ([], s)
    Right (x, s') -> case many p s' of
        Right (xs, s'') -> Right (x:xs, s'')

many1 :: Parser a -> Parser [a]
many1 p s = do
    (x, s') <- p s
    (xs, s'') <- many p s'
    Right (x:xs, s'')

(<|>) :: Parser a -> Parser a -> Parser a
(p1 <|> p2) s = (p1 s) <|> (p2 s) where
    Left a <|> Left b = Left $ a ++ " or " ++ b
    Left _ <|> b = b
    a <|> _ = a

anyChar :: Parser Char
anyChar (x:xs) = Right (x, xs)
anyChar _ = Left "empty string"

digit :: Parser Char
digit (x:xs) | isDigit x = Right (x, xs)
digit _ = Left "expect digit"

letter :: Parser Char
letter (x:xs) | isLetter x = Right (x, xs)
letter _ = Left "expect letter"

main :: IO ()
main = do
    disp $ anyChar "abc"
    disp $ anyChar ""
    disp $ digit "123"
    disp $ digit "abc"
    disp $ letter "123"
    disp $ letter "abc"
    disp $ sequence' [letter, digit] "a23"
    disp $ sequence' [letter, digit] "ab3"
    disp $ many digit "123"
    disp $ many digit "abc"
    disp $ many1 digit "123"
    disp $ many1 digit "abc"
    disp $ (digit <|> letter) "a23"
    disp $ (digit <|> letter) "123"
    disp $ (digit <|> letter) ""

モナドを使って書き直す

手続き型言語で構文解析をするとき、文字列をどこまで読んだかを更新し、状態を破壊しながらパースすることが多い(?)と思います。Haskellでも文字列の状態を明示的に考えることなく手続き的に書きたいです。

一文字パーサ

StateモナドとEitherモナドをStateTモナド変換子で合成します。StateT s m aでsが状態、mがモナド、aが値です。まずパーサを定義します。

type Parser a = StateT String (Either String) a

StateT s m aはs -> m (a, s)型の関数を保持しています。

anyChar :: Parser Char
anyChar = StateT anyChar where
    anyChar (x:xs) = Right (x, xs)
    anyChar _ = Left "empty string"

runStateT :: StateT s m a -> s -> m (a, s)を使うと内部関数を取り出すことができて、そのまま文字列を適用すれば解析結果が得られます。

main = do
    disp $ runStateT anyChar "abc"

連結

連結はsequence :: Monad m => [m a] -> m [a]を使えば良いです。

繰り返し

manyはほぼ同じように書けます。

many :: Parser a -> Parser [a]
many p = StateT $ \s -> case runStateT p s of
    Left _ -> Right ([], s)
    Right (x, s') -> case runStateT (many p) s' of
        Right (xs, s'') -> Right (x:xs, s'')

many1は、StateTアクションを使うことで、パース途中の文字列を明示せずに書くことができます。

many1 :: Parser a -> Parser [a]
many1 p = do
    x <- p
    xs <- many p
    return (x:xs)

選択

選択もほぼ同じです。

(<|>) :: Parser a -> Parser a -> Parser a
StateT a <|> StateT b = StateT $ \s -> (a s) <|> (b s) where
    Left a <|> Left b = Left $ a ++ " or " ++  b
    Left _ <|> b      = b
    a      <|> _      = a

main :: IO ()
main = do
    disp $ runStateT (digit <|> letter) "a23"
    disp $ runStateT (digit <|> letter) "123"
    disp $ runStateT (digit <|> letter) ""

全体のコード

import Control.Monad.State
import Data.Char

type Parser a = StateT String (Either String) a

disp :: Show a => Either String (a, String) -> IO ()
disp (Right (res, _)) = print res
disp (Left err) = print $ "error: " ++ err

many :: Parser a -> Parser [a]
many p = StateT $ \s -> case runStateT p s of
    Left _ -> Right ([], s)
    Right (x, s') -> case runStateT (many p) s' of
        Right (xs, s'') -> Right (x:xs, s'')

many1 :: Parser a -> Parser [a]
many1 p = do
    x <- p
    xs <- many p
    return (x:xs)

(<|>) :: Parser a -> Parser a -> Parser a
StateT a <|> StateT b = StateT $ \s -> (a s) <|> (b s) where
    Left a <|> Left b = Left $ a ++ " or " ++  b
    Left _ <|> b      = b
    a      <|> _      = a

anyChar :: Parser Char
anyChar = StateT anyChar where
    anyChar (x:xs) = Right (x, xs)
    anyChar _ = Left "empty string"

digit :: Parser Char
digit = StateT digit where
    digit (x:xs) | isDigit x = Right (x, xs)
    digit _ = Left "expect digit"

letter :: Parser Char
letter = StateT letter where
    letter (x:xs) | isLetter x = Right (x, xs)
    letter _ = Left "expect letter"

main :: IO ()
main = do
    disp $ runStateT anyChar "abc"
    disp $ runStateT anyChar ""
    disp $ runStateT digit "123"
    disp $ runStateT digit "abc"
    disp $ runStateT letter "123"
    disp $ runStateT letter "abc"
    disp $ runStateT (sequence [letter, digit]) "a23"
    disp $ runStateT (sequence [letter, digit]) "ab3"
    disp $ runStateT (many digit) "123"
    disp $ runStateT (many digit) "abc"
    disp $ runStateT (many1 digit) "123"
    disp $ runStateT (many1 digit) "abc"
    disp $ runStateT (digit <|> letter) "a23"
    disp $ runStateT (digit <|> letter) "123"
    disp $ runStateT (digit <|> letter) ""

簡単な数式のパース

数値

手続き的に書いてみます。

num :: Parser Int
num = do
    digits <- many1 digit
    return $ read digits

main :: IO ()
main = do
    disp $ runStateT num "123abc"
    disp $ runStateT num "abc"

足し算

add = num ('+' num)*

をパースします。後の0回以上の繰り返しはmanyを利用できます。特定の一文字を読み込むchar :: Char -> Parser Charを定義して、足し算のパーサを次のように書きます。

char :: Char -> Parser Char
char c = StateT char where
    char (x:xs) | x == c = Right (x, xs)
    char _ = Left $ "expect " ++ [c]

add :: Parser Int
add = do
    x <- num
    xs <- many $ do
        char '+'
        y <- num
        return y
    return $ sum (x:xs)

main :: IO ()
main = do
    disp $ runStateT add "1+2+3+4abc"

余談：Applicativeスタイル

を用いると

func = do
    a <- m1
    b <- m2
    ...
    return $ f a b ...

を

func = f <$> a <*> b ...

と書くことができる。これをApplicativeスタイルという。

Applicativeスタイルを用いると、例えば繰り返しを簡潔に書ける。

many p = ((:) <$> p <*> many p) <|> StateT (\s -> Right ([], s))

many1 p = (:) <$> p <*> many p

参考

おわり

明日はいくらはむさんの記事です。

season1618 icon
この記事を書いた人
season1618

数学と物理と情報工学

この記事をシェア

このエントリーをはてなブックマークに追加
共有

関連する記事

2021年8月12日
CPCTFを支えたWebshell
mazrean icon mazrean
2022年9月26日
競プロしかシラン人間が web アプリ QK Judge を作った話
tqk icon tqk
2022年9月16日
5日でゲームを作った #tararira
Komichi icon Komichi
2023年9月27日
夏のブログリレーは終わらない【駄文】
Komichi icon Komichi
2023年9月13日
ブログリレーを支えるリマインダー
H1rono_K icon H1rono_K
2023年8月21日
名取さなになりたくてOBSと連携する配信画面を作った
d_etteiu8383 icon d_etteiu8383
記事一覧 タグ一覧 Google アナリティクスについて 特定商取引法に基づく表記