OCamlでMonadic Parserを作ってみる（前編）

OCaml 4.08でmonadic/applicative letの構文が入ったことだし、これを使ってみよう、ということでHaskellのParsecのようなMonadic Parser Combinatorが作れるか試してみた。

具体的にはGraham HuttonのProgramming in Haskellの13章にあたる「Monadic parsing」の章をOCamlで追ってみたい。

Parser型

Huttonの例ではParserは

newtype Parser a = P (String -> [(a, String)])

となっている。文字列を受け取り、パースが失敗したら空リスト、成功したらパースした結果と残りの文字列のタプルが唯一の要素のリストを返す。

OCamlに訳すにあたって三つ変えてみる：

• コンストラクタを使わない。Haskellではtypeclassのインスタンスにするためにnewtypeとコンストラクタを用意しているがOCamlではそもそもtypeclassがないので。
• stringではなくchar listを使う。HaskellだとStringはそのまま[Char]なのでパターンマッチできたり、tailがO(1)で取れたりして便利。OCamlだと文字列はリストではないのでそのまま扱うにはいろいろとめんどくさい。
• 戻り値はlistではなくoptionを使う。複数の可能なパース結果を返す、といったことをしないかぎりリストを使う意味はない。

というわけでParser.tはこうなる：

type 'a t = char list -> ('a * char list) option

ついでに文字列にこのParser.t型の関数を適用できるように、parseという関数を定義しておく：

let parse p s = p @@ String.to_list s

（余談だが今回はcontainersというOCaml標準ライブラリを補う拡張ライブラリを使っている。普段使っているBatteriesがOCaml4.08に対応していなかったため・・・）

最小限のパーサ

文字リストから先頭の文字一つを結果としてとるget_charパーサを実装してみる：

let get_char = function
  | [] -> None
  | c::cs -> Some (c, cs)

使ってみるとこんな感じ：

utop # parse get_char "ABC";;
- : (char * char list) option = Some ('A', ['B'; 'C'])

これを元にいろいろと組み合わせて使えるパーサコンビネータを作っていく。

Functor

まずParser.tをFunctorとして使えるようにmapを定義する：

let map f p = fun cs -> (match p cs with
  | None -> None
  | Some (v, cs') -> Some (f v, cs'))

これで何ができるようになるかというと、あるパーサと、そのパース結果の型を引数にとる関数を組み合わせることができる。

例えばget_charのパース結果はchar型だが、その文字に対応するascii codeをパース結果とするパーサがほしいとすると：

let get_charcode = map Char.code get_char

でその新しいパーサが作れてしまう。パーサの内部実装などはまったく触らずに、パーサAの結果に対して関数を適用したものがパース結果になるパーサBを作成する。

Applicative

Functorとしてmapが定義されているのはうれしいが、まだまだ表現力が貧弱だ。例えば「二つのパーサを順番に並べて、その二つのパース結果を組み合わせたものをパース結果とする」ようなパーサはmapだけでは作れない。そのためにはApplicativeの関数であるpureとapplyが必要になる。

pureはある値aをとり、「入力である文字リストをまったく消費せずにその値aをパース結果とするパーサ」を返す関数：

let pure v = fun cs -> Some (v, cs)

そしてapplyは「関数を返すパーサ」と「その関数の引数を返すパーサ」を組み合わせて「関数適用の結果を返すパーサ」を作成する関数：

let apply fp xp = fun cs -> (match fp cs with
  | None -> None
  | Some (f, cs') -> (map f xp) cs')

(* applyの中置演算子 *)
let (<*>) = apply

いくつか関連した演算子も追加：

let (<$>) = map

(* パーサ二つを順に組み合わせて左側のパーサの結果を結果とする *)
let ( <* ) xp yp = (fun x _ -> x) <$> xp <*> yp

(* パーサ二つを順に組み合わせて右側のパーサの結果を結果とする *)
let ( *> ) xp yp = (fun _ x -> x) <$> xp <*> yp

これで例えば「連続した二つの文字をとるパーサ」や「三つの文字を消費して真ん中の文字だけを結果として残すパーサ」などを定義できる：

let get_two = (fun x y -> [x;y]) <$> get_char <*> get_char
let get_middle = get_char *> get_char <* get_char

utop # parse get_two "ABC";;
- : (char list * char list) option = Some (['A'; 'B'], ['C'])

utop # parse get_middle "abc";;
- : (char * char list) option = Some ('b', [])

ついでにapplicative letも定義しておく：

let product xp yp = (fun x y -> (x, y)) <$> xp <*> yp

let (let+) x f = map f x
let (and+) xa ya = product xa ya

（Applicative Letについては前回の記事を参照してほしい）

Alternative

Applicativeをさらに強化して「二つのパーサのどちらかが成功したらそのパーサの結果を使う」というような合成を可能にしたい。Alternative Functorというらしい。

Alternativeのためにはまず「必ず失敗するパーサ」を定義する：

let empty = fun _ -> None

そして「二つのパーサのどちらかが成功したらそのパーサの結果を使う」を実現するeither：

let either xp yp = fun cs -> (match xp cs with
  | None -> yp cs
  | Some _ as r -> r)

(* eitherの中置演算子 *)
let (<|>) = either

Monad

ApplicativeやAlternativeを使うと成功したパース結果を別の値に変換したり組み合わせたり、失敗したら別のパーサを試したり、などとかなり表現力が強まる。ただ、パースした結果を元に次のパーサを選んだり、一つのパーサの結果を調べてパースを失敗させたり、などということはできない。

そういうことだってできちゃう、そう、Monadならね。

というわけでモナドの登場。すでにApplicativeであるParser.tをMonadとして使うために必要なのは、「a型を結果とするパーサ」と「aを引数に別のパーサを返す関数」を組み合わせるbind関数：

let bind xp fp = fun cs -> (match xp cs with
  | None -> None
  | Some (x, cs') -> fp x cs')

let (>>=) = bind

let (let*) x f = bind x f

これを使って：

let satisfy p =
  let* x = get_char in
  if p x
    then pure x
    else empty

というような関数が定義でき、さらに

(* 特定の文字ひとつ *)
let match_char c = satisfy (Char.equals c)

(* アルファベット小文字ひとつ *)
let match_lower =
  let p = function
    | 'a' .. 'z' -> true
    | _ -> false
  in
  satisfy p

(* アルファベット大文字ひとつ *)
let match_upper =
  let p = function
    | 'A' .. 'Z' -> true
    | _ -> false
  in
  satisfy p

(* 数字ひとつ *)
let match_digit =
  let p = function
    | '0' .. '9' -> true
    | _ -> false
  in
  satisfy p

(* アルファベット文字ひとつ *)
let match_letter = match_lower <|> match_upper

(* 英数字ひとつ *)
let match_alphanum = match_letter <|> match_digit

(* 空白一つ *)
let match_space =
  let p = function
    | ' ' | '\t' | '\n' | '\r' -> true
    | _ -> false
  in
  satisfy p

などと一気にいろいろできるようになる。

次回

Monadまでの機能を実装したところで長くなってきたので一旦ここまで。次回はこれを使ってsome、manyなどのコンビネータ、それらを使ってget_token、get_intなどのより複雑なパーサを作り、最終的には簡単な四則演算パーサ＆計算機を実装する。

ついでにHutton本に載っているHaskell版との比較などについても言及したい。

続き