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 | |
parent | 4e4d5373328276ea6d49a60242555d5db03158ff (diff) | |
download | bdl-2bbafc053adfd4af01503d3163cba71698855fb0.tar.gz bdl-2bbafc053adfd4af01503d3163cba71698855fb0.zip |
Add modulo primitive and stubs for other procs
-rw-r--r-- | examples/arithmetic.bdl | 14 | ||||
-rwxr-xr-x | src/bootstrap/main.c | 12 | ||||
-rw-r--r-- | src/bootstrap/primitives.c | 126 | ||||
-rw-r--r-- | tests/arithmetic_expected.txt | 4 |
4 files changed, 152 insertions, 4 deletions
diff --git a/examples/arithmetic.bdl b/examples/arithmetic.bdl index 83404e2..c3ff230 100644 --- a/examples/arithmetic.bdl +++ b/examples/arithmetic.bdl | |||
@@ -3,20 +3,26 @@ | |||
3 | ;; | 3 | ;; |
4 | 4 | ||
5 | ;; Addition. | 5 | ;; Addition. |
6 | (print "(+ 10 100) -> ") (+ 10 100) | 6 | (print "(+ 10 100) -> ") (+ 10 100) |
7 | (print "(+ 1 -2 3 4) -> ") (+ 1 -2 3 4) | 7 | (print "(+ 1 -2 3 4) -> ") (+ 1 -2 3 4) |
8 | 8 | ||
9 | ;; Substraction. | 9 | ;; Substraction. |
10 | (print "(- 100 75) -> ") (- 100 75) | 10 | (print "(- 100 75) -> ") (- 100 75) |
11 | (print "(- 10 20 30) -> ") (- 10 20 30) | 11 | (print "(- 10 20 30) -> ") (- 10 20 30) |
12 | 12 | ||
13 | ;; Multiplication. | 13 | ;; Multiplication. |
14 | (print "(* 10 7) -> ") (* 10 7) | 14 | (print "(* 10 7) -> ") (* 10 7) |
15 | (print "(* -1 66) -> ") (* -1 66) | 15 | (print "(* -1 66) -> ") (* -1 66) |
16 | 16 | ||
17 | ;; Division. | 17 | ;; Division. |
18 | (print "(/ 45 5) -> ") (/ 45 5) | 18 | (print "(/ 45 5) -> ") (/ 45 5) |
19 | (print "(/ 10 5 2) -> ") (/ 10 5 2) | 19 | (print "(/ 10 5 2) -> ") (/ 10 5 2) |
20 | 20 | ||
21 | ;; Remainder/modulo. | ||
22 | (print "(% 45 5) -> ") (% 45 5) | ||
23 | (print "(% 45 7) -> ") (% 45 7) | ||
24 | (print "(% 120 45) -> ") (% 120 45) | ||
25 | (print "(% 120 45 8) -> ") (% 120 45 8) | ||
26 | |||
21 | ;; Nesting operations. | 27 | ;; Nesting operations. |
22 | (print "(* 20 (+ 100 (- 50 30) (/ 300 3)) 10) -> ") (* 20 (+ 100 (- 50 30) (/ 300 3)) 10) | 28 | (print "(* 20 (+ 100 (- 50 30) (/ 300 3)) 10) -> ") (* 20 (+ 100 (- 50 30) (/ 300 3)) 10) |
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? | ||
diff --git a/tests/arithmetic_expected.txt b/tests/arithmetic_expected.txt index 16445dc..a2a5a83 100644 --- a/tests/arithmetic_expected.txt +++ b/tests/arithmetic_expected.txt | |||
@@ -6,4 +6,8 @@ | |||
6 | (* -1 66) -> -66 | 6 | (* -1 66) -> -66 |
7 | (/ 45 5) -> 9 | 7 | (/ 45 5) -> 9 |
8 | (/ 10 5 2) -> 1 | 8 | (/ 10 5 2) -> 1 |
9 | (% 45 5) -> 0 | ||
10 | (% 45 7) -> 3 | ||
11 | (% 120 45) -> 30 | ||
12 | (% 120 45 8) -> 6 | ||
9 | (* 20 (+ 100 (- 50 30) (/ 300 3)) 10) -> 44000 | 13 | (* 20 (+ 100 (- 50 30) (/ 300 3)) 10) -> 44000 |