如何使用Parsec解析簡單的命令式語言？

Question

我有一種簡單的語言，有以下語法

Expr -> Var | Int | Expr Op Expr  
Op -> + | - | * | / | % | == | != | < | > | <= | >= | && | ||  
Stmt -> Skip | Var := Expr | Stmt ; Stmt | write Expr | read Expr | while Expr do Stmt | if Expr then Stmt else Stmt

我正在使用Haskell的Parsec庫為該語言編寫簡單的解析器，而我遇到了一些麻煩

當我嘗試解析語句時，請skip ; skip skip ; skip我只獲得第一個“ Skip ，但是我想去獲得類似“ Colon Skip Skip

另外，當我嘗試解析分配時，我得到了無限遞歸。 例如，當我嘗試解析x := 1我的計算機掛斷了很長時間。

這是我的解析器的完整源代碼。 謝謝你的幫助！

module Parser where


import Control.Monad
import Text.Parsec.Language
import Text.ParserCombinators.Parsec
import Text.ParserCombinators.Parsec.Expr
import Text.ParserCombinators.Parsec.Language
import qualified Text.ParserCombinators.Parsec.Token as Token

type Id = String

data Op = Add
        | Sub
        | Mul
        | Div
        | Mod
        | Eq
        | Neq
        | Gt
        | Geq
        | Lt
        | Leq
        | And
        | Or deriving (Eq, Show)

data Expr = Var Id
          | Num Integer
          | BinOp Op Expr Expr deriving (Eq, Show)

data Stmt = Skip
          | Assign Expr Expr
          | Colon Stmt Stmt
          | Write Expr
          | Read Expr
          | WhileLoop Expr Stmt
          | IfCond Expr Stmt Stmt deriving (Eq, Show)

languageDef =
     emptyDef    { Token.commentStart    = ""
                 , Token.commentEnd      = ""
                 , Token.commentLine     = ""
                 , Token.nestedComments  = False
                 , Token.caseSensitive   = True
                 , Token.identStart      = letter
                 , Token.identLetter     = alphaNum
                 , Token.reservedNames   = [ "skip"
                                           , ";"
                                           , "write"
                                           , "read"
                                           , "while"
                                           , "do"
                                           , "if"
                                           , "then"
                                           , "else"
                                           ]
                 , Token.reservedOpNames = [ "+"
                                           , "-"
                                           , "*"
                                           , "/"
                                           , ":="
                                           , "%"
                                           , "=="
                                           , "!="
                                           , ">"
                                           , ">="
                                           , "<"
                                           , "<="
                                           , "&&"
                                           , "||"
                                           ]
                }

lexer = Token.makeTokenParser languageDef

identifier = Token.identifier lexer
reserved   = Token.reserved   lexer
reservedOp = Token.reservedOp lexer
semi       = Token.semi       lexer
parens     = Token.parens     lexer
integer    = Token.integer    lexer
whiteSpace = Token.whiteSpace lexer

ifStmt :: Parser Stmt
ifStmt = do
    reserved "if"
    cond <- expression
    reserved "then"
    action1 <- statement
    reserved "else"
    action2 <- statement
    return $ IfCond cond action1 action2

whileStmt :: Parser Stmt
whileStmt = do
    reserved "while"
    cond <- expression
    reserved "do"
    action <- statement
    return $ WhileLoop cond action

assignStmt :: Parser Stmt
assignStmt = do
    var <- expression
    reservedOp ":="
    expr <- expression
    return $ Assign var expr

skipStmt :: Parser Stmt
skipStmt = do
    reserved "skip"
    return Skip

colonStmt :: Parser Stmt
colonStmt = do
    s1 <- statement
    reserved ";"
    s2 <- statement
    return $ Colon s1 s2

readStmt :: Parser Stmt
readStmt = do
    reserved "read"
    e <- expression
    return $ Read e

writeStmt :: Parser Stmt
writeStmt = do
    reserved "write"
    e <- expression
    return $ Write e

statement :: Parser Stmt
statement = colonStmt
            <|> assignStmt
            <|> writeStmt
            <|> readStmt
            <|> whileStmt
            <|> ifStmt
            <|> skipStmt

expression :: Parser Expr
expression = buildExpressionParser operators term

term = fmap Var identifier
        <|> fmap Num integer
        <|> parens expression

operators = [ [Infix (reservedOp "==" >> return (BinOp Eq)) AssocNone,
              Infix (reservedOp "!=" >> return (BinOp Neq)) AssocNone,
              Infix (reservedOp ">"  >> return (BinOp Gt)) AssocNone,
              Infix (reservedOp ">=" >> return (BinOp Geq)) AssocNone,
              Infix (reservedOp "<"  >> return (BinOp Lt)) AssocNone,
              Infix (reservedOp "<=" >> return (BinOp Leq)) AssocNone,
              Infix (reservedOp "&&" >> return (BinOp And)) AssocNone,
              Infix (reservedOp "||" >> return (BinOp Or)) AssocNone]

            , [Infix (reservedOp "*"  >> return (BinOp Mul)) AssocLeft,
              Infix (reservedOp "/"  >> return (BinOp Div)) AssocLeft,
              Infix (reservedOp "%"  >> return (BinOp Mod)) AssocLeft]

            , [Infix (reservedOp "+"  >> return (BinOp Add)) AssocLeft,
               Infix (reservedOp "-"  >> return (BinOp Sub)) AssocLeft]
            ]

parser :: Parser Stmt
parser = whiteSpace >> statement

parseString :: String -> Stmt
parseString str =
    case parse parser "" str of
        Left e -> error $ show e
        Right r -> r`

Answer 1

這是基於解析器組合器的解析器的一個常見問題： statement是左遞歸的，因為它的第一個模式是colonStmt ，而colonStmt要做的第一件事就是嘗試再次解析一個statement 。 眾所周知，解析器組合器在這種情況下不會終止。

從statement解析器中刪除了colonStmt模式，其他部分工作正常：

> parseString "if (1 == 1) then skip else skip"
< IfCond (BinOp Eq (Num 1) (Num 1)) Skip Skip
> parseString "x := 1"
< Assign (Var "x") (Num 1)

---

該解決方案已在此repo中進行了全面描述，沒有許可證文件，因此我真的不知道引用代碼是否安全，通常的想法是在解析任何語句時添加另一層解析器：

statement :: Parser Stmt
statement = do
    ss <- sepBy1 statement' (reserved ";")
    if length ss == 1
        then return $ head ss
        else return $ foldr1 Colon ss

statement' :: Parser Stmt
statement' = assignStmt
            <|> writeStmt
            <|> readStmt
            <|> whileStmt
            <|> ifStmt
            <|> skipStmt