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
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
|
module Reader
( read_str )
where
import Text.ParserCombinators.Parsec (
Parser, parse, space, char, digit, letter, try,
(<|>), oneOf, noneOf, many, many1, skipMany, skipMany1, sepEndBy)
import qualified Data.Map as Map
import Control.Monad (liftM)
import Types
spaces :: Parser ()
spaces = skipMany1 (oneOf ", \n")
comment :: Parser ()
comment = do
char ';'
skipMany (noneOf "\r\n")
ignored :: Parser ()
ignored = skipMany (spaces <|> comment)
symbol :: Parser Char
symbol = oneOf "!#$%&|*+-/:<=>?@^_~"
escaped :: Parser Char
escaped = do
char '\\'
x <- oneOf "\\\"n"
case x of
'n' -> return '\n'
_ -> return x
read_number :: Parser MalVal
read_number = liftM (MalNumber . read) $ many1 digit
read_string :: Parser MalVal
read_string = do
char '"'
x <- many (escaped <|> noneOf "\\\"")
char '"'
return $ MalString x
read_symbol :: Parser MalVal
read_symbol = do
first <- letter <|> symbol
rest <- many (letter <|> digit <|> symbol)
let str = first:rest
return $ case str of
"true" -> MalTrue
"false" -> MalFalse
"nil" -> Nil
_ -> MalSymbol str
read_keyword :: Parser MalVal
read_keyword = do
char ':'
x <- many (letter <|> digit <|> symbol)
return $ MalString $ "\x029e" ++ x
read_atom :: Parser MalVal
read_atom = read_number
<|> read_string
<|> read_keyword
<|> read_symbol
read_list :: Parser MalVal
read_list = do
char '('
x <- sepEndBy read_form ignored
char ')'
return $ MalList x Nil
read_vector :: Parser MalVal
read_vector = do
char '['
x <- sepEndBy read_form ignored
char ']'
return $ MalVector x Nil
-- TODO: propagate error properly
_pairs [x] = error "Odd number of elements to _pairs"
_pairs [] = []
_pairs (MalString x:y:xs) = (x,y):_pairs xs
read_hash_map :: Parser MalVal
read_hash_map = do
char '{'
x <- sepEndBy read_form ignored
char '}'
return $ MalHashMap (Map.fromList $ _pairs x) Nil
-- reader macros
read_quote :: Parser MalVal
read_quote = do
char '\''
x <- read_form
return $ MalList [MalSymbol "quote", x] Nil
read_quasiquote :: Parser MalVal
read_quasiquote = do
char '`'
x <- read_form
return $ MalList [MalSymbol "quasiquote", x] Nil
read_splice_unquote :: Parser MalVal
read_splice_unquote = do
char '~'
char '@'
x <- read_form
return $ MalList [MalSymbol "splice-unquote", x] Nil
read_unquote :: Parser MalVal
read_unquote = do
char '~'
x <- read_form
return $ MalList [MalSymbol "unquote", x] Nil
read_deref :: Parser MalVal
read_deref = do
char '@'
x <- read_form
return $ MalList [MalSymbol "deref", x] Nil
read_with_meta :: Parser MalVal
read_with_meta = do
char '^'
m <- read_form
x <- read_form
return $ MalList [MalSymbol "with-meta", x, m] Nil
read_macro :: Parser MalVal
read_macro = read_quote
<|> read_quasiquote
<|> try read_splice_unquote <|> read_unquote
<|> read_deref
<|> read_with_meta
--
read_form :: Parser MalVal
read_form = do
ignored
x <- read_macro
<|> read_list
<|> read_vector
<|> read_hash_map
<|> read_atom
return $ x
read_str :: String -> IOThrows MalVal
read_str str = case parse read_form "Mal" str of
Left err -> throwStr $ show err
Right val -> return val
|
