我试图解析简单输入的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);
,但我无法让它发挥作用。
答案 0 :(得分:2)
请包含您的导入 - 这样可以更轻松地使用您的代码。
我认为我已经通过修改所有令牌解析器来使你的解析器工作,以便在令牌之后立即消耗空白。
例如,将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