aboutsummaryrefslogtreecommitdiffstats
path: root/src/bootstrap/primitives.c
diff options
context:
space:
mode:
Diffstat (limited to 'src/bootstrap/primitives.c')
-rw-r--r--src/bootstrap/primitives.c95
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 @@
1void display(Object *root); 1bool display(Object *root);
2 2
3void 3void
4display_pair(Object *root) { 4display_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
17void 17bool
18display(Object *root) { 18display(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
54Object * 55Object *
@@ -223,14 +224,90 @@ proc_display(Object *args) {
223} 224}
224 225
225Object * 226Object *
227proc_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
259Object *
226proc_is_boolean(Object *args) { 260proc_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
270Object *
271proc_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
278Object *
279proc_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
233Object * 293Object *
234proc_is_false(Object *args) { 294proc_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