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

Parsec Parsing list of different kind of statements

我正在尝试(暂时)解析 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 "}"

我的理解是解析器选择第一个匹配规则(带回溯)。这里边和节点语句都是以and标识符开头的,所以它总是选择这个。

我尝试颠倒 stmt 中的顺序,但没有成功。 我还尝试在 stmt、nodeStmt 和 edgeStmt 中添加一些 try,但也不走运。

感谢任何帮助。

请注意,无论第 1 行是否被注释掉,我都会得到同样的错误,所以:

digraph PZIFOZBO{
        a->b
        }

也说 unexpected "-"

正如我认为您已经正确诊断的那样,这里的问题是 stmt 解析器首先尝试 nodeStmt。成功并解析 "a",留下 "->b" 尚未被使用,但 ->b 不是有效语句。请注意,Parsec 在没有 try 的情况下 不会 自动回溯,因此当它“发现” ->b 时,它不会返回并重新审视此决定无法解析。

您可以通过交换 stmt 中的顺序来“修复”此问题:

x <- edgeStmt <|> nodeStmt

但现在解析会在 a[toto = bar] 这样的表达式上中断。那是因为 edgeStmt 有问题。它将 "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

然后您的示例编译正常。