Commit | Line | Data |
---|---|---|
b76aa73b JM |
1 | module Reader |
2 | ( read_str ) | |
3 | where | |
4 | ||
5 | import Text.ParserCombinators.Parsec ( | |
2988d38e | 6 | Parser, parse, space, char, digit, letter, try, |
fa9a9758 | 7 | (<|>), oneOf, noneOf, many, many1, skipMany, skipMany1, sepEndBy) |
b76aa73b | 8 | import qualified Data.Map as Map |
b76aa73b JM |
9 | |
10 | import Types | |
11 | ||
12 | spaces :: Parser () | |
fa9a9758 JM |
13 | spaces = skipMany1 (oneOf ", \n") |
14 | ||
15 | comment :: Parser () | |
16 | comment = do | |
17 | char ';' | |
18 | skipMany (noneOf "\r\n") | |
19 | ||
20 | ignored :: Parser () | |
21 | ignored = skipMany (spaces <|> comment) | |
b76aa73b JM |
22 | |
23 | symbol :: Parser Char | |
24 | symbol = oneOf "!#$%&|*+-/:<=>?@^_~" | |
25 | ||
26 | escaped :: Parser Char | |
27 | escaped = do | |
28 | char '\\' | |
29 | x <- oneOf "\\\"n" | |
30 | case x of | |
31 | 'n' -> return '\n' | |
32 | _ -> return x | |
33 | ||
34 | read_number :: Parser MalVal | |
328384f3 DM |
35 | read_number = do |
36 | x <- many1 digit | |
37 | return $ MalNumber $ read x | |
38 | ||
39 | read_negative_number :: Parser MalVal | |
40 | read_negative_number = do | |
41 | sign <- char '-' | |
42 | rest <- many1 digit | |
43 | return $ MalNumber $ read $ sign:rest | |
b76aa73b JM |
44 | |
45 | read_string :: Parser MalVal | |
46 | read_string = do | |
47 | char '"' | |
b76aa73b JM |
48 | x <- many (escaped <|> noneOf "\\\"") |
49 | char '"' | |
50 | return $ MalString x | |
51 | ||
52 | read_symbol :: Parser MalVal | |
53 | read_symbol = do | |
54 | first <- letter <|> symbol | |
55 | rest <- many (letter <|> digit <|> symbol) | |
56 | let str = first:rest | |
57 | return $ case str of | |
58 | "true" -> MalTrue | |
59 | "false" -> MalFalse | |
60 | "nil" -> Nil | |
61 | _ -> MalSymbol str | |
62 | ||
63 | read_keyword :: Parser MalVal | |
64 | read_keyword = do | |
65 | char ':' | |
66 | x <- many (letter <|> digit <|> symbol) | |
c150ec41 | 67 | return $ MalString $ "\x029e" ++ x |
b76aa73b JM |
68 | |
69 | read_atom :: Parser MalVal | |
70 | read_atom = read_number | |
328384f3 | 71 | <|> try read_negative_number |
b76aa73b JM |
72 | <|> read_string |
73 | <|> read_keyword | |
74 | <|> read_symbol | |
75 | ||
76 | read_list :: Parser MalVal | |
77 | read_list = do | |
78 | char '(' | |
fa9a9758 | 79 | x <- sepEndBy read_form ignored |
b76aa73b | 80 | char ')' |
c150ec41 | 81 | return $ MalList x Nil |
b76aa73b JM |
82 | |
83 | read_vector :: Parser MalVal | |
84 | read_vector = do | |
85 | char '[' | |
fa9a9758 | 86 | x <- sepEndBy read_form ignored |
b76aa73b | 87 | char ']' |
c150ec41 JM |
88 | return $ MalVector x Nil |
89 | ||
90 | -- TODO: propagate error properly | |
91 | _pairs [x] = error "Odd number of elements to _pairs" | |
92 | _pairs [] = [] | |
93 | _pairs (MalString x:y:xs) = (x,y):_pairs xs | |
b76aa73b | 94 | |
b76aa73b JM |
95 | read_hash_map :: Parser MalVal |
96 | read_hash_map = do | |
97 | char '{' | |
fa9a9758 | 98 | x <- sepEndBy read_form ignored |
b76aa73b | 99 | char '}' |
c150ec41 | 100 | return $ MalHashMap (Map.fromList $ _pairs x) Nil |
b76aa73b | 101 | |
c150ec41 | 102 | -- reader macros |
2988d38e JM |
103 | read_quote :: Parser MalVal |
104 | read_quote = do | |
105 | char '\'' | |
106 | x <- read_form | |
c150ec41 | 107 | return $ MalList [MalSymbol "quote", x] Nil |
2988d38e JM |
108 | |
109 | read_quasiquote :: Parser MalVal | |
110 | read_quasiquote = do | |
111 | char '`' | |
112 | x <- read_form | |
c150ec41 | 113 | return $ MalList [MalSymbol "quasiquote", x] Nil |
2988d38e JM |
114 | |
115 | read_splice_unquote :: Parser MalVal | |
116 | read_splice_unquote = do | |
117 | char '~' | |
118 | char '@' | |
119 | x <- read_form | |
c150ec41 | 120 | return $ MalList [MalSymbol "splice-unquote", x] Nil |
2988d38e JM |
121 | |
122 | read_unquote :: Parser MalVal | |
123 | read_unquote = do | |
124 | char '~' | |
125 | x <- read_form | |
c150ec41 JM |
126 | return $ MalList [MalSymbol "unquote", x] Nil |
127 | ||
128 | read_deref :: Parser MalVal | |
129 | read_deref = do | |
130 | char '@' | |
131 | x <- read_form | |
132 | return $ MalList [MalSymbol "deref", x] Nil | |
2988d38e | 133 | |
c150ec41 JM |
134 | read_with_meta :: Parser MalVal |
135 | read_with_meta = do | |
136 | char '^' | |
137 | m <- read_form | |
138 | x <- read_form | |
139 | return $ MalList [MalSymbol "with-meta", x, m] Nil | |
2988d38e JM |
140 | |
141 | read_macro :: Parser MalVal | |
142 | read_macro = read_quote | |
143 | <|> read_quasiquote | |
144 | <|> try read_splice_unquote <|> read_unquote | |
c150ec41 JM |
145 | <|> read_deref |
146 | <|> read_with_meta | |
147 | ||
148 | -- | |
b76aa73b JM |
149 | |
150 | read_form :: Parser MalVal | |
151 | read_form = do | |
fa9a9758 | 152 | ignored |
2988d38e JM |
153 | x <- read_macro |
154 | <|> read_list | |
155 | <|> read_vector | |
156 | <|> read_hash_map | |
157 | <|> read_atom | |
b76aa73b JM |
158 | return $ x |
159 | ||
5400d4bf | 160 | read_str :: String -> IOThrows MalVal |
b76aa73b | 161 | read_str str = case parse read_form "Mal" str of |
5400d4bf | 162 | Left err -> throwStr $ show err |
b76aa73b | 163 | Right val -> return val |