-
-
Notifications
You must be signed in to change notification settings - Fork 0
/
LCParser.hs
47 lines (40 loc) · 1.18 KB
/
LCParser.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
module LCParser where
import Data.Char
import Data.Void
import Text.Megaparsec
import Text.Megaparsec.Char
import LCTerm
type Parser = Parsec Void String
readTermIO :: String -> IO (Maybe Term)
readTermIO t = case parse parseTerm "readTermIO" t of
Left bundle -> putStrLn (errorBundlePretty bundle) >> return Nothing
Right term -> return (Just term)
parens :: Parser a -> Parser a
parens = between (char '(') (char ')')
stripParens :: Parser a -> Parser a
stripParens p = stripParensOnly p <|> p
where
stripParensOnly :: Parser a -> Parser a
stripParensOnly p = do
first <- some (char '(')
inner <- p
second <- string (replicate (length first) ')')
return inner
parseTerm :: Parser Term
parseTerm = do
terms <- some $
parens (try parseAbst <|> try parseVar) <|>
(try parseAbst <|> try parseVar)
return $ foldl1 Appl terms
parseAbst :: Parser Term
parseAbst = stripParens $ do
_ <- satisfy (\c -> c == 'λ' || c == '\\')
(Var v) <- parseVar
_ <- char '.'
body <- parseTerm
return $ Abst v body
parseVar :: Parser Term
parseVar = stripParens $ do
base <- letterChar
primes <- many (char '\'')
return $ Var (base:primes)