Wie parse ich einfache imperative Sprache mit Parsec?

Question

Ich habe eine einfache Sprache mit folgenden Grammatik

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 

ich für diese Sprache einfach Parser Haskells Parsec Bibliothek schreibe, und ich bin mit einigen Dingen stecken

Wenn ich versuche, skip ; skip i nur zu analysieren Anweisung bekommen zuerst Skip, aber ich möchte gehen etwas wie Colon Skip Skip

Auch wenn ich versuche, die Zuordnung zu analysieren, bekomme ich eine unendliche Rekursion. Zum Beispiel, wenn ich versuche, x := 1 zu analysieren, legt mein Computer für lange Zeit auf.

Hier ist der vollständige Quellcode meines Parsers. Danke für jede Hilfe!

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

Es ist ein häufiges Problem von Parsern auf Parser Combinator zugrunde: statement ist linksrekursive als erstes Muster colonStmt, und das erste, was colonStmt werden versuchen zu tun ist wieder ein statement Parsen. Parser-Kombinatoren sind bekanntlich in diesem Fall nicht terminiert.

Entfernt die colonStmt Muster aus statement Parser und die anderen Teile gearbeitet passend:

> 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) 

---

Die Lösung vollständig in this repo beschrieben wird, gibt es keine Lizenz-Datei, so ich nicht wirklich wissen, ob es sicher ist, Um auf den Code zu verweisen, besteht die allgemeine Idee darin, beim Analysieren einer beliebigen Anweisung eine weitere Parser-Schicht hinzuzufügen:

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