From e068d45199bb23452821727e5b82a2307ae0256d Mon Sep 17 00:00:00 2001 From: Bad Diode Date: Wed, 13 Oct 2021 17:18:31 +0200 Subject: Add eq? primitive procedure --- examples/types.bdl | 2 +- src/bootstrap/environment.c | 43 ----------------------------------------- src/bootstrap/main.c | 5 +++++ src/bootstrap/objects.c | 36 ++++++++++++++++++++++++++++++++++ src/bootstrap/primitives.c | 47 ++++++++++++++++++++++++++++----------------- 5 files changed, 71 insertions(+), 62 deletions(-) diff --git a/examples/types.bdl b/examples/types.bdl index 36dab7a..22ffdce 100644 --- a/examples/types.bdl +++ b/examples/types.bdl @@ -39,7 +39,7 @@ (print "(fixnum? (+ 1 2 3)) -> ") (fixnum? (+ 1 2 3)) (print "(fixnum? (not 1)) -> ") (fixnum? (not 1)) -;; Symbol +;; Symbol. (print "(symbol? true) -> ") (symbol? true) (print "(symbol? false) -> ") (symbol? false) (print "(symbol? 1) -> ") (symbol? 1) diff --git a/src/bootstrap/environment.c b/src/bootstrap/environment.c index 1bbe844..0a6a866 100644 --- a/src/bootstrap/environment.c +++ b/src/bootstrap/environment.c @@ -1,7 +1,3 @@ -// -// Environment. -// - typedef struct EnvEntry { Object *symbol; Object *value; @@ -50,45 +46,6 @@ env_add_symbol(Environment *env, Object *symbol, Object *value) { env->buf[env->size++] = (EnvEntry){symbol, value}; } -bool -obj_eq(Object *a, Object* b) { - if (a->type != b->type) { - return false; - } - switch (a->type) { - case OBJ_TYPE_FIXNUM: { - return a->fixnum == b->fixnum; - } break; - case OBJ_TYPE_STRING: { - if (a->string_n != b->string_n) { - return false; - } - for (size_t i = 0; i < a->string_n; i++) { - if (a->string[i] != b->string[i]) { - return false; - } - } - } break; - case OBJ_TYPE_SYMBOL: { - if (a->symbol_n != b->symbol_n) { - return false; - } - for (size_t i = 0; i < a->symbol_n; i++) { - if (a->symbol[i] != b->symbol[i]) { - return false; - } - } - } break; - case OBJ_TYPE_PAIR: { - // TODO: needs evaluation of parameters... - } break; - default: { - return a == b; - } break; - } - return true; -} - Object * env_lookup(Environment *env, Object *symbol) { while (env != NULL) { diff --git a/src/bootstrap/main.c b/src/bootstrap/main.c index 8092bbd..945e121 100755 --- a/src/bootstrap/main.c +++ b/src/bootstrap/main.c @@ -14,6 +14,10 @@ #include "environment.c" #include "primitives.c" +// +// Utility macros. +// + #define MAKE_SYM(STR) make_symbol((StringView){(STR), sizeof(STR) - 1}) #define MAKE_ENV_VAR(ENV,STR,VAR) \ (env_add_symbol((ENV), MAKE_SYM(STR), (VAR))) @@ -66,6 +70,7 @@ init(void) { MAKE_ENV_PROC(global_env, ">", proc_num_greater_than); MAKE_ENV_PROC(global_env, ">=", proc_num_greatereq_than); MAKE_ENV_PROC(global_env, "=", proc_num_equal); + MAKE_ENV_PROC(global_env, "eq?", proc_equal); } void diff --git a/src/bootstrap/objects.c b/src/bootstrap/objects.c index 0361ae8..497a04d 100644 --- a/src/bootstrap/objects.c +++ b/src/bootstrap/objects.c @@ -197,3 +197,39 @@ display(Object *root) { } return; } + +bool +obj_eq(Object *a, Object* b) { + if (a->type != b->type) { + return false; + } + switch (a->type) { + case OBJ_TYPE_FIXNUM: { + return a->fixnum == b->fixnum; + } break; + case OBJ_TYPE_STRING: { + if (a->string_n != b->string_n) { + return false; + } + for (size_t i = 0; i < a->string_n; i++) { + if (a->string[i] != b->string[i]) { + return false; + } + } + } break; + case OBJ_TYPE_SYMBOL: { + if (a->symbol_n != b->symbol_n) { + return false; + } + for (size_t i = 0; i < a->symbol_n; i++) { + if (a->symbol[i] != b->symbol[i]) { + return false; + } + } + } break; + default: { + return a == b; + } break; + } + return true; +} diff --git a/src/bootstrap/primitives.c b/src/bootstrap/primitives.c index 8369fa8..2a82782 100644 --- a/src/bootstrap/primitives.c +++ b/src/bootstrap/primitives.c @@ -880,21 +880,32 @@ proc_list(Environment *env, Object *obj) { // Polymorphic procedures. // -//Object * -//proc_equal(Object *args) { -// // TODO: stub -// (void) args; -// return NULL; -//} - -//// TODO: fixnum left/right shift, mask, invert -//// TODO: implement and test missing procedures -//// TODO: add primitives for type transforms: string->symbol, symbol->string, etc -//// TODO: properly implement nested environments -//// TODO: implement support for quotes and semi-quotes -//// TODO: LAMBDA -//// TODO: let -//// TODO: better error handling? -//// TODO: Revise all instances where we are returning an object, since currently -//// we may be returning a pointer to an object instead of a new one. Check also -//// on eval function and everytime we do make_xxx(obj). +Object * +proc_equal(Environment *env, Object *obj) { + if (obj == obj_nil || obj->cdr == obj_nil) { + error_push((Error){ + .type = ERR_TYPE_RUNTIME, + .value = ERR_NOT_ENOUGH_ARGS, + }); + return obj_err; + } + Object *a = eval(env, obj->car); + if (a == obj_err) { + return obj_err; + } + Object *b = eval(env, obj->cdr->car); + if (b == obj_err) { + return obj_err; + } + return obj_eq(a, b) ? obj_true : obj_false; +} + + +// TODO: fixnum left/right shift, mask, invert +// TODO: add primitives for type transforms: string->symbol, symbol->string, etc +// TODO: implement support for semi-quotes +// TODO: LAMBDA +// TODO: let +// TODO: Revise all instances where we are returning an object, since currently +// we may be returning a pointer to an object instead of a new one. Check also +// on eval function and everytime we do make_xxx(obj). -- cgit v1.2.1