blob: 611261f9e07e1733897efc1d34b662d9bbb36d02 (
plain) (
blame)
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
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
|
module Parser where
import Data.Functor.Identity
import Text.Parsec
import Text.Parsec.Language
import qualified Text.Parsec.Token as Token
languageDef :: GenLanguageDef String u Identity
languageDef = emptyDef { Token.commentLine = "#"
, Token.identStart = letter
, Token.identLetter = alphaNum <|> char '_'
, Token.reservedOpNames = ["[", "]"]
}
type Parser = Parsec String ()
lexer :: Token.GenTokenParser String u Identity
lexer = Token.makeTokenParser languageDef
identifier :: Parser String
identifier = Token.identifier lexer
reservedOp :: String -> Parser ()
reservedOp = Token.reservedOp lexer
parens :: Parser a -> Parser a
parens = Token.parens lexer
data Expression = Index Int | Abstraction Int Expression | Application Expression Expression
deriving (Ord, Eq)
data Instruction = Define String Expression | Evaluate Expression | Comment String
parseAbstraction :: Parser Expression
parseAbstraction = do
reservedOp "["
idc <- endBy1 digit spaces
build idc <$> parseExpression
where
build (idx : idc) body =
Abstraction ((read . pure :: Char -> Int) idx) $ build idc body
curry [] body = body
parseApplication :: Parser Expression
parseApplication = do
s <- sepBy1 parseSingleton spaces
pure $ foldl1 Application s
parseSingleton :: Parser Expression
parseSingleton = parseAbstraction <|> parens parseApplication
parseExpression :: Parser Expression
parseExpression = do
expr <- parseApplication <|> parseSingleton
pure expr
parseDefine :: Parser Instruction
parseDefine = do
var <- identifier
space
Define var <$> parseExpression
parseLine :: Parser Instruction
parseLine = try parseDefine
parseReplLine :: Parser Expression
parseReplLine = try parseExpression
|
