blob: 23bf7232ea806f3688a045355246cc3683a296b1 (
plain)
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
|
module Unlambda.Parser (
parseUnlambda,
parseUnlambda1
) where
import Control.Applicative( some )
import Data.Either
import Text.ParserCombinators.Parsec
import Unlambda.Types
parseUnlambda :: String -> Either ParseError UnlambdaTerm
parseUnlambda input =
let firstPass = parse removeComments "error" input
in case firstPass of
Left e -> Left e
Right o -> parse unlambda "error" o
parseUnlambda1 :: String -> Either ParseError UnlambdaTerm
parseUnlambda1 input =
let firstPass = parse removeComments "error" input
in case firstPass of
Left e -> Left e
Right o -> parse unlambda1 "error" o
removeComments = uline `sepEndBy` eol >>= (return . concat)
uline = do
l <- many (builtin <|> (oneOf " \t" >>= return . (:[])))
optional (char '#' >> many (noneOf "\r\n"))
return . concat $ l
builtin = (oneOf "`skivrdce|@" >>= return . (:[]))
<|> (char '.' >> anyChar >>= return . ('.':) . (:[]))
<|> (char '?' >> anyChar >>= return . ('?':) . (:[]))
<?> "unlambda builtin function"
eol = try (string "\r\n")
<|> try (string "\n\r")
<|> try (string "\r")
<|> try (string "\n")
<?> "end of line"
unlambda = do
whiteSpace
t <- term
eof
return t
unlambda1 = do
whiteSpace
t <- term1
eof
return t
term = (try term1)
<|> (try e)
<|> (try reed)
<|> (try comp)
<|> (try bar)
<?> "unlambda term"
term1 = (try app)
<|> (try s)
<|> (try k)
<|> (try i)
<|> (try v)
<|> (try r)
<|> (try d)
<|> (try c)
<|> (try dot)
<?> "unlambda term"
app = do
char '`'
whiteSpace
f <- term
x <- term
return (App f x)
s = char 's' >> whiteSpace >> return S
k = char 'k' >> whiteSpace >> return K
i = char 'i' >> whiteSpace >> return I
v = char 'v' >> whiteSpace >> return V
r = char 'r' >> whiteSpace >> return R
d = char 'd' >> whiteSpace >> return D
c = char 'c' >> whiteSpace >> return C
e = char 'e' >> whiteSpace >> return E
reed = char '@' >> whiteSpace >> return Reed
bar = char '|' >> whiteSpace >> return Bar
comp = do
char '?'
c <- anyChar
whiteSpace
return (Compare c)
dot = do
char '.'
c <- anyChar
whiteSpace
return (Dot c)
whiteSpace = many (oneOf "\t\n\r ")
|
