Finish splitting up headers. All tests pass.
Chris Pressey
10 years ago
1 | 1 | * Copyright (c)2014 Chris Pressey, Cat's Eye Technologies. |
2 | 2 | * Distributed under a BSD-style license; see LICENSE for more information. |
3 | 3 | */ |
4 | ||
5 | /* | |
6 | #include <assert.h> | |
7 | #include <stdio.h> | |
8 | #include <stdlib.h> | |
9 | #include <string.h> | |
10 | */ | |
11 | 4 | |
12 | 5 | #ifndef TAMSIN_SCANNER_H |
13 | 6 | #define TAMSIN_SCANNER_H |
2 | 2 | * Distributed under a BSD-style license; see LICENSE for more information. |
3 | 3 | */ |
4 | 4 | |
5 | #include <assert.h> | |
6 | ||
5 | 7 | #include "tamsin.h" |
6 | 8 | |
7 | struct term APOS = {"'", 1, -1, NULL}; | |
9 | const struct term APOS = {"'", 1, -1, NULL}; | |
10 | const struct term BRA = { "(", 1, -1, NULL }; | |
11 | const struct term KET = { ")", 1, -1, NULL }; | |
12 | const struct term COMMA = { ", ", 2, -1, NULL }; | |
8 | 13 | |
9 | 14 | int tamsin_isupper(char c) { |
10 | 15 | return (c >= 'A' && c <= 'Z'); |
266 | 271 | |
267 | 272 | return term_new_atom_from_cstring(buffer); |
268 | 273 | } |
274 | ||
275 | /** repr **/ | |
276 | ||
277 | /* | |
278 | * Returns the number of extra bytes we'll need to allocate to escape | |
279 | * this string. 0 indicates it does not need to be escaped. | |
280 | * control/high character = +3 (\xXX) | |
281 | * apos or backslash = +1 (\\, \') | |
282 | */ | |
283 | static int escapes_needed(const char *text, size_t size) { | |
284 | int i; | |
285 | int needed = 0; | |
286 | ||
287 | for (i = 0; i < size; i++) { | |
288 | if (text[i] < 32 || text[i] > 126) { | |
289 | needed += 3; | |
290 | } else if (text[i] == '\'' || text[i] == '\\') { | |
291 | needed += 1; | |
292 | } | |
293 | } | |
294 | ||
295 | return needed; | |
296 | } | |
297 | ||
298 | static int all_bareword(const char *text, size_t size) { | |
299 | int i; | |
300 | ||
301 | for (i = 0; i < size; i++) { | |
302 | if (tamsin_isalnum(text[i]) || text[i] == '_') { | |
303 | } else { | |
304 | return 0; | |
305 | } | |
306 | } | |
307 | ||
308 | return 1; | |
309 | } | |
310 | ||
311 | const char *HEX = "0123456789abcdef"; | |
312 | ||
313 | static const struct term *term_escape_atom(const struct term *t) { | |
314 | int needed; | |
315 | ||
316 | if (t->size == 0) { | |
317 | return term_new_atom("''", 2); | |
318 | } | |
319 | ||
320 | needed = escapes_needed(t->atom, t->size); | |
321 | ||
322 | if (needed > 0) { | |
323 | const struct term *r; | |
324 | char *buffer = malloc(t->size + needed); | |
325 | int i, j = 0; | |
326 | ||
327 | for (i = 0; i < t->size; i++) { | |
328 | if (t->atom[i] < 32 || t->atom[i] > 126) { | |
329 | buffer[j++] = '\\'; | |
330 | buffer[j++] = 'x'; | |
331 | buffer[j++] = HEX[(t->atom[i] >> 4) & 0x0f]; | |
332 | buffer[j++] = HEX[t->atom[i] & 0x0f]; | |
333 | } else if (t->atom[i] == '\'' || t->atom[i] == '\\') { | |
334 | buffer[j++] = '\\'; | |
335 | buffer[j++] = t->atom[i]; | |
336 | } else { | |
337 | buffer[j++] = t->atom[i]; | |
338 | } | |
339 | } | |
340 | assert(j == t->size + needed); | |
341 | ||
342 | r = term_new_atom("'", 1); | |
343 | r = term_concat(r, term_new_atom(buffer, t->size + needed)); | |
344 | r = term_concat(r, term_new_atom("'", 1)); | |
345 | free(buffer); | |
346 | ||
347 | return r; | |
348 | } else if (all_bareword(t->atom, t->size)) { | |
349 | /* TODO: can we eliminate this copy? */ | |
350 | return term_new_atom(t->atom, t->size); | |
351 | } else { | |
352 | const struct term *r; | |
353 | ||
354 | r = term_new_atom("'", 1); | |
355 | r = term_concat(r, t); | |
356 | r = term_concat(r, term_new_atom("'", 1)); | |
357 | ||
358 | return r; | |
359 | } | |
360 | } | |
361 | ||
362 | const struct term *tamsin_repr(const struct term *t) { | |
363 | struct termlist *tl; | |
364 | ||
365 | if (t->subterms == NULL) { /* it's an atom */ | |
366 | return term_escape_atom(t); | |
367 | } else { /* it's a constructor */ | |
368 | const struct term *n; | |
369 | n = term_concat(term_escape_atom(t), &BRA); | |
370 | ||
371 | for (tl = t->subterms; tl != NULL; tl = tl->next) { | |
372 | n = term_concat(n, tamsin_repr(tl->term)); | |
373 | if (tl->next != NULL) { | |
374 | n = term_concat(n, &COMMA); | |
375 | } | |
376 | } | |
377 | n = term_concat(n, &KET); | |
378 | return n; | |
379 | } | |
380 | } |
2 | 2 | * Distributed under a BSD-style license; see LICENSE for more information. |
3 | 3 | */ |
4 | 4 | |
5 | /* | |
6 | #include <assert.h> | |
7 | #include <stdio.h> | |
8 | #include <stdlib.h> | |
9 | #include <string.h> | |
10 | */ | |
11 | ||
12 | 5 | #ifndef TAMSIN_TAMSIN_H |
13 | 6 | #define TAMSIN_TAMSIN_H |
14 | 7 | |
15 | 8 | #include "term.h" |
9 | #include "scanner.h" | |
16 | 10 | |
17 | 11 | /* -------------------------------------------------------- tamsin */ |
18 | 12 | |
32 | 26 | const struct term *tamsin_format_octal(const struct term *); |
33 | 27 | const struct term *tamsin_length(const struct term *); |
34 | 28 | |
29 | /* | |
30 | * Given a possibly non-atom term, return an atom consisting of | |
31 | * contents of the given term reprified into an atom. | |
32 | * | |
33 | * The returned term is NOT always newly allocated. | |
34 | */ | |
35 | const struct term *tamsin_repr(const struct term *); | |
36 | ||
35 | 37 | int tamsin_isalpha(char); |
36 | 38 | int tamsin_isupper(char); |
37 | 39 | int tamsin_isdigit(char); |
136 | 136 | return t; |
137 | 137 | } |
138 | 138 | |
139 | const struct term BRA = { "(", 1, -1, NULL }; | |
140 | const struct term KET = { ")", 1, -1, NULL }; | |
141 | const struct term COMMA = { ", ", 2, -1, NULL }; | |
139 | const struct term COMMASPACE = { ", ", 2, -1, NULL }; | |
142 | 140 | |
143 | 141 | const struct term *term_flatten(const struct term *t) { |
144 | 142 | struct termlist *tl; |
148 | 146 | } else { /* it's a constructor */ |
149 | 147 | const struct term *n; |
150 | 148 | /* we clone t here to get an atom from its tag */ |
151 | n = term_concat(term_new_atom(t->atom, t->size), &BRA); | |
149 | n = term_concat(term_new_atom(t->atom, t->size), | |
150 | term_new_atom_from_char('(')); | |
152 | 151 | |
153 | 152 | for (tl = t->subterms; tl != NULL; tl = tl->next) { |
154 | 153 | n = term_concat(n, term_flatten(tl->term)); |
155 | 154 | if (tl->next != NULL) { |
156 | n = term_concat(n, &COMMA); | |
155 | n = term_concat(n, &COMMASPACE); | |
157 | 156 | } |
158 | 157 | } |
159 | n = term_concat(n, &KET); | |
158 | n = term_concat(n, term_new_atom_from_char(')')); | |
160 | 159 | return n; |
161 | 160 | } |
162 | 161 | } |
165 | 164 | const struct term *flat = term_flatten(t); |
166 | 165 | |
167 | 166 | fwrite(flat->atom, 1, flat->size, f); |
168 | } | |
169 | ||
170 | /* | |
171 | * Returns the number of extra bytes we'll need to allocate to escape | |
172 | * this string. 0 indicates it does not need to be escaped. | |
173 | * control/high character = +3 (\xXX) | |
174 | * apos or backslash = +1 (\\, \') | |
175 | */ | |
176 | int escapes_needed(const char *text, size_t size) { | |
177 | int i; | |
178 | int needed = 0; | |
179 | ||
180 | for (i = 0; i < size; i++) { | |
181 | if (text[i] < 32 || text[i] > 126) { | |
182 | needed += 3; | |
183 | } else if (text[i] == '\'' || text[i] == '\\') { | |
184 | needed += 1; | |
185 | } | |
186 | } | |
187 | ||
188 | return needed; | |
189 | } | |
190 | ||
191 | int all_bareword(const char *text, size_t size) { | |
192 | int i; | |
193 | ||
194 | for (i = 0; i < size; i++) { | |
195 | if (tamsin_isalnum(text[i]) || text[i] == '_') { | |
196 | } else { | |
197 | return 0; | |
198 | } | |
199 | } | |
200 | ||
201 | return 1; | |
202 | } | |
203 | ||
204 | const char *HEX = "0123456789abcdef"; | |
205 | ||
206 | const struct term *term_escape_atom(const struct term *t) { | |
207 | int needed; | |
208 | ||
209 | if (t->size == 0) { | |
210 | return term_new_atom("''", 2); | |
211 | } | |
212 | ||
213 | needed = escapes_needed(t->atom, t->size); | |
214 | ||
215 | if (needed > 0) { | |
216 | const struct term *r; | |
217 | char *buffer = malloc(t->size + needed); | |
218 | int i, j = 0; | |
219 | ||
220 | for (i = 0; i < t->size; i++) { | |
221 | if (t->atom[i] < 32 || t->atom[i] > 126) { | |
222 | buffer[j++] = '\\'; | |
223 | buffer[j++] = 'x'; | |
224 | buffer[j++] = HEX[(t->atom[i] >> 4) & 0x0f]; | |
225 | buffer[j++] = HEX[t->atom[i] & 0x0f]; | |
226 | } else if (t->atom[i] == '\'' || t->atom[i] == '\\') { | |
227 | buffer[j++] = '\\'; | |
228 | buffer[j++] = t->atom[i]; | |
229 | } else { | |
230 | buffer[j++] = t->atom[i]; | |
231 | } | |
232 | } | |
233 | assert(j == t->size + needed); | |
234 | ||
235 | r = term_new_atom("'", 1); | |
236 | r = term_concat(r, term_new_atom(buffer, t->size + needed)); | |
237 | r = term_concat(r, term_new_atom("'", 1)); | |
238 | free(buffer); | |
239 | ||
240 | return r; | |
241 | } else if (all_bareword(t->atom, t->size)) { | |
242 | /* TODO: can we eliminate this copy? */ | |
243 | return term_new_atom(t->atom, t->size); | |
244 | } else { | |
245 | const struct term *r; | |
246 | ||
247 | r = term_new_atom("'", 1); | |
248 | r = term_concat(r, t); | |
249 | r = term_concat(r, term_new_atom("'", 1)); | |
250 | ||
251 | return r; | |
252 | } | |
253 | } | |
254 | ||
255 | const struct term *term_repr(const struct term *t) { | |
256 | struct termlist *tl; | |
257 | ||
258 | if (t->subterms == NULL) { /* it's an atom */ | |
259 | return term_escape_atom(t); | |
260 | } else { /* it's a constructor */ | |
261 | const struct term *n; | |
262 | n = term_concat(term_escape_atom(t), &BRA); | |
263 | ||
264 | for (tl = t->subterms; tl != NULL; tl = tl->next) { | |
265 | n = term_concat(n, term_repr(tl->term)); | |
266 | if (tl->next != NULL) { | |
267 | n = term_concat(n, &COMMA); | |
268 | } | |
269 | } | |
270 | n = term_concat(n, &KET); | |
271 | return n; | |
272 | } | |
273 | 167 | } |
274 | 168 | |
275 | 169 | int term_equal(const struct term *pattern, const struct term *ground) |
2 | 2 | * Distributed under a BSD-style license; see LICENSE for more information. |
3 | 3 | */ |
4 | 4 | |
5 | /* | |
6 | #include <assert.h> | |
7 | #include <string.h> | |
8 | */ | |
9 | 5 | #include <stdlib.h> |
10 | 6 | #include <stdio.h> |
11 | 7 | |
84 | 80 | */ |
85 | 81 | const struct term *term_flatten(const struct term *); |
86 | 82 | |
87 | /* | |
88 | * Given a possibly non-atom term, return an atom consisting of | |
89 | * contents of the given term reprified into an atom. | |
90 | * | |
91 | * The returned term is NOT always newly allocated. | |
92 | */ | |
93 | const struct term *term_repr(const struct term *); | |
94 | ||
95 | 83 | void term_fput(const struct term *, FILE *); |
96 | 84 | |
97 | 85 | /* |
22 | 22 | * Generated code! Edit at your own risk! |
23 | 23 | * Must be linked with -ltamsin to build. |
24 | 24 | */ |
25 | #include <assert.h> | |
25 | 26 | #include <tamsin.h> |
26 | 27 | |
27 | 28 | /* global scanner */ |
189 | 190 | |
190 | 191 | compile_r(P,B,Mod, call(prodref('$', 'repr'), list(T, nil))) = |
191 | 192 | compile_r(P,B,Mod, T) → TNm & |
192 | emitln_fmt('result = term_repr(%s);', [TNm]) & | |
193 | emitln_fmt('result = tamsin_repr(%s);', [TNm]) & | |
193 | 194 | emitln('ok = 1;'). |
194 | 195 | |
195 | 196 | compile_r(P,B,Mod, call(prodref('$', 'eof'), nil)) = |
19 | 19 | * Generated code! Edit at your own risk! |
20 | 20 | * Must be linked with -ltamsin to build. |
21 | 21 | */ |
22 | #include <assert.h> | |
22 | 23 | #include <tamsin.h> |
23 | 24 | |
24 | 25 | /* global scanner */ |
291 | 292 | (argnames[1], argnames[0]) |
292 | 293 | ) |
293 | 294 | elif name == 'repr': |
294 | self.emit('result = term_repr(%s);' % argnames[0]) | |
295 | self.emit('result = tamsin_repr(%s);' % argnames[0]) | |
295 | 296 | self.emit('ok = 1;') |
296 | 297 | elif name == 'reverse': |
297 | 298 | self.emit('result = tamsin_reverse(%s, %s);' % |