kyoheiu.dev/blog
各パーサーコンビネータにおけるtry/eof(endOfInput)の挙動
/code
#Haskell #Megaparsec #Attoparsec #Parsec

Advent of Code 2020のDay 19を解いていて、複数パーサーの選択でしばらくつまずいていたのでメモ。

TL;DR

  • MegaparsecおよびParsecでは、tryでくるんだパーサー内でeofを使うと正常に動かない場合がある？
  • Attoparsecではchoice内でも問題なくendOfInputが動く。

テキストを直和型のリストにパースする

Day 19では次のようなテキストを適切にパースすることが求められる。

0: 4 1 5
1: 2 3 | 3 2
2: 4 4 | 5 5
3: 4 5 | 5 4
4: "a"
5: "b"

これを、ひとまず次のような型としてパースしたい。

data Rule: Zero [Int]
          | Pairs Int [(Int,Int)]
          | Key Int Char
          deriving Show

-- expected result
[Zero [4,1,5],Pairs 1 [(2,3),(3,2)],Pairs 2 [(4,4),(5,5)],Pairs 3 [(4,5),(5,4)],Key 4 'a',Key 5 'b']
  • ０から始まる行は「特殊ルール」として、Zero [Int]で拾う。
  • それ以外の行は、
    • 数字と”|“のみの行についてはPairsで、
    • アルファベットが含まれる行はKeyで拾う。

Magaparsec - tryで失敗してくれない？

最初に使ったのはMegaparsec。このソースコードから始めよう。

import qualified Data.Map.Strict as M
import Text.Megaparsec
import Text.Megaparsec.Char
import qualified Data.Text as T
import Data.Void
import Data.Either (rights)

type Parser: Parsec Void String

readInt x: read x :: Int

data Rule: Zero [Int]
          | Pairs Int [(Int,Int)]
          | Key Int Char
          deriving Show

zero :: Parser Rule
zero: do
  string "0: "
  list <- sepBy1 (many alphaNumChar) (char ' ')
  return $ Zero (map readInt list)

pair :: Parser (Int,Int)
pair: do
  y <- many digitChar
  char ' '
  z <- many digitChar
  return (readInt y, readInt z)

pairs :: Parser Rule
pairs: do
  n <- readInt <$> many alphaNumChar
  string ": "
  p <- sepBy1 pair (string " | ")
  return $ Pairs n p

key :: Parser Rule
key: do
  n <- readInt <$> many alphaNumChar
  string ": \""
  c <- letterChar
  char '\"'
  return $ Key n c

rules: try zero <|> key <|> pairs

main: readFile "day19e.txt" >>= print . rights . map (parse rules "") . lines

cabal replでmainを実行すると、結果はこうなる。

[Zero [4,1,5],Key 4 'a',Key 5 'b']

Data.Eitherのrightsで強制的にRightのみを抽出しているので分かりにくいが、２〜４行めはパースに失敗している。ちなみにエラーメッセージはかなり難解。

Right (Zero [4,1,5]),Left (ParseErrorBundle {bundleErrors: TrivialError 1 (Just (Tokens (':' :| " 2"))) (fromList [Tokens (':' :| " \""),Label ('a' :| "lphanumeric character")]) :| [], bundlePosState: PosState {pstateInput: "1: 2 3 | 3 2", pstateOffset: 0, pstateSourcePos: SourcePos {sourceName: "", sourceLine: Pos 1, sourceColumn: Pos 1}, pstateTabWidth: Pos 8, pstateLinePrefix: ""}}),Left (ParseErrorBundle {bundleErrors: TrivialError 1 (Just (Tokens (':' :| " 4"))) (fromList [Tokens (':' :| " \""),Label ('a' :| "lphanumeric character")]) :| [], bundlePosState: PosState {pstateInput: "2: 4 4 | 5 5", pstateOffset: 0, pstateSourcePos: SourcePos {sourceName: "", sourceLine: Pos 1, sourceColumn: Pos 1}, pstateTabWidth: Pos 8, pstateLinePrefix: ""}}),Left (ParseErrorBundle {bundleErrors: TrivialError 1 (Just (Tokens (':' :| " 4"))) (fromList [Tokens (':' :| " \""),Label ('a' :| "lphanumeric character")]) :| [], bundlePosState: PosState {pstateInput: "3: 4 5 | 5 4", pstateOffset: 0, pstateSourcePos: SourcePos {sourceName: "", sourceLine: Pos 1, sourceColumn: Pos 1}, pstateTabWidth: Pos 8, pstateLinePrefix: ""}}),Right (Key 4 'a'),Right (Key 5 'b')]

色々と試行錯誤した結果わかったのは、tryでくるんでいるからといって必ず適切なパーサーを選択してくれるわけではない（適切に選択してもらうためには工夫が必要）ということ。

たとえば２行目の1: 2 3 | 3 2のみをパースしてみると、

*Main> parseTest rules "1: 2 3 | 3 2"
1:2:
  |
1 | 1: 2 3 | 3 2
  |  ^^^
unexpected ": 2"
expecting ": "" or alphanumeric character

tryでくるんでいるから最終的にはpairsを使ってパースしてくれるはずなのに、そうなっていない。
ちなみにpairs単体でパースすると、

*Main> parseTest pairs "1: 2 3 | 3 2"
Pairs 1 [(2,3),(3,2)]

となって正しい結果が出るので、pairs自体にミスがあるわけではなさそうだ。

rulesはまずzeroをトライするが、string "0: "にマッチしないので失敗し、backtrackが発生する。
次にkeyをトライする。そうすると、最初のmany alphaNumCharは成功するが、次のstring ": \""は失敗するのでまたbacktrackが発生する…はずなのだがそうならず、パースは失敗に終わる。

try以降の選択肢の順番なのか？

最初に、tryのくるみ方に問題があるのかもしれないと考えて、tryのあとを色々と変えてみた。すると実際、rules: try key <|> zero <|> pairsとした場合は、

[Zero [4,1,5],Pairs 1 [(2,3),(3,2)],Pairs 2 [(4,4),(5,5)],Pairs 3 [(4,5),(5,4)],Key 4 'a',Key 5 'b']

となり成功している。

さらに、rules: try key <|> pairs <|> zeroの場合。

[Pairs 0 [(4,1)],Pairs 1 [(2,3),(3,2)],Pairs 2 [(4,4),(5,5)],Pairs 3 [(4,5),(5,4)],Key 4 'a',Key 5 'b']

一見成功しているように見えるが、第１行めがZeroではなくPairsでのパースになってしまっているので間違っている。

zero, pairs, keyの順番を入れ替えて試した結果は以下の通り。

orderresultT/F
zero key pairs[Zero [4,1,5],Key 4 'a',Key 5 'b']F
zero pairs key[Zero [4,1,5],Pairs 1 [(2,3),(3,2)],Pairs 2 [(4,4),(5,5)],Pairs 3 [(4,5),(5,4)]]F
pairs zero key[Pairs 0 [(4,1)],Pairs 1 [(2,3),(3,2)],Pairs 2 [(4,4),(5,5)],Pairs 3 [(4,5),(5,4)],Key 4 'a',Key 5 'b']F
pairs key zero[Pairs 0 [(4,1)],Pairs 1 [(2,3),(3,2)],Pairs 2 [(4,4),(5,5)],Pairs 3 [(4,5),(5,4)],Key 4 'a',Key 5 'b']F
key zero pairs[Zero [4,1,5],Pairs 1 [(2,3),(3,2)],Pairs 2 [(4,4),(5,5)],Pairs 3 [(4,5),(5,4)],Key 4 'a',Key 5 'b']T
key pairs zero[Pairs 0 [(4,1)],Pairs 1 [(2,3),(3,2)],Pairs 2 [(4,4),(5,5)],Pairs 3 [(4,5),(5,4)],Key 4 'a',Key 5 'b']F

このあたりで薄々ストーリーが見えてくる。zeroで拾いたいのにpairsになってしまっているのは、0: 4 1 5で言うと”1”まではpairsで拾えてしまえることがまず発端になっている。それだけなら残りを失敗するのでいいじゃないか、となりそうだが、途中でパースが止まっても成功扱いとなり、次の行に進んでしまう。

実際、

pairs :: Parser Rule
pairs: do
  n <- readInt <$> many alphaNumChar
  string ": "
  p <- sepBy pair (string " | ")
  return $ Pairs n p

と、sepBy1からsepByにしてみると、結果は

[Zero [4,1,5],Pairs 1 [(2,3),(3,2)],Pairs 2 [(4,4),(5,5)],Pairs 3 [(4,5),(5,4)],Pairs 4 [],Pairs 5 []]

となって最後の２行がpairsで拾われてしまっていることがわかる。

Megaparsecでのeofの挙動

4: "a"がpairsではなくkeyで拾うべき行だということをプログラムに伝えるには、try以降のパーサーの順番をあれこれいじるよりもeofを使えばよいのではないか、と思いつき、以下のようにしてみる。

zero :: Parser Rule
zero: do
  string "0: "
  list <- sepBy1 (many alphaNumChar) (char ' ')
  eof
  return $ Zero (map readInt list)

pair :: Parser (Int,Int)
pair: do
  y <- readInt <$> many alphaNumChar
  char ' '
  z <- readInt <$> many alphaNumChar
  return (y,z)

pairs :: Parser Rule
pairs: do
  n <- readInt <$> many alphaNumChar
  string ": "
  p <- sepBy1 pair (string " | ")
  eof
  return $ Pairs n p

key :: Parser Rule
key: do
  n <- readInt <$> many alphaNumChar
  string ": \""
  c <- letterChar
  char '\"'
  eof
  return $ Key n c

しかし結果は変わらず、

-- try zero <|> pairs <|> key
[Zero [4,1,5],Pairs 1 [(2,3),(3,2)],Pairs 2 [(4,4),(5,5)],Pairs 3 [(4,5),(5,4)]]

入力の終了にのみマッチするはずのeofが動いていない。

念のため、テストパーサーを書いてみるとこちらはちゃんと機能する。

test :: Parser String
test: do
  s <- many alphaNumChar
  eof
  return s

---

*Main> parseTest test "aaa"
"aaa"
*Main> parseTest test "aaa111"
"aaa111"
---1:7:
|
--- | ^
unexpected '+'
expecting alphanumeric character or end of input

Attoparsecでの挙動

つまり、tryでくるんだパーサーにおいてeofがちゃんと動いていないのではないか？ということだ。 どこかのコードが間違っている可能性も十分あるし、ソースコードを読んでいないのでMegaparsecの調査としてはここまでなのだが、本来であれば、try以降のパーサーの順序は極力考慮せず組み立てられるのが理想…だと思うので、これは困る。ちなみに、後に検証してみたところ、Parsecのtry/eofでも同じ問題が発生する。

そこで、試しにAttoparsecを使ってみるとこちらはうまくいった。

import Data.Attoparsec.Text
import qualified Data.Text as T
import qualified Data.Text.IO as TIO
import Data.Either (rights)

readInt x: read x :: Int

data Rule: Zero [Int]
          | Pairs Int [(Int,Int)]
          | Key Int Char
          deriving Show

zero :: Parser Rule
zero: do
  string "0: "
  list <- many1 digit `sepBy1` char ' '
  endOfInput
  return $ Zero (map readInt list)

pair :: Parser (Int,Int)
pair: do
  x <- readInt <$> many1 digit
  space
  y <- readInt <$> many1 digit
  return (x,y)

pairs :: Parser Rule
pairs: do
  n <- readInt <$> many1 digit
  string ": "
  p <- sepBy1 pair (string " | ")
  endOfInput
  return $ Pairs n p

key :: Parser Rule
key: do
  n <- readInt <$> many1 digit
  string ": \""
  c <- letter
  char '\"'
  endOfInput
  return $ Key n c

rules: choice [pairs, key, zero]

main: TIO.readFile "day19e.txt" >>= print . rights . map (parseOnly rules) . T.lines

---

*Main> main
[Zero [4,1,5],Pairs 1 [(2,3),(3,2)],Pairs 2 [(4,4),(5,5)],Pairs 3 [(4,5),(5,4)],Key 4 'a',Key 5 'b']

もちろん、choice以降のリスト内の順序をどのパターンにしても、結果は変わらなかった。

ちなみに各パーサーのendOfInputを外すと、

-- rules: choice [pairs, key, zero]
[Pairs 0 [(4,1)],Pairs 1 [(2,3),(3,2)],Pairs 2 [(4,4),(5,5)],Pairs 3 [(4,5),(5,4)],Key 4 "a",Key 5 "b"]

となって１行目をpairsで拾ってしまっているので、やっぱりendOfInputが機能していることがわかる。

コード自体はほぼ変わらない。主な変更点としては、

MegaparsecAttoparsec
trychoice
eofendOfInput

まず１点め、tryでなくchoiceを使うというのは、Attoparsecがデフォルトで失敗時backtrackをする仕様のためで、これは素晴らしい（tryも実装されているが、これはParsecとの互換性のためと明記されている）。
そしてMegaparsecのeofとAttoparsecのendOfInputは、どうやら局所的に違う挙動をするらしい。（MegaparsecとParsecがこの点で同じ動きをしたのは、MegaparsecがParsecのフォークだからかもしれない）

同じようなディテールで頭を悩ませている人がいたら、参考になれば幸いです。