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 --- src/bootstrap/main.c | 12 +++++ src/bootstrap/primitives.c | 126 +++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 138 insertions(+) (limited to 'src/bootstrap') 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? -- cgit v1.2.1