Как разобрать простой императивный язык с использованием 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 и я застрял с некоторыми вещами

Когда я пытаюсь разобрать заявление 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. Комбинаторы Parser хорошо известны в этом случае не прекратятся.

Убрана colonStmt шаблон из statement парсер и другие части работали соответствующим образом:

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

---

Раствор полностью описан в this 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