関数型パーサー

もうすぐ Haskell の本が出版されるので復習する。
『プログラミング Haskell』 の第8章を今回は Scala(version 2.9.2) で書く。

Scala 的に使った方がいいらしいので Option や Either も勉強する。
Scala の API と以下を参考にしながら書いてみた。

• Java で Either モナド - xuwei-k's blog
• Modegramming Style: Scala Tips / Option - Index
• Modegramming Style: Scala Tips / Either - Index

まずはパターンマッチで

ほとんど変わらないはずだが、書籍よりも Code の Parsing.lhs と parser.lhs の方を参考にした。

• Page Redirection

object Parsers {
  type P[A] = Seq[Char] => Option[(A,Seq[Char])]

  implicit def parserWrapper[A](p: P[A]) = new {
    def >>=[B](f: A => P[B]): P[B] = inp => parse(p, inp) match {
      case None          => None
      case Some((v,out)) => parse(f(v), out)
    }
    def +++(q: P[A]): P[A] = inp => parse(p, inp) match {
      case None => parse(q, inp)
      case x    => x
    }
  }

  def parse[A](p: P[A], inp: Seq[Char]): Option[(A,Seq[Char])] = p(inp)

  def unit   [A](v: A): P[A]    = inp => Some((v,inp))
  def failure[A]      : P[A]    = inp => None
  def item            : P[Char] = inp => inp match {
    case Seq()         => None
    case Seq(v,out@_*) => Some((v,out))
  }

  def many [A](p: P[A]): P[Seq[A]] = many1(p) +++ unit(Seq.empty)
  def many1[A](p: P[A]): P[Seq[A]] = p >>= (v => many(p) >>= (vs => unit(v+:vs)))
  def token[A](p: P[A]): P[A]      = space >>= (_ => p >>= (v => space >>= (_ => unit(v))))

  val sat: (Char => Boolean) => P[Char] =
    p => item >>= (x => if (p(x)) unit(x) else failure)
  val digit      = sat(_.isDigit)
  val lower      = sat(_.isLower)
  val upper      = sat(_.isUpper)
  val alpha      = sat(_.isLetter)
  val alphanum   = sat(_.isLetterOrDigit)
  val char: Char => P[Char] = x => sat(_ == x)
  val string: String => P[String] = {
    case "" => unit("")
    case x  => char(x.head) >>= (_ => string(x.tail) >>= (_ => unit(x)))
  }
  val ident      = lower >>= (x => many(alphanum) >>= (xs => unit(x+:xs)))
  val nat        = many1(digit) >>= (xs => unit(xs.mkString.toInt))
  val int        = (char('-') >>= (_ => nat >>= (n => unit(-n)))) +++ nat
  val space      = many(sat(_.isWhitespace)) >>= (_ => unit())
  val identifier = token(ident)
  val natural    = token(nat)
  val integer    = token(int)
  val symbol: (String => P[String]) = xs => token(string(xs))
}

import Parsers._
lazy val expr: P[Int] = term >>= (t =>
                         (symbol("+") >>= (_ =>
                          expr        >>= (e =>
                          unit(t+e)))
                         ) +++ unit(t))
lazy val term: P[Int] = fact >>= (f =>
                         (symbol("*") >>= (_ =>
                          term        >>= (t =>
                          unit(f*t)))
                         ) +++ unit(f))
lazy val fact: P[Int] = (symbol("(") >>= (_ =>
                         expr        >>= (e =>
                         symbol(")") >>= (_ =>
                         unit(e))))
                        ) +++ natural
val eval = (xs: String) => parse(expr, xs.toSeq) match {
  case Some((n, Seq())) => n
  case Some((_, out))   => sys.error("unused input " + out.mkString)
  case None             => sys.error("invalid input")
}

assert( eval("2*3+4")       == 10 )
assert( eval("2*(3+4)")     == 14 )
assert( eval("2 * (3 + 4)") == 14 )

Option のメソッドを使う

パターンマッチは一覧性にすぐれるのだけれども Option でパターンマッチする場合に決まった形が現れる。
この部分の None => None は何度も書いていると飽きてくる...多分

    def >>=[B](f: A => P[B]): P[B] = inp => parse(p, inp) match {
      case None          => None
      case Some((v,out)) => parse(f(v), out)
    }

というわけで省略してしまう。

    def >>=[B](f: A => P[B]): P[B] =
      inp => parse(p, inp).flatMap{ case (v,out) => parse(f(v), out) }

Some を書かない代わりに flatMap でつなげるだけ。

もう一つの方も x => x は Some(y) => Some(y) なので何かメソッドがありそう。

    def +++(q: P[A]): P[A] = inp => parse(p, inp) match {
      case None => parse(q, inp)
      case x    => x
    }

しかし、Option の API を探してみたがこれと思えるものがなかった。

    def +++(q: P[A])        : P[A] =
      inp => parse(p, inp).toLeft(parse[A](q, inp)).fold(Option(_), identity)

toLeft で一旦 Either に変換して再度 fold で Option に戻している。
おそらく None => None の場合は flatMap で済むのでメソッドにすればよいが、
それ以外の場合は最初から Either を使うのだろう。

Either のメソッドを使う

パーサーの戻り値を Either 型に変更する。
まずはパターンマッチで

  type P[A] = Seq[Char] => Either[Unit,(A,Seq[Char])]

  implicit def parserWrapper[A](p: P[A]) = new {
    def >>=[B](f: A => P[B]): P[B] = inp => parse(p, inp) match {
      case Left(_)        => Left()
      case Right((v,out)) => parse(f(v), out)
    }
    def +++(q: P[A]): P[A] = inp => parse(p, inp) match {
      case Left(_) => parse(q, inp)
      case x       => x
    }

None が Left に、Some が Right に変わっただけ

これを Either のメソッドを使うように変更してみる。

  implicit def parserWrapper[A](p: P[A]) = new {
    def >>=[B](f: A => P[B]): P[B] = inp =>
      parse(p, inp).right flatMap{ case (v,out) => parse(f(v), out) }
    def +++   (q: P[A])     : P[A] = inp =>
      parse(p, inp).left  flatMap{ case _       => parse(q, inp) }
  }

両方とも flatMap になるので読みやすい。
.right や .left は 「Right だったら」や「Left だったら」と読める。

パーサーを生成している部分も変更しなくてはならない。
これも素直に None を Left に Some を Right に書き換えただけ。

  def unit   [A](v: A): P[A]    = inp => Right((v,inp))
  def failure[A]      : P[A]    = inp => Left()
  def item            : P[Char] = inp => inp match {
    case Seq()         => Left()
    case Seq(v,out@_*) => Right((v,out))
  }

item は Seq でパターンマッチしているがこれもパターンマッチでなくすことができる。

  def item            : P[Char] = inp => if (inp.isEmpty) Left() else Right((inp.head,inp.tail))

さらに Either のメソッドを使って

  def item            : P[Char] = inp => Either.cond(!inp.isEmpty, (inp.head,inp.tail), ())

左が Right で右が Left なので少しややこしい。

for 式を使う

調べていたら、第8章を Scala で実装されている方がいた。

• http://www.ayutaya.com/dev/scala/haskell-parser-generator
• http://svc.ayutaya.com/wordpress/2011/04/22/scala-haskell-parser-generato/

パーサーに map と flatMap が実装されていれば for 式が使えるらしい。

object Parsers {
  type P[A] = Seq[Char] => Either[Unit,(A,Seq[Char])]

  implicit def parserWrapper[A](p: P[A]) = new {
    def flatMap[B](f: A => P[B]): P[B] = inp =>
      parse(p, inp).right flatMap{ case (v,out) => parse(f(v), out) }
    def map    [B](f: A => B)   : P[B] = inp =>
      parse(p, inp).right flatMap{ case (v,out) => Right((f(v),out)) }
    def +++   (q: P[A])     : P[A] = inp =>
      parse(p, inp).left  flatMap{ case _       => parse(q, inp) }
  }

  def parse[A](p: P[A], inp: Seq[Char]) = p(inp)

  def unit   [A](v: A): P[A]    = inp => Right((v,inp))
  def failure[A]      : P[A]    = inp => Left()
  def item            : P[Char] = inp => Either.cond(!inp.isEmpty, (inp.head,inp.tail), ())

  def many [A](p: P[A]): P[Seq[A]] = many1(p) +++ unit(Seq.empty)
  def many1[A](p: P[A]): P[Seq[A]] = for (v <- p; vs <- many(p)) yield v+:vs
  def token[A](p: P[A]): P[A]      = for (_ <- space; v <- p;_ <- space) yield v

  val sat: (Char => Boolean) => P[Char] =
    p => for (x <- item; y <- if (p(x)) unit(x) else failure) yield(y)
  val digit      = sat(_.isDigit)
  val lower      = sat(_.isLower)
  val upper      = sat(_.isUpper)
  val alpha      = sat(_.isLetter)
  val alphanum   = sat(_.isLetterOrDigit)
  val char: Char => P[Char] = x => sat(_ == x)
  val string: String => P[String] = {
    case "" => unit("")
    case x  => for (_ <- char(x.head);_ <- string(x.tail)) yield x
  }
  val ident      = for (x <- lower; xs <- many(alphanum)) yield x+:xs
  val nat        = for (xs <- many1(digit)) yield xs.mkString.toInt
  val int        = (for (_ <- char('-'); n <- nat) yield -n) +++ nat
  val space      = for (_ <- many(sat(_.isWhitespace))) yield ()
  val identifier = token(ident)
  val natural    = token(nat)
  val integer    = token(int)
  val symbol: (String => P[String]) = xs => token(string(xs))
}

import Parsers._
lazy val expr: P[Int] = for {
                          t <- term
                          r <- (for {
                            _ <- symbol("+");
                            e <- expr
                          } yield t+e) +++ unit(t)
                        } yield r
lazy val term: P[Int] = for {
                          f <- fact
                          r <- (for {
                            _ <- symbol("*");
                            t <- term
                          } yield f*t) +++ unit(f)
                        } yield r
lazy val fact: P[Int] = (for {
                           _ <- symbol("(")
                           e <- expr
                           _ <- symbol(")")
                         } yield e) +++ natural
val eval = (xs: String) => parse(expr, xs.toSeq) match {
  case Right((n, Seq())) => n
  case Right((_, out))   => sys.error("unused input " + out.mkString)
  case Left(_)           => sys.error("invalid input")
}

assert( eval ("2*3+4")       == 10 )
assert( eval ("2*(3+4)")     == 14 )
assert( eval ("2 * (3 + 4)") == 14 )

flatMap だけでよさそうに思うが map がないとエラーになる。
eval でメソッド使ってないことに気づいたが、ここはパターンマッチの方が見やすいのでこのままにしておく。