Question

我想知道解析输入的最佳方法，其中多个解析器可以成功。我已经概述了我的第一次失败的尝试和一个不优雅的解决方案，我希望这可以更加惯用。

例如，我想将以下句子中的“the”，“quick”和“fox”列为自己的数据构造函数：

"the quick brown fox jumps over the lazy dog".

因此给出了以下类型构造函数：

data InterestingWord = Quick | The | Fox deriving Show
data Snippet = Word InterestingWord | Rest String deriving Show

我希望解析的输出为：

[Word The,
 Rest " ", Word Quick,
 Rest " brown ", Word Fox,
 Rest " jumped over ", Word The,
 Rest " lazy dog"]

以下是两个解决方案：

import Text.Parsec
import Data.Maybe
import Data.Ord    
import Data.List

data InterestingWord = Quick | The | Fox deriving Show
data Snippet = Word InterestingWord | Rest String deriving Show

testCase = "the quick brown fox jumped over the lazy dog"
-- Expected output:
-- [Word The,
--  Rest " ", Word Quick,
--  Rest " brown ", Word Fox,
--  Rest " jumped over ", Word The,
--  Rest " lazy dog"]

toString Quick = "quick"
toString The = "the"
toString Fox = "fox"

-- First attempt

-- Return characters upto the intended word along
-- with the word itself
upto word = do
  pre <- manyTill anyChar $ lookAhead $ string (toString word)
  word' <- try $ string (toString word)
  return [Rest pre, Word word]

-- Parsers for the interesting words
parsers = [upto Quick,
           upto The, 
           upto Fox]

-- Try each parser and return its results with the 
-- rest of the input.
-- An incorrect result is produced because "choice"
-- picks the first successful parse result.
wordParser = do
  snippets <- many $ try $ choice parsers
  leftOver <- many anyChar
  return $ concat $ snippets ++ [[Rest leftOver]]

-- [Rest "the ",Word Quick,Rest " brown fox jumped over the lazy dog"]        
test1 = parseTest wordParser testCase

-- Correct

-- In addition to the characters leading upto the 
-- word and the word, the position is also returned
upto' word = do
  result <- upto word
  pos <- getPosition
  return (pos, result)

-- The new parsers         
parsers' = [upto' Quick,
            upto' The, 
            upto' Fox]

-- Try each of the given parsers and 
-- possibly returning the results and
-- the parser but don't consume
-- input.
tryAll = mapM (\p -> do
                 r <- optionMaybe $ try (lookAhead p)
                 case r of
                   Just result -> return $ Just (p, result)
                   Nothing -> return $ Nothing
              )

-- Pick the parser that has consumed the least.             
firstSuccess ps = do
  successes <- tryAll ps >>= return . catMaybes
  if not (null successes) then
      return $ Just (fst $ head (sortBy (comparing (\(_,(pos,_)) -> pos)) successes))
  else return $ Nothing

-- Return the parse results for the parser that 
-- has consumed the least
wordParser' = do
  parser <- firstSuccess parsers'
  case parser of
    Just p -> do
      (_,snippet) <- p
      return snippet
    Nothing -> parserZero

-- Returns the right result
test2 = parseTest (many wordParser' >>= return . concat) testCase

第一次尝试“test1”没有产生所需的输出，因为“choice”返回第一个成功的解析器，当我真正想要的是第一个在消耗最少字符时成功的解析器。这是我接下来尝试通过保持一次输入的源位置并使用具有最低源位置的解析器来尝试下一步。

这种情况似乎很常见，我觉得我错过了一些明显的组合咒语。任何人都可以提供更好的建议吗？

谢谢！

-deech

Answer 1

这不是一个特别常见的需求，但这是一个实现：

import Control.Monad
import "parsec3" Text.Parsec
import Data.Maybe
import Data.List
import Data.Ord

longestParse :: [Parsec String () a] -> Parsec String () a
longestParse parsers = do
  allParses <- sequence [lookAhead $ optionMaybe $ try $ 
    liftM2 (,) parse getPosition | parse <- parsers]
  -- allParses :: [Maybe (a, SourcePos)]
  (bestParse, bestPos) <- case catMaybes allParses of
    [] -> fail "No valid parse" -- maybe we can do something better?
    successfulParses -> return $ minimumBy (comparing snd) successfulParses
  setPosition bestPos
  return bestParse

Answer 2

据我所知，你想反复解析你看到的第一个有趣的单词。目前，您正在解析每个有趣的单词，并检查您发现哪个有趣的单词更接近。

我的建议是定义一个解析器来检查你当前是否有一个有趣的词（只有其中一个选择可以成功，所以没有必要做任何比简单选择更好的事情）。然后你继续前进，直到第一个解析器成功，这发生在遇到任何有趣的单词时。这给你第一个有趣的词，因为在它包含任何有趣的词之前你什么都不知道。

是的，这不能回答确定哪个解析器匹配最短的问题。这样可以通过解决您的实际问题来回避这个问题，而这个问题并不关心哪个解析器匹配最短。

在单个输入上选择多个正确的解析器

2 个答案: