From 2bbafc053adfd4af01503d3163cba71698855fb0 Mon Sep 17 00:00:00 2001 From: Bad Diode Date: Sun, 10 Oct 2021 16:12:36 +0200 Subject: Add modulo primitive and stubs for other procs --- examples/arithmetic.bdl | 14 +++-- src/bootstrap/main.c | 12 ++++ src/bootstrap/primitives.c | 126 ++++++++++++++++++++++++++++++++++++++++++ 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 @@ ;; ;; Addition. -(print "(+ 10 100) -> ") (+ 10 100) +(print "(+ 10 100) -> ") (+ 10 100) (print "(+ 1 -2 3 4) -> ") (+ 1 -2 3 4) ;; Substraction. -(print "(- 100 75) -> ") (- 100 75) +(print "(- 100 75) -> ") (- 100 75) (print "(- 10 20 30) -> ") (- 10 20 30) ;; Multiplication. -(print "(* 10 7) -> ") (* 10 7) +(print "(* 10 7) -> ") (* 10 7) (print "(* -1 66) -> ") (* -1 66) ;; Division. -(print "(/ 45 5) -> ") (/ 45 5) +(print "(/ 45 5) -> ") (/ 45 5) (print "(/ 10 5 2) -> ") (/ 10 5 2) +;; Remainder/modulo. +(print "(% 45 5) -> ") (% 45 5) +(print "(% 45 7) -> ") (% 45 7) +(print "(% 120 45) -> ") (% 120 45) +(print "(% 120 45 8) -> ") (% 120 45 8) + ;; Nesting operations. (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) { environment[env_n++] = (EnvSymbol){MAKE_SYM("-"), make_procedure(proc_sub)}; environment[env_n++] = (EnvSymbol){MAKE_SYM("*"), make_procedure(proc_mul)}; environment[env_n++] = (EnvSymbol){MAKE_SYM("/"), make_procedure(proc_div)}; + environment[env_n++] = (EnvSymbol){MAKE_SYM("%"), make_procedure(proc_mod)}; environment[env_n++] = (EnvSymbol){MAKE_SYM("<"), make_procedure(proc_num_less_than)}; environment[env_n++] = (EnvSymbol){MAKE_SYM(">"), make_procedure(proc_num_greater_than)}; environment[env_n++] = (EnvSymbol){MAKE_SYM("="), make_procedure(proc_num_equal)}; environment[env_n++] = (EnvSymbol){MAKE_SYM("<="), make_procedure(proc_num_lesseq_than)}; environment[env_n++] = (EnvSymbol){MAKE_SYM(">="), make_procedure(proc_num_greatereq_than)}; + environment[env_n++] = (EnvSymbol){MAKE_SYM("null?"), make_procedure(proc_is_null)}; environment[env_n++] = (EnvSymbol){MAKE_SYM("boolean?"), make_procedure(proc_is_boolean)}; + environment[env_n++] = (EnvSymbol){MAKE_SYM("symbol?"), make_procedure(proc_is_symbol)}; + environment[env_n++] = (EnvSymbol){MAKE_SYM("string?"), make_procedure(proc_is_string)}; + environment[env_n++] = (EnvSymbol){MAKE_SYM("fixnum?"), make_procedure(proc_is_fixnum)}; + environment[env_n++] = (EnvSymbol){MAKE_SYM("pair?"), make_procedure(proc_is_pair)}; + environment[env_n++] = (EnvSymbol){MAKE_SYM("procedure?"), make_procedure(proc_is_procedure)}; environment[env_n++] = (EnvSymbol){MAKE_SYM("not"), make_procedure(proc_not)}; environment[env_n++] = (EnvSymbol){MAKE_SYM("and"), make_procedure(proc_and)}; environment[env_n++] = (EnvSymbol){MAKE_SYM("or"), make_procedure(proc_or)}; environment[env_n++] = (EnvSymbol){MAKE_SYM("if"), make_procedure(proc_if)}; environment[env_n++] = (EnvSymbol){MAKE_SYM("else"), obj_true}; environment[env_n++] = (EnvSymbol){MAKE_SYM("cond"), make_procedure(proc_cond)}; + environment[env_n++] = (EnvSymbol){MAKE_SYM("car"), make_procedure(proc_car)}; + environment[env_n++] = (EnvSymbol){MAKE_SYM("cdr"), make_procedure(proc_cdr)}; + environment[env_n++] = (EnvSymbol){MAKE_SYM("cons"), make_procedure(proc_cons)}; + environment[env_n++] = (EnvSymbol){MAKE_SYM("list"), make_procedure(proc_list)}; + environment[env_n++] = (EnvSymbol){MAKE_SYM("eq?"), make_procedure(proc_equal)}; environment[env_n++] = (EnvSymbol){MAKE_SYM("display"), make_procedure(proc_display)}; environment[env_n++] = (EnvSymbol){MAKE_SYM("print"), make_procedure(proc_print)}; } 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) { return obj_nil; } +// +// Arithmetic procedures. +// + Object * proc_add(Object *args) { // Extract first parameter. @@ -212,6 +216,40 @@ proc_div(Object *args) { return make_fixnum(tot); } +Object * +proc_mod(Object *args) { + // Extract first parameter. + Object *car = eval(args->car); + if (car == NULL) { + fprintf(stderr, "error: not enough arguments\n"); + return obj_nil; + } + args = args->cdr; + ssize_t tot = car->fixnum; + + while (args->type == OBJ_TYPE_PAIR) { + Object *car = eval(args->car); + if (car == NULL) { + car = obj_nil; + } + if (car->type != OBJ_TYPE_FIXNUM) { + fprintf(stderr, "error: div not supported for type %d\n", car->type); + return obj_nil; + } + if (car->fixnum == 0) { + fprintf(stderr, "error: division by zero\n"); + return obj_nil; + } + tot %= car->fixnum; + args = args->cdr; + } + return make_fixnum(tot); +} + +// +// Display/Evaluation procedues. +// + Object * proc_display(Object *args) { if (args == NULL) { @@ -256,6 +294,10 @@ proc_print(Object *args) { return NULL; } +// +// Type info procedures. +// + Object * proc_is_boolean(Object *args) { Object *obj = NULL; @@ -267,6 +309,46 @@ proc_is_boolean(Object *args) { return (obj == obj_true || obj == obj_false) ? obj_true : obj_false; } +Object * +proc_is_null(Object *args) { + // TODO: stub + return NULL; +} + +Object * +proc_is_symbol(Object *args) { + // TODO: stub + return NULL; +} + +Object * +proc_is_string(Object *args) { + // TODO: stub + return NULL; +} + +Object * +proc_is_fixnum(Object *args) { + // TODO: stub + return NULL; +} + +Object * +proc_is_pair(Object *args) { + // TODO: stub + return NULL; +} + +Object * +proc_is_procedure(Object *args) { + // TODO: stub + return NULL; +} + +// +// Boolean/conditional procedures. +// + Object * proc_not(Object *args) { if (args->type == OBJ_TYPE_PAIR) { @@ -522,4 +604,48 @@ proc_num_equal(Object *args) { return obj_true; } +// +// List operation procedures. +// + +Object * +proc_car(Object *args) { + // TODO: stub + return NULL; +} + +Object * +proc_cdr(Object *args) { + // TODO: stub + return NULL; +} + +Object * +proc_cons(Object *args) { + // TODO: stub + return NULL; +} + +Object * +proc_list(Object *args) { + // TODO: stub + return NULL; +} + +// +// Polymorphic procedures. +// + +Object * +proc_equal(Object *args) { + // TODO: stub + return NULL; +} + // TODO: fixnum left/right shift, mask, invert +// TODO: implement and test missing procedures +// TODO: properly implement nested environments +// TODO: implement support for quotes and semi-quotes +// TODO: LAMBDA +// TODO: let +// 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 @@ (* -1 66) -> -66 (/ 45 5) -> 9 (/ 10 5 2) -> 1 +(% 45 5) -> 0 +(% 45 7) -> 3 +(% 120 45) -> 30 +(% 120 45 8) -> 6 (* 20 (+ 100 (- 50 30) (/ 300 3)) 10) -> 44000 -- cgit v1.2.1