blob: 1f768bdb749af132c85fda22a7dfc40e31f65812 (
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
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
|
module Parser where
import Data.Functor.Identity
import Text.Parsec
import Text.Parsec.Language
import qualified Text.Parsec.Token as Token
data Error = SyntaxError ParseError | UndeclaredFunction String | InvalidIndex Int | FatalError String
instance Show Error where
show (SyntaxError err) = show err
show (UndeclaredFunction err) = "ERROR: undeclared function " <> show err
show (InvalidIndex err) = "ERROR: invalid index " <> show err
show (FatalError err) = show err
type Failable = Either Error
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 = Bruijn Int | Variable String | Abstraction Expression | Application Expression Expression
deriving (Ord, Eq, Show)
data Instruction = Define String Expression | Evaluate Expression | Comment String
deriving (Show)
parseAbstraction :: Parser Expression
parseAbstraction = do
reservedOp "["
exp <- parseExpression
reservedOp "]"
pure $ Abstraction exp
parseApplication :: Parser Expression
parseApplication = do
s <- sepBy1 parseSingleton spaces
pure $ foldl1 Application s
parseBruijn :: Parser Expression
parseBruijn = do
idx <- digit
spaces
pure $ Bruijn $ (read . pure) idx
parseVariable :: Parser Expression
parseVariable = do
var <- identifier
spaces
pure $ Variable var
parseSingleton :: Parser Expression
parseSingleton =
parseAbstraction <|> parens parseApplication <|> parseBruijn <|> parseVariable
parseExpression :: Parser Expression
parseExpression = do
expr <- parseApplication <|> parseSingleton
pure expr
parseDefine :: Parser Instruction
parseDefine = do
var <- identifier
spaces
Define var <$> parseExpression
parseComment :: Parser Instruction
parseComment = string "#" >> Comment <$> many letter
parseLine :: Parser Instruction
parseLine = try parseDefine <|> parseComment
parseReplLine :: Parser Expression
parseReplLine = try parseExpression
|
