parsing - uu-parsinglib での計画外の貪欲な動作

Question

問題

今日問題が発生しましたが、解決方法がわかりません。私が書いたコードは (私の現在の知識によると) 正しいはずなので、私には非常に奇妙です。

以下に、サンプルのパーサー コンビネータを示します。最も重要なものはpOperator、非常に単純な方法 (デモンストレーション目的のみ) でオペレーター AST を構築する です。「x」を消費し、空白で区切られた複数の「x」を消費できます。

pParens次のように定義されたコンビネータもあります。

pPacked pParenL (pWSpaces *> pParenR)

そのため、括弧を閉じる前に空白を消費します。

サンプル入出力

正しい入出力は次のようにする必要があります:

in: "(x)"
out: Single "x"

in: "(x )"
out: Single "x"

しかし、私は得ています:

in: "(x)"
out: Single "x"

in: "(x )" 
out: Multi (Single "x") (Single "x")
--  Correcting steps: 
--    Inserted  'x' at position LineColPos 0 3 3 expecting one of ['\t', ' ', 'x']

しかし、2 番目の例ではエラーが発生します。パーサーは、いくつかのトークンを貪欲に食べるように動作します (貪欲な操作はありません)。

私はそれを手伝ってくれてありがとう。

サンプルコード

import Prelude hiding(lex)
import Data.Char hiding (Space)
import qualified Text.ParserCombinators.UU as UU
import           Text.ParserCombinators.UU hiding(parse)
import qualified Text.ParserCombinators.UU.Utils as Utils
import           Text.ParserCombinators.UU.BasicInstances hiding (Parser)


data El = Multi El El
        | Single String
        deriving (Show)


---------- Example core grammar ----------

pElement     = Single <$> pSyms "x"
pOperator    = applyAll <$> pElement <*> pMany (flip <$> (Multi <$ pWSpaces1) <*> pElement)

---------- Basic combinators ----------

applyAll x (f:fs) = applyAll (f x) fs
applyAll x []     = x

pSpace    = pSym ' '
pTab      = pSym '\t'
pWSpace   = pSpace <|> pTab
pWSpaces  = pMany pWSpace
pWSpaces1 = pMany1 pWSpace
pMany1 p  = (:) <$> p <*> pMany p

pSyms []       = pReturn []
pSyms (x : xs) = (:) <$> pSym x <*> pSyms xs

pParenL     = Utils.lexeme $ pSym '('
pParenR     = Utils.lexeme $ pSym ')'
pParens     = pPacked pParenL (pWSpaces *> pParenR)

---------- Program ----------

pProgram = pParens pOperator
-- if you replace it with following line, it works:
--  pProgram = pParens pElement
-- so it seems like something in pOperator is greedy

tests = [ ("test", "(x)")
        , ("test", "(x )")
        ]

---------- Helpers ----------

type Parser a = P (Str Char String LineColPos) a

parse p s = UU.parse ( (,) <$> p <*> pEnd) (createStr (LineColPos 0 0 0) s)

main :: IO ()
main = do 
    mapM_ (\(desc, p) -> putStrLn ("\n=== " ++ desc ++ " ===") >> run pProgram p) tests
    return ()

run :: Show t =>  Parser t -> String -> IO ()
run p inp = do  let (a, errors) =  parse p inp
                putStrLn ("--  Result: \n" ++ show a)
                if null errors then  return ()
                               else  do putStr ("--  Correcting steps: \n")
                                        show_errors errors
                putStrLn "-- "
             where show_errors :: (Show a) => [a] -> IO ()
                   show_errors = sequence_ . (map (putStrLn . show))

重要

pOperator    = applyAll <$> pElement <*> pMany (flip <$> (Multi <$ pWSpaces1) <*> pElement)

次と同等です。

foldr pChainl pElement (Multi <$ pWSpaces1)

に従って: Combinator Parsing: A Short Tutorial

また、演算子の優先順位を定義するために使用されます。