2019-12-11 18:29:28 -08:00
|
|
|
module LambdaCalculus.Parser (parseExpression) where
|
2019-08-29 20:46:42 -07:00
|
|
|
|
2019-12-11 18:29:28 -08:00
|
|
|
import Control.Applicative ((*>))
|
2019-08-29 20:46:42 -07:00
|
|
|
import Control.Monad (void)
|
2019-12-11 18:29:28 -08:00
|
|
|
import LambdaCalculus.Expression (Expression (Variable, Application, Abstraction))
|
|
|
|
import Text.Parsec hiding (spaces)
|
|
|
|
import Text.Parsec.String
|
2019-08-29 20:46:42 -07:00
|
|
|
|
2019-12-11 18:29:28 -08:00
|
|
|
spaces :: Parser ()
|
|
|
|
spaces = void $ many1 space
|
2019-08-29 20:46:42 -07:00
|
|
|
|
2019-12-11 18:29:28 -08:00
|
|
|
variableName :: Parser String
|
|
|
|
variableName = many1 letter
|
2019-08-29 20:46:42 -07:00
|
|
|
|
|
|
|
variable :: Parser Expression
|
2019-12-11 18:29:28 -08:00
|
|
|
variable = Variable <$> variableName
|
2019-08-29 20:46:42 -07:00
|
|
|
|
|
|
|
application :: Parser Expression
|
2019-12-11 18:29:28 -08:00
|
|
|
application = foldl1 Application <$> sepBy1 applicationTerm spaces
|
|
|
|
where applicationTerm :: Parser Expression
|
|
|
|
applicationTerm = variable <|> abstraction <|> grouping
|
|
|
|
where grouping :: Parser Expression
|
|
|
|
grouping = between (char '(') (char ')') expression
|
2019-08-29 20:46:42 -07:00
|
|
|
|
2019-12-11 18:29:28 -08:00
|
|
|
abstraction :: Parser Expression
|
|
|
|
abstraction = do
|
|
|
|
char '^'
|
|
|
|
names <- sepBy1 variableName spaces
|
|
|
|
char '.'
|
2019-08-29 20:46:42 -07:00
|
|
|
body <- expression
|
2019-12-11 18:29:28 -08:00
|
|
|
pure $ foldr Abstraction body names
|
2019-08-29 20:46:42 -07:00
|
|
|
|
|
|
|
expression :: Parser Expression
|
2019-12-11 18:29:28 -08:00
|
|
|
expression = abstraction <|> application <|> variable
|
2019-08-29 20:46:42 -07:00
|
|
|
|
2019-12-11 18:29:28 -08:00
|
|
|
parseExpression :: String -> Either ParseError Expression
|
|
|
|
parseExpression = parse (expression <* eof) "input"
|