Parsec chainl1 失败

Question

我正在尝试从简单类型的 lambda 演算 (F1) 中解析表达式，但我对 Parsec 有点吃力，而且我终其一生都想不出如何解决我的问题。

我有以下 ADT：

newtype LambdaVar = LV Char
  deriving (Eq, Ord)

data Type
  = TBool
  | TNat
  | Arr Type Type
  deriving Eq

data LambdaExpr
  = Abstr LambdaVar Type LambdaExpr
  | App LambdaExpr LambdaExpr
  | Var LambdaVar
  deriving Eq

newtype TypeContext = TC [(LambdaVar, Type)]
  deriving (Eq, Show)

data Expression = Expr TypeContext LambdaExpr Type
  deriving (Eq, Show)

使用此解析器：

type ParserT a b = ParsecT String a Identity b

parens :: ParserT a b -> ParserT a b
parens = between (char '(') (char ')')

symbol :: String -> ParserT a String
symbol p = spaces *> string p <* spaces

typeParser :: CharParser () Type
typeParser = arr <|> tbool <|> tnat
  where tbool = const TBool <$> string "Bool"
        tnat = const TNat <$> string "Nat"
        subtyp = parens arr <|> tbool <|> tnat
        arr = chainr1 subtyp $ try (symbol "->" *> pure Arr)

lambdaParser :: CharParser () LambdaExpr
lambdaParser = expr
  where expr = pApp <|> pAbstr <|> pVar
        pVar = Var . LV <$> letter
        pAbstr = Abstr <$> (LV <$> (char '\' *> letter)) <*> (symbol ":" *> typeParser) <*> (char '.' *> expr)
        pApp = chainl1 subExpr (char ' ' *> pure App)
        subExpr = parens pApp <|> pAbstr <|> pVar

typeContextParser :: CharParser () TypeContext
typeContextParser = TC <$> ((,) <$> (LV <$> letter <* symbol ":") <*> typeParser) `sepBy` try (symbol ",")

expressionParser :: CharParser () Expression
expressionParser = Expr <$> (typeContextParser <* symbol "|-") <*> (lambdaParser <* symbol ":") <*> try typeParser

parse :: String -> Either ParseError Expression
parse = P.parse expressionParser ""

现在问题出现了，即试图解析像

这样的表达式

|- \x:Bool -> Nat.\y:Bool.x y : (Bool -> Nat) -> Bool -> Nat

我尝试解析它，我会得到一个错误：

unexpected ":"
expecting "(", "\" or letter

所以这里发生的是我在 x y 之后有一个 space 所以解析器假设这将是一个应用程序但是然后找到一个它无法解析的 :一个，但我不知道如何纠正这种行为。我想我不得不用 try 以某种方式回溯，但我就是做不到。

Answer 1

请包含您的导入 - 它使您的代码更容易使用。

我想我已经让你的解析器工作了，方法是修改所有令牌解析器，使其也使用紧跟在令牌后面的白色 space。

例如，将char x替换为(char x) <* spaces，将string "->"替换为(string "->") <* spaces，等等

这是工作代码：

{-# LANGUAGE NoMonomorphismRestriction, FlexibleContexts #-}

import Text.Parsec 
import qualified Text.Parsec as P
import Text.Parsec.Expr
import Text.ParserCombinators.Parsec.Char
import Data.Functor.Identity

newtype LambdaVar = LV Char
  deriving (Eq, Ord, Show)

data Type
  = TBool
  | TNat
  | Arr Type Type
  deriving (Eq, Show)

data LambdaExpr
  = Abstr LambdaVar Type LambdaExpr
  | App LambdaExpr LambdaExpr
  | Var LambdaVar
  deriving (Eq, Show)

newtype TypeContext = TC [(LambdaVar, Type)]
  deriving (Eq, Show)

data Expression = Expr TypeContext LambdaExpr Type
  deriving (Eq, Show)

type ParserT a b = ParsecT String a Identity b

lexeme p = p <* spaces

lchar = lexeme . char
lstring = lexeme . string

parens :: ParserT a b -> ParserT a b
parens = between (lchar '(') (lchar ')')

symbol :: String -> ParserT a String
symbol p = string p <* spaces

typeParser :: CharParser () Type
typeParser = arr <|> tbool <|> tnat
  where tbool = const TBool <$> lstring "Bool"
        tnat = const TNat <$> lstring "Nat"
        subtyp = parens arr <|> tbool <|> tnat
        arr = chainr1 subtyp $ try (symbol "->" *> pure Arr)

lambdaParser :: CharParser () LambdaExpr
lambdaParser = expr
  where expr = pApp <|> pAbstr <|> pVar
        pVar = Var . LV <$> (lexeme letter)
        pAbstr = Abstr <$> (LV <$> (lchar '\' *> letter)) <*> (symbol ":" *> typeParser) <*> (lchar '.' *> expr)
        pApp = chainl1 subExpr (pure App)
        subExpr = parens pApp <|> pAbstr <|> pVar

typeContextParser :: CharParser () TypeContext
typeContextParser = TC <$> ((,) <$> (LV <$> letter <* symbol ":") <*> typeParser) `sepBy` try (symbol ",")

expressionParser :: CharParser () Expression
expressionParser = Expr <$> (typeContextParser <* symbol "|-") <*> (lambdaParser <* symbol ":") <*> try typeParser

parseIt :: String -> Either ParseError Expression
parseIt = P.parse expressionParser ""

test1 = parseIt
  "|- \x:Bool -> Nat.\y:Bool.x y : (Bool -> Nat) -> Bool -> Nat"
-- 1234 56789.123456789 .123456789.
--           1          2

Parsec chainl1 失败

Parsec chainl1 on failure

haskell

parsec