diff options
Diffstat (limited to 'src/bootstrap/primitives.c')
-rw-r--r-- | src/bootstrap/primitives.c | 95 |
1 files changed, 86 insertions, 9 deletions
diff --git a/src/bootstrap/primitives.c b/src/bootstrap/primitives.c index e4c18cd..97058f9 100644 --- a/src/bootstrap/primitives.c +++ b/src/bootstrap/primitives.c | |||
@@ -1,4 +1,4 @@ | |||
1 | void display(Object *root); | 1 | bool display(Object *root); |
2 | 2 | ||
3 | void | 3 | void |
4 | display_pair(Object *root) { | 4 | display_pair(Object *root) { |
@@ -6,7 +6,7 @@ display_pair(Object *root) { | |||
6 | if (root->cdr->type == OBJ_TYPE_PAIR) { | 6 | if (root->cdr->type == OBJ_TYPE_PAIR) { |
7 | printf(" "); | 7 | printf(" "); |
8 | display_pair(root->cdr); | 8 | display_pair(root->cdr); |
9 | } else if (root->cdr->type == OBJ_TYPE_NIL) { | 9 | } else if (root->cdr == obj_nil) { |
10 | return; | 10 | return; |
11 | } else { | 11 | } else { |
12 | printf(" . "); | 12 | printf(" . "); |
@@ -14,10 +14,10 @@ display_pair(Object *root) { | |||
14 | } | 14 | } |
15 | } | 15 | } |
16 | 16 | ||
17 | void | 17 | bool |
18 | display(Object *root) { | 18 | display(Object *root) { |
19 | if (root == NULL) { | 19 | if (root == NULL) { |
20 | return; | 20 | return false; |
21 | } | 21 | } |
22 | 22 | ||
23 | switch (root->type) { | 23 | switch (root->type) { |
@@ -49,6 +49,7 @@ display(Object *root) { | |||
49 | printf("#{procedure}"); | 49 | printf("#{procedure}"); |
50 | } break; | 50 | } break; |
51 | } | 51 | } |
52 | return true; | ||
52 | } | 53 | } |
53 | 54 | ||
54 | Object * | 55 | Object * |
@@ -223,14 +224,90 @@ proc_display(Object *args) { | |||
223 | } | 224 | } |
224 | 225 | ||
225 | Object * | 226 | Object * |
227 | proc_print(Object *args) { | ||
228 | if (args == NULL) { | ||
229 | return NULL; | ||
230 | } | ||
231 | if (args->type == OBJ_TYPE_PAIR) { | ||
232 | Object *obj = args->car; | ||
233 | if (obj->type == OBJ_TYPE_STRING) { | ||
234 | StringView scanner = (StringView) { | ||
235 | .start = obj->string, | ||
236 | .n = obj->string_n, | ||
237 | }; | ||
238 | while (scanner.n != 0) { | ||
239 | char c = sv_next(&scanner); | ||
240 | if (c == '\\' && sv_peek(&scanner) == 'n') { | ||
241 | putchar('\n'); | ||
242 | sv_next(&scanner); | ||
243 | continue; | ||
244 | } | ||
245 | if (c == '\\' && sv_peek(&scanner) == '"') { | ||
246 | putchar('"'); | ||
247 | sv_next(&scanner); | ||
248 | continue; | ||
249 | } | ||
250 | putchar(c); | ||
251 | } | ||
252 | } else { | ||
253 | fprintf(stderr, "error: print requires a string argument\n"); | ||
254 | } | ||
255 | } | ||
256 | return NULL; | ||
257 | } | ||
258 | |||
259 | Object * | ||
226 | proc_is_boolean(Object *args) { | 260 | proc_is_boolean(Object *args) { |
227 | if (args->car == obj_true || args->car == obj_false) { | 261 | Object *obj = NULL; |
228 | return obj_true; | 262 | if (args->type == OBJ_TYPE_PAIR) { |
263 | obj = eval(args->car); | ||
264 | } else { | ||
265 | obj = eval(args); | ||
229 | } | 266 | } |
230 | return obj_false; | 267 | return (obj == obj_true || obj == obj_false) ? obj_true : obj_false; |
268 | } | ||
269 | |||
270 | Object * | ||
271 | proc_not(Object *args) { | ||
272 | if (args->type == OBJ_TYPE_PAIR) { | ||
273 | return eval(args->car) == obj_false ? obj_true : obj_false; | ||
274 | } | ||
275 | return eval(args) == obj_false ? obj_true : obj_false; | ||
276 | } | ||
277 | |||
278 | Object * | ||
279 | proc_and(Object *args) { | ||
280 | while (args != NULL && args != obj_nil) { | ||
281 | Object *obj = args->car; | ||
282 | if (args->car->type == OBJ_TYPE_PAIR) { | ||
283 | obj = eval(args->car); | ||
284 | } | ||
285 | if (proc_not(obj) == obj_true) { | ||
286 | return obj_false; | ||
287 | } | ||
288 | args = args->cdr; | ||
289 | } | ||
290 | return obj_true; | ||
231 | } | 291 | } |
232 | 292 | ||
233 | Object * | 293 | Object * |
234 | proc_is_false(Object *args) { | 294 | proc_or(Object *args) { |
235 | return args->car == obj_false ? obj_true : obj_false; | 295 | if (args->type != OBJ_TYPE_PAIR) { |
296 | return obj_false; | ||
297 | } | ||
298 | |||
299 | while (args != NULL && args != obj_nil) { | ||
300 | Object *obj = args->car; | ||
301 | if (args->car->type == OBJ_TYPE_PAIR) { | ||
302 | obj = eval(args->car); | ||
303 | } | ||
304 | if (proc_not(obj) == obj_false) { | ||
305 | return obj_true; | ||
306 | } | ||
307 | args = args->cdr; | ||
308 | } | ||
309 | return obj_false; | ||
236 | } | 310 | } |
311 | |||
312 | // TODO: if/cond | ||
313 | // TODO: fixnum left/right shift, mask, invert | ||