モナディックなパーサ・コンビネータFParsecを使おう。てゆうかParsec(Haskell)のApplicativeスタイルがやばい。

Parsec(Haskell)のApplicativeスタイルがやばすぎるので、FParsecでApplicativeスタイルしてみた。

FParsecとは

FParsec とは Haskell のパーサ・コンビネータライブラリ Parsec をF#に移植したものです*1。
では、パーサ・コンビネータとはなんでしょうか。簡単に言うとパーサ(構文解析)の関数を組み合わせることで、
新たに複雑なパーサを作り上げるための仕組み(フレームワーク)と考えておけばよいでしょう。ファイルやいろいろな型のデータの構文解析に力を発揮します。

構文解析といえば正規表現を思い浮かべる人も多いかもしれません。正規表現は多くの場合とても便利ですが、複雑なデータ構造を扱うには不向きです。
パーサ・コンビネータは、時に正規表現に対する“より良い代替案”になり得ます*2。
FParsecを用いることで、無限先読みの文脈依存文法を解析したり、BNF記法で表すような複雑なパーサも比較的簡単に作ることができます。
噂によるとHaskellのParsecはLL構文解析において最高の性能を発揮するそうです。FParsecも同じような雰囲気ですたぶん。
ということで、難しいことはよくわかりませんが、魔神英雄伝ワタルよろしくなんだか面白カッコ良さそうなので利用しない手はないです。

環境

F# 2.0.0
FParsec 0.8.0.0

準備１：FParsecをビルドする

FParsecを利用するには、まずここ から FParsec のソースコードをダウンロードし、適当なディレクトリに解凍してビルドします。
すると、めでたくFParsec.dllとFParsecCS.dllを手に入れることができます。ありがたや。

準備２：参照設定とモジュールのオープン

さっそくFParsec.dllとFParsecCS.dllを参照設定に追加します。

そして、利用するFParsecの各モジュールをオープンします。

open System
open FParsec.Primitives
open FParsec.CharParsers
open FParsec.Error

これでFParsecを利用する環境が手に入りました。やったね。

FParsec：パースの基本

FParsec - A Parser Combinator Library for F#に解説と基本的なサンプルコードが出ています。
サンプルコードを動かすと、なんとなく雰囲気がつかめます。
ただ、ドキュメントの内容が古くなってしまっていて、すべてをそのまま適用できないのが残念なところです。

さっそく何かパースしてみましょう。
まったく面白くもなんともありませんが、例えば1つの文字をパースするパーサはこう書けます。

let test s = match run letter s with
             | Success (r,us,p)   -> printfn "success: %A" r
             | Failure (msg,err,us) -> printfn "failed: %s" msg

let _ = test "ふじこｌｐ777"
let _ = test "1ふじこｌｐ777"

実行結果

success: 'ふ'
failed: Error in Ln: 1 Col: 1
1ふじこｌｐ777
^
Expecting: letter

letterの型はParserとなっています。
正確には、unicode letter(System.Char.IsLetterがtrueを返すもの)をパースするシンプルなパーサです。
runはパーサと対象を受け取ってパースを実行して結果を返す関数で、
成功した場合はSuccess、失敗した場合はFailureを判別共用体 ParserResult<'Result,'UserState>で返します*3。
例の「"1ふじこｌｐ777"」のパースは、先頭が数字(System.Char.IsLetter('1')はfalse)なので失敗していることがわかります。

もちろん letter の他にも以下のような基本的なパーサがいくつも定義されています。
でもぶっちゃけ全然足りてないですね。字句解析を真面目にやるなら不足分は自分で作るしかないですね。

anyOf: string -> Parser<char,'u>
 「任意の文字列(引数:string)に含まれるすべてのchar」をパース

noneOf: string -> Parser<char,'u>
 「任意の文字列(引数:string)に含まれるすべてのchar」を含まないパース

asciiUpper: Parser<char,'u>
 ASCII letter (大文字)をパース

asciiLower: Parser<char,'u>
 ASCII letter (小文字)をパース

asciiLetter: Parser<char,'u>
 ASCII letterをパース

upper: Parser<char,'u>
 unicode letter(大文字)をパース

lower: Parser<char,'u>
 unicode letter(小文字)をパース

digit: Parser<char,'u>
 数字([0-9])をパース

ちなみに１つ以上の複数のunicode letter(System.Char.IsLetterがtrue)をパースするパーサはこう書けます。

let test2 s = match many1 letter |> run <| s with
              | Success (r, s, p) -> printfn "%A" r
              | Failure (msg, err, s) -> printfn "%s" msg

let _ = test2 "ふじこｌｐ777"
let _ = test2 "1ふじこｌｐ777"

実行結果

['ふ'; 'じ'; 'こ'; 'ｌ'; 'ｐ']
Error in Ln: 1 Col: 1
1ふじこｌｐ777
^
Expecting: letter

選択

(<|>)、choice関数

(<|>)演算子あるいは、choice関数でパーサを選択することができる。
意味としては、正規表現で言うところの「|」（どれかにマッチ）と同じと考えて差し支えはない。
ただし、(<|>)演算子は、常に左側の選択肢を最初に試すということには注意。

unicode letterあるいは数字に一致する１文字以上にパース

let ld = (letter <|> digit |> many1Chars) 
         |> run <| "ABC12D34;EF5"
match ld with
| Success (r, s, p) -> printfn "%A" r
| Failure (msg, err, s) -> printfn "%s" msg

実行結果

"ABC12D34"

もちろんコンピューテーション式で記述することもできる

let ld' = parse {let! anc = choice [letter;digit] |> many1Chars
                 return anc}
          |> run <| "ABC12D34;EF5"
match ld' with
| Success (r, s, p) -> printfn "%A" r
| Failure (msg, err, s) -> printfn "%s" msg
Console.WriteLine () |> ignore

(.>>)、(>>.)

括弧内の1つ以上の数字をcharのリストとしてパース
many1がみそですね。ただのmanyだと１文字もマッチしなくてもパースが成功します。

let e1 = run (pchar '(' >>. (many1 digit) .>> pchar ')') "(123456)"
match e1 with
| Success (r, s, p) -> printfn "%A" r
| Failure (msg, err, s) -> printfn "%s" msg

実行結果

['1'; '2'; '3'; '4'; '5'; '6']

括弧内の1つ以上の数字をstringとしてパース
many1Charsがみそですね。ただのmanyCharsもmanyと同様に、１文字もマッチしなくてもパースが成功します。

let f = pchar '(' >>. (many1Chars digit) .>> pchar ')'
        |> run <| "(123456)"
match f with
| Success (r, s, p) -> printfn "%A" r
| Failure (msg, err, s) -> printfn "%s" msg

実行結果

"123456"

unicode letterおよび#+.をパース（ただし、lowerは読み捨てる）

let notlower1 = (letter <|> anyOf "#+.") .>> manyChars lower |> manyChars
               |> run <| "F#C#C++javaVB.NET"
match notlower1 with
| Success (r, s, p) -> printfn "%A" r
| Failure (msg, err, s) -> printfn "%s" msg

実行結果

"F#C#C++VB.NET"

連結

連結とはまさにパースとパースを繋ぎ合わせることです。
以下は、「unicode letterと数字が隣り合う文字列」に一致する１文字以上にパース

let cn = (pipe2 letter (many1Chars digit) (fun x y -> string(x)+string(y)) |> manyStrings) 
         |> run <| "A1B2C345;D6"
match cn with
| Success (r, s, p) -> printfn "%A" r
| Failure (msg, err, s) -> printfn "%s" msg

もちろんコンピューテーション式として記述することもできる

let cn' = parse {let! anc = letter 
                 let! d = many1Chars digit 
                 return string(anc)+string(d)} |> manyStrings
          |> run <| "A1B2C345;D6"
match cn' with
| Success (r, s, p) -> printfn "%A" r
| Failure (msg, err, s) -> printfn "%s" msg

unicode letterと隣り合うセミコロンも許容する

let cn'' = parse {let! anc = letter 
                  let! d = many1Chars digit <|> (anyOf ";" |> many1Chars)
                  return string(anc)+string(d)} |> manyStrings
           |> run <| "A1B2C3D;E45;F6"
match cn'' with
| Success (r, s, p) -> printfn "%A" r
| Failure (msg, err, s) -> printfn "%s" msg

実行結果

"A1B2C3D;E45"

正規表現の併用

正規表現を使わない場合

let str = @"(*comme
nt123a*)bc4d*)"

let comment1 = pstring "(*" >>. many1Chars (choice [digit;letter;newline] ) .>> pstring "*)"
               |> run <| str
match comment1 with
| Success (r, s, p) -> printfn "%A" r
| Failure (msg, err, s) -> printfn "%s" msg

正規表現を併用して使う

let comment2 = between (pstring "(*") (pstring "*)") (regex "[^*)]+") 
               |> run <| str
match comment2 with
| Success (r, s, p) -> printfn "%A" r
| Failure (msg, err, s) -> printfn "%s" msg

実行結果

"comme
nt123a"
"comme
nt123a"

FParsecは正規表現の代替案になり得るのは間違いない。
しかし、正規表現の長所すべてを否定するものではない。
正規表現の長所はそのままFParsecの中で生かすことができる。

let kanji = regex "[一-龠]" <?> "kanji"

let kr = kanji |> many1 |> run <| "読書百遍意自ずから通ず"
match kr with
| Success (r, s, p) -> printfn "%A" r
| Failure (msg, err, s) -> printfn "%s" msg

実行結果

["読"; "書"; "百"; "遍"; "意"; "自"]

というように、正規表現を導入することで漢字のパーサを簡単かつ正確に作ることができます。
(<?>)演算子は、解析器が失敗したときのエラーメッセージをカスタマイズするためのものです。

とあるパーサをn回適用したパーサ

とあるパーサをn回適用したパーサを取得する関数repeatを定義する

let repeat n p =
  let rec repeat n p result =
    parse {if n > 0 then
             let! x = p
             let! xs = repeat (n - 1) p (result@[x])
             return xs
           else
             return result}
  repeat n p []

unicode letterを読み捨てて、数字3桁をパースする

let d3 = letter <|> digit .>> many letter >>. repeat 3 digit
         |> run <| "aBc1234dEf"

match d3 with
| Success (r, s, p) -> printfn "%A" r
| Failure (msg, err, s) -> printfn "%s" msg

実行結果

['1'; '2'; '3']

let w = repeat 3 (pstring "うぇ")
         |> run <| "うぇうぇうぇうぇうぇうえぇえぇええｗｗｗｗ"

match w with
| Success (r, s, p) -> printfn "%A" r
| Failure (msg, err, s) -> printfn "%s" msg

実行結果

["うぇ"; "うぇ"; "うぇ"]

先読み

FParsecにはattemptがあって、これを使って先読みを表現することができる(Parsecでいうところのtryに相当)。
attemptは解析関数(Parser<_,_>)を１つ取って、解析が成功しなかった場合、attempは入力を消費しない。
なので、(<|>)演算子の左側でattempを使うと、attemp内での消費がなかったものとして右側を試しま。attemptって名前のとおりです。

let w2 = repeat 3 (pstring "うぇうぇ")
         |> run <| "うぇうぇうぇうぇうぇうえぇえぇええｗｗｗ"

match w2 with
| Success (r, s, p) -> printfn "%A" r
| Failure (msg, err, s) -> printfn "%s" msg


let w3 = attempt (repeat 3 (pstring "うぇうぇ")) <|> (repeat 5 (pstring "うぇ"))
         |> run <| "うぇうぇうぇうぇうぇうえぇえぇええｗｗｗ"

match w3 with
| Success (r, s, p) -> printfn "%A" r
| Failure (msg, err, s) -> printfn "%s" msg

実行結果

Error in Ln: 1 Col: 9
うぇうぇうぇうぇうぇうえぇえぇええｗｗｗ
        ^
Expecting: 'うぇうぇ'

["うぇ"; "うぇ"; "うぇ"; "うぇ"; "うぇ"]

単純なパーサ：郵便番号

郵便番号パーサ　正規表現

let r = parse {let! d = regex "^\d{3}-\d{4}$" in return d}
let zip = (r, "001-0016") ||> run
match zip with
| Success (r, s, p) -> printfn "%A" r
| Failure (msg, err, s) -> printfn "%s" msg

郵便番号パーサ 正規表現未使用

let zip2 = parse {let! p= pipe3 (repeat 3 digit) (pchar '-') (repeat 4 digit) (fun x y z -> x@[y]@z)
                  do! notFollowedBy (digit <|> letter)
                  return new string (List.toArray p)}
           |> run <| "001-0016"
match zip2 with
| Success (r, s, p) -> printfn "%A" r
| Failure (msg, err, s) -> printfn "%s" msg

実行結果

"001-0016"
"001-0016"

単純なパーサ：改行区切り

改行区切りでパースする

let pline =
   parse {let! first = anyChar 
          if first = '\n' then 
            return "" 
          else 
            let! txt = restOfLine 
            return (first.ToString()+txt)} 

let strings' = run (many pline) "\n\nHoge1\nFuga\n\nPiyo" 
match strings' with
| Success (r, s, p) -> printfn "%A" r
| Failure (msg, err, s) -> printfn "%s" msg

内部的にどうなっているのか、もっと詳細な書き方をした場合

let pline': Parser<string, unit> =
    fun state ->
       let mutable str = null
       let newState = state.SkipRestOfLine(true, &str)
       if not (LanguagePrimitives.PhysicalEquality state newState) then
           Reply(str, newState)
       else
           Reply(Error, NoErrorMessages, newState)

let strings'' = run (many pline') "\n\nHoge1\nFuga\n\nPiyo"
match strings'' with
| Success (r, s, p) -> printfn "%A" r
| Failure (msg, err, s) -> printfn "%s" msg

実行結果

[""; ""; "Hoge1"; "Fuga"; ""; "Piyo"]
[""; ""; "Hoge1"; "Fuga"; ""; "Piyo"]

Applicativeスタイルがやばい

Applicativeのススメ - あどけない話
http://d.hatena.ne.jp/kazu-yamamoto/20101211/1292021817

Real World Haskell - Chapter 16. Using Parsec Applicative functors for parsing
http://book.realworldhaskell.org/read/using-parsec.html

Applicativeスタイル*4がやばい。やばすぎるよ！
ということで、冒頭でも書いたが、FParsecでApplicativeスタイルしてみた。

module FParsec.Applicative
open System
open FParsec.Primitives
open Microsoft.FSharp.Core.Operators.Unchecked 

/// ap :: Monad m => m (a -> b) -> m a -> m b
let inline ap f a = f >>= fun f' -> a >>= fun a' -> preturn (f' a') 

/// (<*>) :: Applicative f => f (a -> b) -> f a -> f b
let inline (<*>) f a = ap f a

/// (<**>) :: Applicative f => f a -> f (a -> b) -> f b
let inline apr f a = a <*> f
let inline (<**>) f a = apr f a

/// liftA :: Applicative f => (a -> b) -> f a -> f b
let inline liftA f a = a |>> f 

/// (<$>) :: Functor f => (a -> b) -> f a -> f b
let inline (<!>) f a = liftA f a 

/// (<$) :: Functor f => a -> f b -> f a
let inline (<!) f a = preturn f .>> a
let inline (!>) f a = f >>. preturn a

/// liftA2 :: Applicative f => (a -> b -> c) -> f a -> f b -> f c
let inline liftA2 f a b = pipe2 a b f         // preturn f <*> a <*> b 
let inline (<!!>) f a b = liftA2 f a b 

/// liftA3 :: Applicative f => (a -> b -> c -> d) -> f a -> f b -> f c -> f d
let inline liftA3 f a b c = pipe3 a b c f
let inline (<!!!>) f a b c = liftA3 f a b c

/// ( *>) :: Applicative f => f a -> f b -> f b
let inline ( *>) x y = x >>. y                 // liftA2 (fun _ z -> z) x y 

/// (<*) :: Applicative f => f a -> f b -> f a
let inline ( <*) x y = x .>> y                 // liftA2 (fun z _ -> z) x y 

/// sequenceA :: Applicative f => [f a] -> f [a]
let sequenceA ps = List.foldBack (liftA2 (fun x y -> x::y)) ps (preturn [])

/// sequenceA_ :: Applicative f => [f a] -> f ()
let sequenceA_ ps = List.fold ( *>) (preturn ()) ps

/// mapA :: Applicative f => (a -> f b) -> [a] -> f [b]
let mapA f xs = sequenceA (List.map f xs)

/// mapA_ :: Applicative f => (a -> f b) -> [a] -> f ()
let mapA_ f xs = sequenceA_ (List.map f xs)

/// foreverA :: Applicative f => f a -> f b
let rec foreverA a = a *> foreverA a

/// asum :: Alternative f => [f a] -> f a
let sumA ps = List.fold (<|>) (preturn defaultof<'a>) ps

//filterA :: Applicative f => (a -> f Bool) -> f [a] -> f [a]
let filterA f ps = 
  let addIf x b xs = if b then x::xs else xs
  let consA x a = liftA2 (addIf x) (f x) a
  List.foldBack consA ([]) ps

/// zipWithA :: Applicative f => (a -> b -> f c) -> [a] -> [b] -> f [c]
let map2A f xs ys = sequenceA (List.map2 f xs ys)

/// zipWithA_ :: Applicative f => (a -> b -> f c) -> [a] -> [b] -> f ()
let map2A_ f xs ys = sequenceA_ (List.map2 f xs ys)

/// mapAndUnzipA :: Applicative f => (a -> f (b, c)) -> [a] -> f ([b], [c])
let mapAndUnzipA f xs = liftA List.unzip (mapA f xs)

/// replicateA :: Applicative f => Int -> f a -> f [a]
let replicateA n a = sequenceA (List.replicate n a)

/// replicateA_ :: Applicative f => Int -> f a -> f ()
let replicateA_ n a = sequenceA_ (List.replicate n a)

/// unlessA :: Applicative f => Bool -> f () -> f ()
let unlessA b a = if b then preturn () else a

/// guardA :: Alternative f => Bool -> f ()
let guardA b = unlessA b (preturn ())

/// whenA :: Applicative f => Bool -> f () -> f ()
let whenA b a = if b then a else preturn ()

ということで、FParsecはHaskellのParsec同様にモナディックなパーサ・コンビネータであることがわかります。
ちなみに、コメントの型表記はHaskell形式です。
当然ながらF#的な型を表すものではありませんし正確でもありません。あしからず。

Applicativeスタイルを適用すると、

let foo m1 m2 f = 
  parse {let! a= m1
         let! b = m2
         return f a b}

というように、コンピューテーション式でこう書いていたものが

let foo' m1 m2 f = f <!> m1 <*> m2

こう書けます。あらまあ、きれいにコンピューテーション式なスタイルがなくなりました。

(<!>)演算子と(<*>)演算子を隠してみると以下のようになります。

let foo' m1 m2 f = f m1 m2

これはつまり、Applicativeがf m1 m2 という関数適用の形になっていることを表します。
Applicaitveを用いると、パーサをとても自然に表現することができるということです。
これが Applicative (適用できる)と呼ばれる由来です。

CSVファイルのパース

リア充本としても知られる「Real World Haskell」に掲載されているParsecによるCSVファイルパーサのお手本。
http://book.realworldhaskell.org/read/using-parsec.html

import Text.ParserCombinators.Parsec

csvFile = endBy line eol
line = sepBy cell (char ',')
cell = quotedCell <|> many (noneOf ",\n\r")

quotedCell = 
    do char '"'
       content <- many quotedChar
       char '"' <?> "quote at end of cell"
       return content

quotedChar =
        noneOf "\""
    <|> try (string "\"\"" >> return '"')

eol =   try (string "\n\r")
    <|> try (string "\r\n")
    <|> string "\n"
    <|> string "\r"
    <?> "end of line"

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

main =
    do c <- getContents
       case parse csvFile "(stdin)" c of
            Left e -> do putStrLn "Error parsing input:"
                         print e
            Right r -> mapM_ print r

実にエレガントですね。

何も考えずに、F#へ移植してみる

let quotedChar = noneOf "\"" 
             <|> attempt (pstring "\"\"" >>. pchar '"')

let quotedCell = pchar '"' 
             >>. manyChars quotedChar 
             .>> pchar '"' 
             <?> "quote at end of cell"

let cell = quotedCell
       <|> manyChars (noneOf ",\n\r")

let line = sepBy cell (pchar ',')

let eol = attempt (newline) <?> "end of line"
let csvFile = sepEndBy line eol
let parseCSV input = (csvFile, input) ||> run

let ReadFile filename = System.IO.File.ReadAllText(filename,System.Text.Encoding.GetEncoding("UTF-8")) 
let csv = @"D:\test\Data\sample.csv" |>  ReadFile
match parseCSV csv with
| Success (r, s, p) -> printfn "%A" r
| Failure (msg, err, s) -> printfn "%s" msg
Console.ReadLine () |> ignore

なんという写経。

適用箇所少ないけど、Applicativeスタイルにしてみる。

open FParsec.Applicative

let quotedChar = noneOf "\"" <|> attempt ('"' <! pstring "\"\"")
let quotedCell = pchar '"' *> manyChars quotedChar <* pchar '"' 
             <?> "quote at end of cell"
let cell = quotedCell <|> manyChars (noneOf ",\n\r")
let line = sepBy cell (pchar ',')
let eol = attempt newline <?> "end of line"
let csvFile = sepEndBy line eol
let parseCSV input = (csvFile, input) ||> run

let ReadFile filename = System.IO.File.ReadAllText(filename,System.Text.Encoding.GetEncoding("UTF-8")) 
let csv = @"D:\test\Data\sample.csv" |>  ReadFile 

match parseCSV csv with
| Success (r, s, p) -> printfn "%A" r
| Failure (msg, err, s) -> printfn "%s" msg
Console.ReadLine () |> ignore

ふつくしい…！

あわせて読みたい

マジあわせて読みたい。

シンプルで高速な構文解析ライブラリ「Parsec」を.NETで使う^^ - yuji1982の日記
http://d.hatena.ne.jp/yuji1982/20080627/1214558307

最強のパーザー、Parser Combinator - 純粋関数型雑記帳
http://d.hatena.ne.jp/tanakh/comment?date=20040730

正規表現を超える - あどけない話
http://d.hatena.ne.jp/kazu-yamamoto/20090309/1236590230

正規表現ちっくなパーサーコンビネーター - あどけない話
http://d.hatena.ne.jp/kazu-yamamoto/20110131/1296466529

Applicativeのススメ - あどけない話
http://d.hatena.ne.jp/kazu-yamamoto/20101211/1292021817

Applicative よりも Monad の方が力が強い理由 - あどけない話
http://d.hatena.ne.jp/kazu-yamamoto/20100525/1274744955

Parsing with applicative functors in F# - Bug squash
http://bugsquash.blogspot.com/2011/01/parsing-with-applicative-functors-in-f.html

例によるApplicativeパーシング
http://www.mokehehe.com/realworldhaskell/index.php?Parsec%20%A5%D1%A1%BC%A5%B7%A5%F3%A5%B0%A5%E9%A5%A4%A5%D6%A5%E9%A5%EA#content_1_11

F# FParsec で（とりあえず）Forthを作る - 還暦プログラマの挑戦(Haskell に挑む→F#による言語造り)
http://www.cmas60.com/FS/fparsec.php

最後に

関数型的であり、ひじょーにCOOOOLなApplicativeスタイルではありますが、
当然ながら、使いこなすにはある程度の関数脳レベルが要求されるので、素人にはおすすめできない諸刃の剣。

ですから「F#でそれをやる意味あんの？」と問われたら、「慣れれば意味あるけど、慣れないうちは爆死必至だよ。」とでも答えよう。
そもそも、F#には、コンピューテーション式という、すばらしく可読性の高いステキスタイルがあらかじめ言語レベルで用意されているので、
あなたが、より意味を伝えるよう意識してコードを記述する善良なプログラマならば、わざわざApplicativeにする理由はこれっぽっちもない。
FParsecでのApplicativeスタイルは、まぎれもなく変態さん向け。変態さん個人で利用する場合、もしくは変態さんが
変態さんとコミュニケーションするためにはこの上ない良いツールです。それ以外のケースではうまく機能しないことは言うまでもありません。

なにはともあれ、FParsecは良い道具です。ご賞味あれ。

*1:FParsecもモナドだよとか言ったらその筋の人に怒られそうだけど、まぁ制限付モナドとして捉えるのは間違いじゃないんじゃないか

*2:便利だけど適用は割と難しい。主に学習コスト的な意味で。

*3:Parsec(Haskell)の場合だと、Eitherで返す

*4:「Real World Haskell」日本語翻訳版には、作用型解析という名前で紹介されています