blob: 33b3c447aba03ae29575f8d07dd7bec3c7897cef (
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
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
|
module Parser
( parseLine
, parseReplLine
) where
import Control.Monad ( ap )
import Data.Functor.Identity
import Helper
import Text.Parsec hiding ( parseTest )
import Text.Parsec.Language
import qualified Text.Parsec.Token as Token
languageDef :: GenLanguageDef String u Identity
languageDef = emptyDef { Token.commentLine = "#"
, Token.identStart = letter <|> char '_'
, Token.identLetter = alphaNum <|> oneOf "?!'_"
, 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
almostAnything :: Parser String
almostAnything =
many1 $ oneOf ".`#~@$%^&*_+-=|;',/?[]<>(){} " <|> letter <|> digit
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
parseNumeral :: Parser Expression
parseNumeral = do
num <- number
spaces
pure $ decimalToTernary num
where
sign = (char '-' >> return negate) <|> (char '+' >> return id)
nat = read <$> many1 digit
number = ap sign nat
parseVariable :: Parser Expression
parseVariable = do
var <- identifier
spaces
pure $ Variable var
parseSingleton :: Parser Expression
parseSingleton =
parseBruijn
<|> parseNumeral
<|> parseAbstraction
<|> parens parseApplication
<|> parseVariable
parseExpression :: Parser Expression
parseExpression = do
spaces
expr <- parseApplication <|> parseSingleton
spaces
pure expr
parseEvaluate :: Parser Instruction
parseEvaluate = Evaluate <$> parseExpression
parseDefine :: Parser Instruction
parseDefine = do
var <- identifier
spaces
Define var <$> parseExpression
parseReplDefine :: Parser Instruction
parseReplDefine = do
var <- identifier
spaces
reservedOp "="
spaces
Define var <$> parseExpression
parseComment :: Parser Instruction
parseComment = string "#" >> Comment <$> almostAnything
parseLoad :: Parser Instruction
parseLoad = string ":load " >> Load <$> almostAnything
parseTest :: Parser Instruction
parseTest = do
string ":test "
exp1 <- parseExpression
spaces
reservedOp "="
spaces
exp2 <- parseExpression
pure $ Test exp1 exp2
parseLine :: Parser Instruction
parseLine = try parseDefine <|> try parseComment <|> try parseTest
parseReplLine :: Parser Instruction
parseReplLine =
try parseReplDefine
<|> try parseComment
<|> try parseEvaluate
<|> try parseLoad
<|> try parseTest
|
