chainl と左再帰

Parsec などが利用する再帰下降構文解析では、左再帰が無限ループに陥るという問題がある。例えば、以下の BNF で定義される数式を考える。

expr ::= expr '+' term | term
term ::= term '*' factor | factor
factor :: = '(' expr ')' | nat
nat = '0' | '1' | ...

expr と term が分かれているのは、足し算と掛け算の結合力の違いを表現するためである。expr と term は、右辺の左端に自分自身が使われているので、これをそのまま実装すると無限ループに陥る。

data Expr = Expr :+ Expr
          | Expr :* Expr
          | Nat Int deriving Show

expr :: Parser Expr
expr = do
  e <- expr
  char '+' 
  t <- term
  return $ e :+ t
  <|> term

この問題を解決するために、Parsec では chainl というコンビネーターを提供しているのだと思っていたが、山下さんや酒井さんにそれは間違いだと教えて頂いた。chainl は左再帰を解決するのではなく、左再帰を除去したBNFを実装できるだけとのことだ。Wikipedia の再帰の除去を参考に BNF を変形すると、次のようになる。

expr ::= term expr'
expr' ::= '+' term expr' | ε
term ::= factor term'
term' ::= '*' factor term' | ε

BNF に0回以上の繰り返しを表す "*" という拡張を入れるとしたら、以下のようにも表現できる。

expr ::= term ('+' term)*
term ::= factor ('*' factor)*

こうなれば、chainl を使わなくても実装できそうだ。

expr :: Parser Expr
expr = lefty <$> term <*> terms
  where
    lefty x xs = foldl1 (:+) (x:xs)
    terms = many (char '+' *> term)

term :: Parser Expr
term = lefty <$> factor <*> factors
  where
    lefty x xs = foldl1 (:*) (x:xs)
    factors = many (char '*' *> factor)

factor :: Parser Expr
factor = (char '(' *> (expr <* char ')')) <|> nat

nat :: Parser Expr
nat = Nat . charToInt <$> oneOf ['0'..'9']
  where
    charToInt c = ord c - ord '0'

expr と term から、共通部分を抜き出せば chainl になる。ただ、chainl は数式の計算結果を返して面白くないので、ここでは構文木を返す chainL を実装してみる。

expr :: Parser Expr
expr = chainL term (() <$ char '+') (:+)

term :: Parser Expr
term = chainL factor (() <$ char '*') (:*)

chainL :: Parser Expr -> Parser () -> (Expr -> Expr -> Expr) -> Parser Expr
chainL p op f = lefty <$> p <*> ps
  where
    lefty x xs = foldl1 f (x:xs)
    ps = many (op *> p)

この chainL は 3 つ引数を取るのがかっこ悪い。そこで、第2引数と第3引数をマージした形で取れる chainL を考える。

expr :: Parser Expr
expr = term `chainL` ((:+) <$ char '+')

term :: Parser Expr
term = factor `chainL` ((:*) <$ char '*')

chainL :: Parser Expr -> Parser (Expr -> Expr -> Expr) -> Parser Expr
chainL p op = lefty <$> p <*> ps
  where
    lefty ini fs = foldl (flip ($)) ini fs
    ps = many (flip <$> op <*> p)

chainL が二項演算子として使えるので、かっこよくなった。しかし、中間データとしてリストを使っているのが無駄なような気がする。そこで、さらに贅肉を削ってみる。

chainL :: Parser Expr -> Parser (Expr -> Expr -> Expr) -> Parser Expr
chainL p op = p >>= op `chain` p

chain :: Parser (Expr -> Expr -> Expr) -> Parser Expr -> Expr -> Parser Expr
chain op p l = ((lefty <$> op <*> p) >>= chain op p) <|> pure l
  where
    lefty f r = l `f` r

とても奇麗になって、大満足。:)