diff options
author | Bad Diode <bd@badd10de.dev> | 2021-10-10 16:12:36 +0200 |
---|---|---|
committer | Bad Diode <bd@badd10de.dev> | 2021-10-10 16:12:36 +0200 |
commit | 2bbafc053adfd4af01503d3163cba71698855fb0 (patch) | |
tree | 747ca8ea3297b291d8456813cb04d03a9995421a /src/bootstrap | |
parent | 4e4d5373328276ea6d49a60242555d5db03158ff (diff) | |
download | bdl-2bbafc053adfd4af01503d3163cba71698855fb0.tar.gz bdl-2bbafc053adfd4af01503d3163cba71698855fb0.zip |
Add modulo primitive and stubs for other procs
Diffstat (limited to 'src/bootstrap')
-rwxr-xr-x | src/bootstrap/main.c | 12 | ||||
-rw-r--r-- | src/bootstrap/primitives.c | 126 |
2 files changed, 138 insertions, 0 deletions
diff --git a/src/bootstrap/main.c b/src/bootstrap/main.c index b8bab47..65e508f 100755 --- a/src/bootstrap/main.c +++ b/src/bootstrap/main.c | |||
@@ -36,18 +36,30 @@ init(void) { | |||
36 | environment[env_n++] = (EnvSymbol){MAKE_SYM("-"), make_procedure(proc_sub)}; | 36 | environment[env_n++] = (EnvSymbol){MAKE_SYM("-"), make_procedure(proc_sub)}; |
37 | environment[env_n++] = (EnvSymbol){MAKE_SYM("*"), make_procedure(proc_mul)}; | 37 | environment[env_n++] = (EnvSymbol){MAKE_SYM("*"), make_procedure(proc_mul)}; |
38 | environment[env_n++] = (EnvSymbol){MAKE_SYM("/"), make_procedure(proc_div)}; | 38 | environment[env_n++] = (EnvSymbol){MAKE_SYM("/"), make_procedure(proc_div)}; |
39 | environment[env_n++] = (EnvSymbol){MAKE_SYM("%"), make_procedure(proc_mod)}; | ||
39 | environment[env_n++] = (EnvSymbol){MAKE_SYM("<"), make_procedure(proc_num_less_than)}; | 40 | environment[env_n++] = (EnvSymbol){MAKE_SYM("<"), make_procedure(proc_num_less_than)}; |
40 | environment[env_n++] = (EnvSymbol){MAKE_SYM(">"), make_procedure(proc_num_greater_than)}; | 41 | environment[env_n++] = (EnvSymbol){MAKE_SYM(">"), make_procedure(proc_num_greater_than)}; |
41 | environment[env_n++] = (EnvSymbol){MAKE_SYM("="), make_procedure(proc_num_equal)}; | 42 | environment[env_n++] = (EnvSymbol){MAKE_SYM("="), make_procedure(proc_num_equal)}; |
42 | environment[env_n++] = (EnvSymbol){MAKE_SYM("<="), make_procedure(proc_num_lesseq_than)}; | 43 | environment[env_n++] = (EnvSymbol){MAKE_SYM("<="), make_procedure(proc_num_lesseq_than)}; |
43 | environment[env_n++] = (EnvSymbol){MAKE_SYM(">="), make_procedure(proc_num_greatereq_than)}; | 44 | environment[env_n++] = (EnvSymbol){MAKE_SYM(">="), make_procedure(proc_num_greatereq_than)}; |
45 | environment[env_n++] = (EnvSymbol){MAKE_SYM("null?"), make_procedure(proc_is_null)}; | ||
44 | environment[env_n++] = (EnvSymbol){MAKE_SYM("boolean?"), make_procedure(proc_is_boolean)}; | 46 | environment[env_n++] = (EnvSymbol){MAKE_SYM("boolean?"), make_procedure(proc_is_boolean)}; |
47 | environment[env_n++] = (EnvSymbol){MAKE_SYM("symbol?"), make_procedure(proc_is_symbol)}; | ||
48 | environment[env_n++] = (EnvSymbol){MAKE_SYM("string?"), make_procedure(proc_is_string)}; | ||
49 | environment[env_n++] = (EnvSymbol){MAKE_SYM("fixnum?"), make_procedure(proc_is_fixnum)}; | ||
50 | environment[env_n++] = (EnvSymbol){MAKE_SYM("pair?"), make_procedure(proc_is_pair)}; | ||
51 | environment[env_n++] = (EnvSymbol){MAKE_SYM("procedure?"), make_procedure(proc_is_procedure)}; | ||
45 | environment[env_n++] = (EnvSymbol){MAKE_SYM("not"), make_procedure(proc_not)}; | 52 | environment[env_n++] = (EnvSymbol){MAKE_SYM("not"), make_procedure(proc_not)}; |
46 | environment[env_n++] = (EnvSymbol){MAKE_SYM("and"), make_procedure(proc_and)}; | 53 | environment[env_n++] = (EnvSymbol){MAKE_SYM("and"), make_procedure(proc_and)}; |
47 | environment[env_n++] = (EnvSymbol){MAKE_SYM("or"), make_procedure(proc_or)}; | 54 | environment[env_n++] = (EnvSymbol){MAKE_SYM("or"), make_procedure(proc_or)}; |
48 | environment[env_n++] = (EnvSymbol){MAKE_SYM("if"), make_procedure(proc_if)}; | 55 | environment[env_n++] = (EnvSymbol){MAKE_SYM("if"), make_procedure(proc_if)}; |
49 | environment[env_n++] = (EnvSymbol){MAKE_SYM("else"), obj_true}; | 56 | environment[env_n++] = (EnvSymbol){MAKE_SYM("else"), obj_true}; |
50 | environment[env_n++] = (EnvSymbol){MAKE_SYM("cond"), make_procedure(proc_cond)}; | 57 | environment[env_n++] = (EnvSymbol){MAKE_SYM("cond"), make_procedure(proc_cond)}; |
58 | environment[env_n++] = (EnvSymbol){MAKE_SYM("car"), make_procedure(proc_car)}; | ||
59 | environment[env_n++] = (EnvSymbol){MAKE_SYM("cdr"), make_procedure(proc_cdr)}; | ||
60 | environment[env_n++] = (EnvSymbol){MAKE_SYM("cons"), make_procedure(proc_cons)}; | ||
61 | environment[env_n++] = (EnvSymbol){MAKE_SYM("list"), make_procedure(proc_list)}; | ||
62 | environment[env_n++] = (EnvSymbol){MAKE_SYM("eq?"), make_procedure(proc_equal)}; | ||
51 | environment[env_n++] = (EnvSymbol){MAKE_SYM("display"), make_procedure(proc_display)}; | 63 | environment[env_n++] = (EnvSymbol){MAKE_SYM("display"), make_procedure(proc_display)}; |
52 | environment[env_n++] = (EnvSymbol){MAKE_SYM("print"), make_procedure(proc_print)}; | 64 | environment[env_n++] = (EnvSymbol){MAKE_SYM("print"), make_procedure(proc_print)}; |
53 | } | 65 | } |
diff --git a/src/bootstrap/primitives.c b/src/bootstrap/primitives.c index 485799d..f6b354e 100644 --- a/src/bootstrap/primitives.c +++ b/src/bootstrap/primitives.c | |||
@@ -92,6 +92,10 @@ eval(Object *root) { | |||
92 | return obj_nil; | 92 | return obj_nil; |
93 | } | 93 | } |
94 | 94 | ||
95 | // | ||
96 | // Arithmetic procedures. | ||
97 | // | ||
98 | |||
95 | Object * | 99 | Object * |
96 | proc_add(Object *args) { | 100 | proc_add(Object *args) { |
97 | // Extract first parameter. | 101 | // Extract first parameter. |
@@ -213,6 +217,40 @@ proc_div(Object *args) { | |||
213 | } | 217 | } |
214 | 218 | ||
215 | Object * | 219 | Object * |
220 | proc_mod(Object *args) { | ||
221 | // Extract first parameter. | ||
222 | Object *car = eval(args->car); | ||
223 | if (car == NULL) { | ||
224 | fprintf(stderr, "error: not enough arguments\n"); | ||
225 | return obj_nil; | ||
226 | } | ||
227 | args = args->cdr; | ||
228 | ssize_t tot = car->fixnum; | ||
229 | |||
230 | while (args->type == OBJ_TYPE_PAIR) { | ||
231 | Object *car = eval(args->car); | ||
232 | if (car == NULL) { | ||
233 | car = obj_nil; | ||
234 | } | ||
235 | if (car->type != OBJ_TYPE_FIXNUM) { | ||
236 | fprintf(stderr, "error: div not supported for type %d\n", car->type); | ||
237 | return obj_nil; | ||
238 | } | ||
239 | if (car->fixnum == 0) { | ||
240 | fprintf(stderr, "error: division by zero\n"); | ||
241 | return obj_nil; | ||
242 | } | ||
243 | tot %= car->fixnum; | ||
244 | args = args->cdr; | ||
245 | } | ||
246 | return make_fixnum(tot); | ||
247 | } | ||
248 | |||
249 | // | ||
250 | // Display/Evaluation procedues. | ||
251 | // | ||
252 | |||
253 | Object * | ||
216 | proc_display(Object *args) { | 254 | proc_display(Object *args) { |
217 | if (args == NULL) { | 255 | if (args == NULL) { |
218 | return obj_nil; | 256 | return obj_nil; |
@@ -256,6 +294,10 @@ proc_print(Object *args) { | |||
256 | return NULL; | 294 | return NULL; |
257 | } | 295 | } |
258 | 296 | ||
297 | // | ||
298 | // Type info procedures. | ||
299 | // | ||
300 | |||
259 | Object * | 301 | Object * |
260 | proc_is_boolean(Object *args) { | 302 | proc_is_boolean(Object *args) { |
261 | Object *obj = NULL; | 303 | Object *obj = NULL; |
@@ -268,6 +310,46 @@ proc_is_boolean(Object *args) { | |||
268 | } | 310 | } |
269 | 311 | ||
270 | Object * | 312 | Object * |
313 | proc_is_null(Object *args) { | ||
314 | // TODO: stub | ||
315 | return NULL; | ||
316 | } | ||
317 | |||
318 | Object * | ||
319 | proc_is_symbol(Object *args) { | ||
320 | // TODO: stub | ||
321 | return NULL; | ||
322 | } | ||
323 | |||
324 | Object * | ||
325 | proc_is_string(Object *args) { | ||
326 | // TODO: stub | ||
327 | return NULL; | ||
328 | } | ||
329 | |||
330 | Object * | ||
331 | proc_is_fixnum(Object *args) { | ||
332 | // TODO: stub | ||
333 | return NULL; | ||
334 | } | ||
335 | |||
336 | Object * | ||
337 | proc_is_pair(Object *args) { | ||
338 | // TODO: stub | ||
339 | return NULL; | ||
340 | } | ||
341 | |||
342 | Object * | ||
343 | proc_is_procedure(Object *args) { | ||
344 | // TODO: stub | ||
345 | return NULL; | ||
346 | } | ||
347 | |||
348 | // | ||
349 | // Boolean/conditional procedures. | ||
350 | // | ||
351 | |||
352 | Object * | ||
271 | proc_not(Object *args) { | 353 | proc_not(Object *args) { |
272 | if (args->type == OBJ_TYPE_PAIR) { | 354 | if (args->type == OBJ_TYPE_PAIR) { |
273 | return eval(args->car) == obj_false ? obj_true : obj_false; | 355 | return eval(args->car) == obj_false ? obj_true : obj_false; |
@@ -522,4 +604,48 @@ proc_num_equal(Object *args) { | |||
522 | return obj_true; | 604 | return obj_true; |
523 | } | 605 | } |
524 | 606 | ||
607 | // | ||
608 | // List operation procedures. | ||
609 | // | ||
610 | |||
611 | Object * | ||
612 | proc_car(Object *args) { | ||
613 | // TODO: stub | ||
614 | return NULL; | ||
615 | } | ||
616 | |||
617 | Object * | ||
618 | proc_cdr(Object *args) { | ||
619 | // TODO: stub | ||
620 | return NULL; | ||
621 | } | ||
622 | |||
623 | Object * | ||
624 | proc_cons(Object *args) { | ||
625 | // TODO: stub | ||
626 | return NULL; | ||
627 | } | ||
628 | |||
629 | Object * | ||
630 | proc_list(Object *args) { | ||
631 | // TODO: stub | ||
632 | return NULL; | ||
633 | } | ||
634 | |||
635 | // | ||
636 | // Polymorphic procedures. | ||
637 | // | ||
638 | |||
639 | Object * | ||
640 | proc_equal(Object *args) { | ||
641 | // TODO: stub | ||
642 | return NULL; | ||
643 | } | ||
644 | |||
525 | // TODO: fixnum left/right shift, mask, invert | 645 | // TODO: fixnum left/right shift, mask, invert |
646 | // TODO: implement and test missing procedures | ||
647 | // TODO: properly implement nested environments | ||
648 | // TODO: implement support for quotes and semi-quotes | ||
649 | // TODO: LAMBDA | ||
650 | // TODO: let | ||
651 | // TODO: better error handling? | ||