0

我正在尝试为一种简单的语言编写解析器；基本上现在它有文字、ifs、函数应用程序，其他的不多。

这是我得到的代码：

import Text.ParserCombinators.Parsec
import Control.Monad (liftM)

data Expr = Term Term
          | Apply Expr Expr
          | If Expr Expr Expr
          deriving (Show)

data Term = Bool Bool
          | Num Double
          | String String
          | Identifier String
          | Parens Expr
          deriving (Show)

sstring s = spaces >> string s
schar c = spaces >> char c

keyword k = do
  kw <- try (sstring k)
  notFollowedBy alphaNum
  return kw

pBool :: Parser Bool
pBool = do
  bool <- keyword "True" <|> keyword "False"
  case bool of
    "True" -> return True
    "False" -> return False

pDouble :: Parser Double
pDouble = do
  ds <- many1 digit
  dot <- optionMaybe $ char '.'
  case dot of
    Nothing -> return $ read ds
    _ -> do
      ds' <- many1 digit
      return $ read (ds ++ "." ++ ds')

pString :: Parser String
pString = do
  char '"'
  str <- many1 $ noneOf "\""
  char '"'
  return str

pIdentifier :: Parser String
pIdentifier = spaces >> many1 letter

pParens :: Parser Expr
pParens = do
  schar '('
  expr <- pExpr
  schar ')'
  return expr

pTerm :: Parser Term
pTerm = try (liftM Bool pBool)
  <|> try (liftM Num pDouble)
  <|> try (liftM String pString)
  <|> try (liftM Identifier pIdentifier)
  <|> try (liftM Parens pParens)

-- TODO: make this left-associative
pApply :: Parser Expr
pApply = do
  term <- pTerm'
  mApp <- spaces >> optionMaybe pApply
  return $ case mApp of
    Just app -> Apply term app
    Nothing -> term

-- pulls "parens" expressions out of terms
pTerm' :: Parser Expr
pTerm' = do
  term <- pTerm
  case term of 
    Parens expr -> return expr
    otherwise -> return $ Term term

pIf :: Parser Expr
pIf = do
  keyword "if"
  cond <- pExpr
  keyword "then"
  ifTrue <- pExpr
  keyword "else"
  ifFalse <- pExpr
  return $ If cond ifTrue ifFalse

pExpr :: Parser Expr
pExpr = try pIf <|> pApply

test parser = parse parser ""

现在，如果我尝试在 ghci 中解析单个数字表达式，一切都很好：

> test pExpr "1"
Right (Term (Num 1.0))

伟大的！还有许多其他事情也有效：

> test pExpr "1.234"
Right (Term (Num 1.234))
> test pApply "neg 1"
Right (Apply (Term (Identifier "neg")) (Term (Num 1.0)))
> test pExpr "f g 1"
Right (Apply (Term (Identifier "f")) (Apply (Term (Identifier "g")) (Term (Num 1.0))))

但是现在，如果我尝试解析一个if语句，我会得到一个错误：

> test pIf "if 1 then 2 else 3"
Left (line 1, column 4):
unexpected "1"
expecting space, "if", "True", "False", letter or "("

这对我来说没有意义！让我们一步一步来，看看解析 if 语句的规则：

我们解析一个"if"关键字（没问题）。然后对于下一个解析（the 1），我们需要解析pExpr，它本身可以是 anpIf或 a pApply。好吧，这不是 if，所以我们尝试 apply，它本身尝试pTerm'，它尝试pTerm，它尝试 a pBool，它失败，然后 a pNum，它成功！然后pTerm以 a成功Num 1.0，因此pTerm'以 a 成功Term (Num 1.0)，这意味着pExpr以 a 成功Term (Num 1.0)，然后将其传递给cond变量...对吗？好吧，显然不是，因为它失败了！我不明白为什么它应该在这里失败。

4

2 回答 2

3

你有不吃所有空间的问题，并且then被else解释为标识符。规则对于lexeme在任何标记之后吃空间都很方便。您pIdentifier需要明确检查它是否没有吞噬保留字。我修复了这些问题，并冒昧地使用了一些现有的组合器，并改为应用风格......

import Text.ParserCombinators.Parsec
import Control.Applicative hiding ((<|>))

data Expr = Term Term
          | Apply Expr Expr
          | If Expr Expr Expr
          deriving (Show)

data Term = Bool Bool
          | Num Double
          | String String
          | Identifier String
          | Parens Expr
          deriving (Show)

keywords = ["if", "then", "else", "True", "False"]
lexeme p = p <* spaces
schar = lexeme . char

keyword k = lexeme . try $
  string k <* notFollowedBy alphaNum

pBool :: Parser Bool
pBool = (True <$ keyword "True") <|> (False <$ keyword "False")

pDouble :: Parser Double
pDouble = lexeme $ do
  ds <- many1 digit
  option (read ds) $ do
    char '.'
    ds' <- many1 digit
    return $ read (ds ++ "." ++ ds')

pString :: Parser String
pString = lexeme . between (char '"') (char '"') . many1 $ noneOf "\""

pIdentifier :: Parser String
pIdentifier = lexeme . try $ do
  ident <- many1 letter
  if ident `elem` keywords
    then unexpected $ "reserved word " ++ show ident
    else return ident

pParens :: Parser Expr
pParens = between (schar '(') (schar ')') pExpr

pTerm :: Parser Term
pTerm = choice [ Bool       <$> pBool
               , Num        <$> pDouble
               , String     <$> pString
               , Identifier <$> pIdentifier
               , Parens     <$> pParens
               ]

-- TODO: make this left-associative
pApply :: Parser Expr
pApply = do
  term <- pTerm'
  option term $
    Apply term <$> pApply

-- pulls "parens" expressions out of terms
pTerm' :: Parser Expr
pTerm' = do
  term <- pTerm
  case term of
    Parens expr -> return expr
    _ -> return $ Term term

pIf :: Parser Expr
pIf = If <$ keyword "if"   <*> pExpr 
         <* keyword "then" <*> pExpr
         <* keyword "else" <*> pExpr

pExpr :: Parser Expr
pExpr = pIf <|> pApply

test parser = parse (spaces *> parser <* eof) ""
于 2013-10-23T15:59:01.213 回答
1

你需要做一些改变。

pExpr :: Parser Expr
pExpr = try pIf <|> pTerm'


pIf :: Parser Expr
pIf = do
  keyword "if"
  spaces
  cond <- pExpr
  keyword "then"
  spaces
  ifTrue <- pExpr
  keyword "else"
  spaces
  ifFalse <- pExpr
  return $ If cond ifTrue ifFalse
于 2013-10-23T09:05:58.860 回答