4

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

例如，我想将以下句子中的“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”不会产生所需的输出，因为“选择”返回第一个成功的解析器，而我真正想要的是第一个成功的解析器，同时消耗最少的字符。这就是我接下来要尝试的方法，方法是保留已解析输入的源位置并使用具有最低源位置的解析器。

这种情况似乎很常见，我觉得我错过了一些明显的组合符咒语。谁能提供更好的建议？

谢谢！

-deech

4

2 回答 2

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
于 2012-02-10T18:42:40.420 回答
0

据我了解，您希望重复解析到您看到的第一个有趣的单词。目前，您正在解析每个有趣的单词并检查您找到的哪个有趣的单词更接近。

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

是的，这并不能回答确定哪个解析器匹配最短的问题。这通过为您的实际问题提供解决方案来回避该问题，而该解决方案并不关心哪个解析器匹配最短。

于 2012-02-10T21:33:27.983 回答