強力なParser Combinatorを簡単に書く

上で述べた通りに

http://www.cs.nott.ac.uk/~gmh/pearl.pdf

こいつを読んだのでそれについて書く。
Parser Combinatorとか滅茶苦茶難しそうだよなーと今まで思っていたけども全くそんな事は無かった。

ただ眠いので起きてから感想とかはつらつらと。

論文のメモ

1.Introduction
Haskellにおける再帰下降パーザの実装についてのpaperらしい。
焦点は

functional parsers
structure functional programsの為のMonad,
Haskellのmonadic programの為の特別記法の使用とかそんなの。

functional programmingの旨味を活かすという事かしら。

2.A type for parsers
何にせよ型が大事。
newtype Parser a = Parser (String -> [(a,String)])
こんなのを作る。
Parserはstringを引数として取り、resultのlistを返す。
空っぽの時は失敗を表し、そうで無い時は成功を表す。
成功の時は、タプルのfstはparsingによって作られたもので、
sndはparseされなかった部分。(食い残し)
listにして結果を返せるというのは、"曖昧さ"を取り扱えるという事でもある。
(私は曖昧さを取り扱いたくないのでResultはno list)

3. A monad for parsers
最初に定義するのはitem
これは引数の文字列が空でない時に一文字目を消費して、そうで無い場合failする。

item :: Parser Char 
item = Parser (\cs -> case cs of 
                       ""       -> [] 
                       (c:cs) -> [(c,cs)])

次にcombinatorを書く。
ParserをMonadのinstanceにしてしまえ！！

instance Monad Parser where 
  return a = Parser (\cs -> [(a,cs)]) 
  p >>= f = Parser (\cs -> concat [parse (f a) cs' |   リスト内包表記 
                                   (a,cs') <- parse p cs])

ここで補助関数
parse (Parser p) = p
を定義しておく。

4.The do notation
いらんのでかっとばす。
引数を3文字消費して、1,3文字目だけ返すparserをcombinateする。

p :: Parser (Char,Char) 
p = do { c <- item; item; d <- item; return (c,d)}

触れられてなかった気がするけど、このdo式の中では、
>>=
じゃなくて
>>(>>=によるデフォルト定義)
が良きに計らわれて使われている。
5.Choice combinators

instance MonadPlus Parser where 
  mzero = Parser (\cs -> []) 何の引数が来たとしても失敗させるパーザ 
  p ++ q = Parser (\cs -> parse p cs ++ parse q cs) 中の++はlistの結合 
  parser pとparser qのparse resultを結合して返すparser 

  (+++) :: Parser a -> Parser a -> Parser a 
  p +++ q = Parser (\cs -> case parse (p ++ q) cs of 
                             []     -> [] 
                             (x:xs) -> [x])

最初の結果のみを返す(or)

sat :: (Char -> Bool) -> Parser Char 
sat p = do { c <- item; if p c then return c else zero}

一文字消費して、それがsat関数の引数に渡された関数を満たすならば、
return　そうでなければ失敗

char :: Char -> Parser Char 
char c = sat (c ==)

6.Recursion Combinators
そのまんま再帰コンビネータで良いのかしら？
再帰をcombinateするの・・・?
A number of useful parser combinators can be defined recursibely.
だってさ。
次の様な便利なparserを書いてしまう。

string :: String -> Parser String 
string ""     = return "" 
string (c:cs) = do { char c; string cs; return (c:cs) } 

many  :: Parser a -> Parser [a] 
many p  = many1 p +++ return [] 

many1 :: Parser a -> Parser [a] 
many1 p = do { a <- p; as <- many p; return (a:as) } 

sepby  :: Parser a -> Parser b -> Parser [a] 
p `sepby` sep = (p `sepby1` sep) +++ return [] 

sepby1 :: Parser a -> Parser [a] 
p `sepby1` sep = do a   <- p 
                    as  <- many (do {sep; p}) 
                    return (a:as) 

chainl  :: Parser a -> Parser (a -> a -> a) -> a -> Parser a 
chainl p op a = (p 'chainl1' op) +++ return a 

chainl1 :: Parser a -> Parser (a -> a -> a) -> Parser a 
p 'chainl1' op = do { a <- p; rest a} 
     where  rest a = (do f <- op 
                         b <- p 
                         rest (f a b)) 
                     +++ return a

f a bの所で、fに二つの引数aとbを適用している。

まとめ

適当に糊付していくだけでガンガンパーザが書ける。
部分適用が美味しい。
再帰使いまくり。
Parser Monadを作り、do式で非常に簡単に、なおかつ見やすく、適当な効率性を持つparserを、ベースとなるparserを使ってcombinateする事が出来る。

凄く関数型言語で良いなぁと思いながら読んでいました。
おいしいMonadの例としても良いので、HaskellはどうもMonadが・・・と思う人はこういうのを自分で実装して感じを掴んで見るのが良いかもしれないとも。

コード

paper見ながら書いたコードを晒したりー。といっても完全にコピーしてるだけですがwww
強いて言えばResult型入れてて、内容が古かった(MonadZeroとか)部分を直しただけです

import Data.Char
import Control.Monad

data Result val rem = Parsed val rem
                    | NoParse
      
newtype Parser a = Parser (String -> Result a String)

ext_parser :: Parser a -> (String -> Result a String)
ext_parser (Parser p) = p

myprint (Parsed a b) = do{print a;print b}
myprint NoParse = print "Error"

instance Monad Parser where
    return a = Parser (\cs -> Parsed a cs)
    
    p1 >>= f  = Parser parse
        where parse cs = first ( (ext_parser p1) cs)
              first (Parsed val rem) =
                  let Parser p2 = f val
                  in second (p2 rem)
              first NoParse = NoParse
                              
              second (Parsed val rem) = Parsed val rem
              second NoParse = NoParse

instance MonadPlus Parser where
    mzero = Parser (\cs -> NoParse)

(Parser p) <|> (Parser q) = Parser (\cs -> case p cs of
                                               Parsed val rem -> Parsed val rem
                                               NoParse -> q cs)

item :: Parser Char
item = Parser (\cs -> case cs of
                        ""     -> NoParse
                        (c:cs) -> Parsed c cs)

satisfy :: (Char -> Bool) -> Parser Char
satisfy p = do { c <- item; if p c then return c else mzero}

char :: Char -> Parser Char
char c = satisfy (c ==)

string :: String -> Parser String
string ""     = return ""
string (c:cs) = do { char c;string cs;return (c:cs) }

many  :: Parser a -> Parser [a]
many p  = many1 p <|> return []

many1 :: Parser a -> Parser [a]
many1 p = do { a <- p; as <- many p; return (a:as)}

sepby  :: Parser a -> Parser b -> Parser [a]
p `sepby` sep  = (p `sepby1` sep) <|> return []

sepby1 :: Parser a -> Parser b -> Parser [a]
p `sepby1` sep = do a  <- p
                    as <- many (do {sep; p})
                    return (a:as)

chainl  p op a = (p `chainl1` op) <|> return a

p `chainl1` op = do { a <- p; rest a}
    where rest a = (do f <- op
                       b <- p
                       rest (f a b))
                   <|> return a

space = many $ satisfy isSpace
token p = do { a <- p; space; return a }
symb cs = token (string cs)
apply p = ext_parser(do {space; p})


---この下で簡易電卓の実装!!
{-
expr   ::= expr addop term | term
term   ::= term mulop factor | factor
factor ::= digit | (expr)
digit  ::= 0 | 1 | .. | 9

addop  ::= + | -
mulop  ::= * | /
-}

expr   = term `chainl1` addop
term   = factor `chainl1` mulop
factor = digit <|> do { symb "("; n <- expr; symb ")";return n}
digit  = do { x <- token (satisfy isDigit); return (ord x - ord '0') }

addop  = do { symb "+"; return (+)} <|> do { symb "-"; return (-)}
mulop  = do { symb "*"; return (*)} <|> do { symb "/"; return (div)}