parsing - Parsec 解析不同类型语句的列表

Question

我正在尝试解析(目前)Dot 语言的一个子集。
语法是here我的代码如下

import System.Environment
import System.IO
import qualified Text.Parsec.Token as P
import Text.ParserCombinators.Parsec.Char -- for letter
import Text.Parsec
import qualified Control.Applicative as App

import Lib
type Id = String
data Dot = Undirected Id  Stmts
         | Directed Id  Stmts
         deriving (Show)

data Stmt = NodeStmt Node | EdgeStmt Edges
          deriving (Show)
type Stmts = [Stmt]

data Node = Node Id Attributes deriving (Show)
data Edge =  Edge Id Id deriving (Show)
type Edges = [Edge]

data Attribute = Attribute Id Id deriving (Show)
type Attributes = [Attribute]

dotDef :: P.LanguageDef st
dotDef = P.LanguageDef
  { P.commentStart    = "/*"
  , P.commentEnd      = "*/"
  , P.commentLine     = "//"
  , P.nestedComments  = True
  , P.identStart      = letter
  , P.identLetter     = alphaNum
  , P.reservedNames   = ["node", "edge", "graph", "digraph", "subgraph", "strict" ]
  , P.caseSensitive   = True
  , P.opStart         = oneOf "-="
  , P.opLetter        = oneOf "->"
  , P.reservedOpNames = []
  }



lexer = P.makeTokenParser dotDef

brackets    = P.brackets lexer
braces      = P.braces lexer

identifier  = P.identifier lexer
reserved    = P.reserved lexer

semi = P.semi lexer
comma = P.comma lexer

reservedOp = P.reservedOp lexer

eq_op = reservedOp "="
undir_edge_op = reservedOp "--"
dir_edge_op = reservedOp "->"

edge_op = undir_edge_op <|> dir_edge_op

-- -> Attribute
attribute = do
  id1 <- identifier
  eq_op
  id2 <- identifier
  optional (semi <|> comma)
  return $ Attribute id1 id2

a_list = many attribute

bracked_alist =
  brackets $ option [] a_list

attributes =
  do
    nestedAttributes <- many1 bracked_alist
    return $ concat nestedAttributes


nodeStmt = do
  nodeName <- identifier
  attr <- option [] attributes
  return $ NodeStmt $ Node nodeName attr

dropLast = reverse . tail . reverse

edgeStmt = do
  nodes <- identifier `sepBy1` edge_op
  return $ EdgeStmt $ fmap (\x -> Edge (fst x) (snd x)) (zip (dropLast nodes) (tail nodes))


stmt = do
  x <- nodeStmt <|> edgeStmt
  optional semi
  return x

stmt_list = many stmt
graphDecl = do
  reserved "graph"
  varName <- option "" identifier
  stms <- braces stmt_list
  return $ Undirected varName stms

digraphDecl = do
  reserved "digraph"
  varName <- option "" identifier
  stms <- braces stmt_list
  return $ Directed varName stms

topLevel3 = do
  spaces
  graphDecl <|> digraphDecl

main :: IO ()
main = do
  (file:_) <- getArgs
  content <- readFile file
  case parse topLevel3 "" content of
    Right g -> print g
    Left err -> print err

鉴于此输入

digraph PZIFOZBO{
        a[toto = bar] b ;   c  ; w  // 1
        a->b // 2
        }

如果第 1 行或第 2 行被注释，它工作正常，但如果两者都启用，它会失败

(line 3, column 10): unexpected "-" expecting identifier or "}"

我的理解是解析器选择第一个匹配规则(带回溯)。这里边和节点语句都以和标识符开头，所以它总是选择这个。
我尝试颠倒 stmt 中的顺序，没有任何运气。
我也试着撒一些 try在 stmt、nodeStmt 和 edgeStmt 中，也没有运气。
任何帮助表示赞赏。

Answer 1

请注意，无论第 1 行是否被注释掉，我都会收到相同的错误，因此:

digraph PZIFOZBO{
        a->b
        }

还说 unexpected "-" .
我认为您已经正确诊断，这里的问题是 stmt解析器尝试 nodeStmt第一的。成功并解析 "a" , 离开 "->b"尚未消耗，但 ->b不是有效的陈述。请注意，Parsec 确实是 不是 在没有 try 的情况下自动回溯，因此当它“发现” ->b 时，它不会回过头来重新审视这个决定。无法解析。
您可以通过交换 stmt 中的顺序来“修复”这个问题。 :

x <- edgeStmt <|> nodeStmt

但现在解析将在类似 a[toto = bar] 的表达式上中断.那是因为 edgeStmt是 buggy 。它解析 "a"作为有效声明 EdgeStmt []因为 sepBy1允许单边 "a" ，这不是您想要的。
如果重写 edgeStmt至少需要一条边:

import Control.Monad (guard)
edgeStmt = do
  nodes <- identifier `sepBy1` edge_op
  guard $ length nodes > 1
  return $ EdgeStmt $ fmap (\x -> Edge (fst x) (snd x)) (zip (dropLast nodes) (tail nodes))

并调整 stmt首先到“ try”一个边语句，然后回溯到一个节点语句:

stmt = do
  x <- try edgeStmt <|> nodeStmt
  optional semi
  return x

那么你的例子编译得很好。