Parsec chainl1失败

时间:2015-11-24 18:31:44

标签: haskell parsec

我试图解析简单输入的lambda演算(F1)中的表达式,而且我对Parsec有点挣扎,无法弄清楚我的生活如何解决我的问题。

我有以下ADT:

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

所以这里发生的事情是我在:之后有一个空格,所以解析器假设这将是一个应用程序,但后来发现一个try它不能解析为一个,但我没有想法如何纠正这种行为。我想我必须以某种方式回溯EmailService myEmailService = new EmailService(); myContainer.RegisterInstance<IMyService>(myEmailService); ,但我无法让它发挥作用。

1 个答案:

答案 0 :(得分:2)

请包含您的导入 - 这样可以更轻松地使用您的代码。

我认为我已经通过修改所有令牌解析器来使你的解析器工作,以便在令牌之后立即消耗空白。

例如,将char x替换为(char x) <* spacesstring "->"替换为(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