FParsecで遊ぶ

F#

この記事は、F# Advent Calendar 2011 6日目の記事です。

構文解析に使うライブラリはたくさんありますが、今回はFParsecを取り上げます。
FParsec は Haskell の Parsec というパーサコンビネータの F# 実装です。

僕の考える文法

F#を使っていて、「F#の文法じゃ僕の思うDSLを表現できない」って思う事が良くありませんか？
内部DSLを頑張るのも結構ですが、どうしても格好悪くなってしまいますよね。
そういう時は、迷わず外部DSLを作ってしまいましょう。

そして、DSLの文法を考えているとき、どうしても実装したい機能が一つありますよね。F#にもあるオフサイドルールです。
今時、閉じタグ、閉じ括弧なんてかっこ悪い！
でも、オフサイドルールって実装するのが面倒そうじゃないですか？ どうやって作ればいいのでしょうか？

例題

こういう入力を、

parent
  child1
  child2
    grandchild1
  child3

こういう構文木に変換してください。

type Ast =
  | Node of string * Ast list
  | Leef of string

printfn "%A"した結果はこうです。

Some
  (Node
     ("parent",
      [Leef "child1"; Node ("child2",[Leef "grandchild1"]); Leef "child3"]))

戦略を考えよう

最初にどういう手順でパースしていくか考えます。括弧を擬似的に挿入する、という方法はどうでしょうか？
インデントが深くなったら括弧を開き、浅くなったら括弧を閉じるイメージです。

例題の入力を、以下のものとして扱います。

parent{
  child1
  child2{
    grandchild1
  }
  child3
}

単純に思いつく方法は、2回パースする方法ですね。UserState は使いません。
1回目のパースで括弧を挿入し、2回目のパースで実際に変換する方法です。これなら簡単にできそうですね。
ですが、それでいいのでしょうか？ 1回のパースだけで行いたくないでしょうか？

パースは1回がいい！

では、どうすれば1回のパースで完了できるでしょうか。
括弧を挿入するルールは、インデントが深くなったら括弧を開き、浅くなったら括弧を閉じる、でした。
でもこれって、前行の深さ、新しい行の深さ、親要素の深さを覚えておく必要がありそうです。
つまり、パーサが状態を持つ、ということです。

オフサイドルールパーサの状態を Record で表すとこんな感じです。

type Context = {
  Levels: int list // 親要素の深さのスタック
  CurrentLevel: int // 前行の深さ
  NewLevel: int // 新しい行の深さ
}

そして、パーサで状態を扱うには UserState を利用します。
UserState を扱うには、次のパーサを利用します（FParsecでは状態の操作もパーサになっています）。

  • 取得 getUserState
  • 更新 setUserState, updateUserState

この Context を次のタイミングで更新します。

  1. 行頭のスペースをパースしたとき NewLevel を更新する
  2. インデントが深くなった時 Levels に CurrentLevel を push する。 CurrentLevel を NewLevel に更新する。
  3. インデントが浅くなった時 Levels から1つ pull し、CurrentLevel に設定する。

UserState と更新のルールさえ決まれば、オフサイドルールなんて勝ったも同然ですよね。

答え合わせ

ところが、素直に実装していったらとても長くなってしまいました。

module OffsideParser
open FParsec

type Ast =
  | Node of string * Ast list
  | Leef of string

type Context = {
  Levels: int list // これまでのインデントのスタック
  CurrentLevel: int // 解析中のインデント
  NewLevel: int // 新しく検出したインデント
}

let updateNewLevel newLevel c = { c with NewLevel = newLevel }
let updateCurrentLevel currentLevel c = { c with CurrentLevel = currentLevel }
let updateLevels levels c = { c with Levels = levels }

type Parser<'a> = Parser<'a, Context>

// 要素名のパーサ
let pName : Parser<_> = manyChars (letter <|> digit)

// インデントの深さを返すパーサ
let pSpace : Parser<_> = manyChars (pchar ' ')
let pIndent = pSpace |>> String.length

// 同じ深さの場合成功するパーサ
let pSameLevel state = parse {
  do! (fun stream -> if state.CurrentLevel = state.NewLevel then
                       Reply(ReplyStatus.Ok)
                     else
                       Reply(ReplyStatus.Error, messageError "same level error"))
      |>> ignore
  return ()
}

// 改行と共に次の行のインデントの深さを調べるパーサ
// EOFだったら次の行はインデントの深さが0とする
let pEndOfLine = 
  attempt (parse {
    do! eof
    do! updateUserState (updateNewLevel 0)
  }) <|>  parse {
    do! newline |>> ignore
    let! indent = pIndent
    let! state = getUserState
    do! updateUserState (updateNewLevel indent)
  }

// インデントが深くなっていたら成功するパーサ
let pOpenParen level = parse {
  let! state = getUserState
  do! (fun stream -> if level < state.NewLevel then
                        Reply(ReplyStatus.Ok)
                      else
                        Reply(ReplyStatus.Error, messageError "open paren error"))
      |>> ignore
  do! updateUserState (updateLevels (level :: state.Levels) >> updateCurrentLevel (state.NewLevel))
  return ()
}

// インデントが浅くなっていたら成功するパーサ
let pCloseParen level = parse {
  let! state = getUserState
  do! (fun stream -> if state.NewLevel <= level then
                        Reply(ReplyStatus.Ok)
                      else
                        Reply(ReplyStatus.Error, messageError "close paren error"))
      |>> ignore
  do! updateUserState (updateLevels (state.Levels.Tail) >> updateCurrentLevel (state.Levels.Head))
  return ()   
}

let pElement, pElementR = createParserForwardedToRef()

// 子要素のパーサ
let pChildren = parse {
  let! state = getUserState
  let currentLevel = state.CurrentLevel
  do! pOpenParen currentLevel
  let! lines = many pElement
  do! pCloseParen currentLevel

  return lines
}

// トップレベルのパーサ
do pElementR := parse {
  let! state = getUserState
  do! pSameLevel state
  let! name = pName
  do! pEndOfLine
  let! children = opt pChildren
  return match children with
         | Some c -> Node(name, c)
         | None -> Leef(name)
}

実行する方法です。

input = "parent
  child1
  child2
    grandchild1
  child3"
let context = { Levels = []; CurrentLevel = 0; NewLevel = 0 }
  match runParserOnString pElement context "" input with
    | Success(result, _, _) ->
      Some result
    | Failure(message, _, _) ->
      None

実行結果です。問題と一致しました。

Some
  (Node
     ("parent",
      [Leef "child1"; Node ("child2",[Leef "grandchild1"]); Leef "child3"]))

まとめ

僕がオフサイドルールな DSL を作った時の記録を元に、この記事を書きました。
構文解析楽しいです。実現したい文法があれば、妥協せずにどんどんパーサを書きましょう。