-
Notifications
You must be signed in to change notification settings - Fork 0
/
Parser.hs
51 lines (40 loc) · 1.3 KB
/
Parser.hs
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
{-# LANGUAGE OverloadedStrings, LambdaCase #-}
module MiniLambda.Parser
( parseExpression
, expression
) where
import Control.Applicative
import Control.Monad
import Data.Bifunctor (second)
import MiniLambda.Parser.Internal
import MiniLambda hiding (lambda, (<.>))
-- parse to end and get result out of tuple
parseExpression :: String -> Either Error Expr
parseExpression = second fst . runParser expression
expression :: Parser Expr
expression = skipWhitespace *> expr <* skipWhitespace
where expr = variable
<|> lambda
<|> application
-- ascii alphanum + symbols, except '.', '\', '(', and ')'
letter = oneOf $ ['!'..'\''] ++ ['*'..'-'] ++ ['/'..'['] ++ [']'..'~']
identifier = many1 letter
variable = (Var <$> identifier) `debugWith` "Expected variable"
lambda = (`debugWith` "Expected lambda") . parenthesized $ do
char '\\' <|> char 'λ'
skipWhitespace
v <- identifier
skipWhitespace
char '.'
skipWhitespace
e <- expression
return $ Lambda v e
application = (`debugWith` "Expected application") . parenthesized $ do
e1 <- expression
skipWhitespace
e2 <- expression
return $ App e1 e2
-- helpers
skipWhitespace = (many $ char ' ') >> return ()
parenthesized p = char '(' *> skipWhitespace *> p <* skipWhitespace <* char ')'
debugWith p msg = p <|> perror msg