From ab6b56dfe916c17f34e684e69483895402783ae5 Mon Sep 17 00:00:00 2001 From: Bad Diode Date: Sat, 9 Oct 2021 20:23:52 +0200 Subject: Add proc_display and fix some bugs --- Makefile | 2 +- src/bootstrap/main.c | 1 + src/bootstrap/objects.c | 17 ------ src/bootstrap/primitives.c | 134 ++++++++++++++++++++++++++++++++++----------- 4 files changed, 105 insertions(+), 49 deletions(-) diff --git a/Makefile b/Makefile index 1f19b98..bfb7d4e 100755 --- a/Makefile +++ b/Makefile @@ -15,7 +15,7 @@ BIN := $(BUILD_DIR)/$(TARGET) # Compiler and linker configuration. CC := cc -CFLAGS := -Wall -Wextra -pedantic -DBIN_NAME=\"$(TARGET)\" +CFLAGS := -Wall -Wextra -pedantic -DBIN_NAME=\"$(TARGET)\" -static CFLAGS += $(INC_FLAGS) LDFLAGS := LDLIBS := diff --git a/src/bootstrap/main.c b/src/bootstrap/main.c index 419ce91..e5d9b17 100755 --- a/src/bootstrap/main.c +++ b/src/bootstrap/main.c @@ -36,6 +36,7 @@ init(void) { environment[env_n++] = (EnvSymbol){make_symbol("-", 1), make_procedure(proc_sub)}; environment[env_n++] = (EnvSymbol){make_symbol("*", 1), make_procedure(proc_mul)}; environment[env_n++] = (EnvSymbol){make_symbol("/", 1), make_procedure(proc_div)}; + environment[env_n++] = (EnvSymbol){make_symbol("display", 7), make_procedure(proc_display)}; } void diff --git a/src/bootstrap/objects.c b/src/bootstrap/objects.c index 985709a..14ff50d 100644 --- a/src/bootstrap/objects.c +++ b/src/bootstrap/objects.c @@ -137,20 +137,3 @@ symbol_eq(Object *a, Object *b) { } return true; } - -void display(Object *root); - -void -display_pair(Object *root) { - display(root->car); - if (root->cdr->type == OBJ_TYPE_PAIR) { - printf(" "); - display_pair(root->cdr); - } else if (root->cdr->type == OBJ_TYPE_NIL) { - return; - } else { - printf(" . "); - display(root->cdr); - } -} - diff --git a/src/bootstrap/primitives.c b/src/bootstrap/primitives.c index 50a2dfb..f72e484 100644 --- a/src/bootstrap/primitives.c +++ b/src/bootstrap/primitives.c @@ -1,3 +1,19 @@ +void display(Object *root); + +void +display_pair(Object *root) { + display(root->car); + if (root->cdr->type == OBJ_TYPE_PAIR) { + printf(" "); + display_pair(root->cdr); + } else if (root->cdr->type == OBJ_TYPE_NIL) { + return; + } else { + printf(" . "); + display(root->cdr); + } +} + void display(Object *root) { if (root == NULL) { @@ -29,26 +45,31 @@ display(Object *root) { display_pair(root); printf(")"); } break; - default: { - printf("TYPE NOT IMPLEMENTED FOR DISPLAY."); + case OBJ_TYPE_PROCEDURE: { + printf("#{procedure}"); } break; } } Object * eval(Object *root) { - if (root == NULL) { - return NULL; - } - switch (root->type) { case OBJ_TYPE_FIXNUM: case OBJ_TYPE_BOOL: case OBJ_TYPE_NIL: - case OBJ_TYPE_STRING: - case OBJ_TYPE_SYMBOL: { + case OBJ_TYPE_STRING: { return root; } break; + case OBJ_TYPE_SYMBOL: { + Object *value = find_environment_symbol(root); + if (value == NULL) { + printf("error: symbol not found: `"); + display(root); + printf("`\n"); + return obj_nil; + } + return value; + } break; case OBJ_TYPE_PAIR: { if (root->car->type == OBJ_TYPE_SYMBOL) { Object *value = find_environment_symbol(root->car); @@ -56,7 +77,7 @@ eval(Object *root) { printf("error: symbol not found: `"); display(root->car); printf("`\n"); - return NULL; + return obj_nil; } if (value->type == OBJ_TYPE_PROCEDURE) { return value->proc(root->cdr); @@ -67,18 +88,32 @@ eval(Object *root) { printf("error: can't eval type %d.\n", root->type); } break; } - - return NULL; + return obj_nil; } Object * proc_add(Object *args) { - ssize_t tot = 0; + // Extract first parameter. + Object *car = eval(args->car); + if (car == NULL) { + fprintf(stderr, "error: not enough arguments\n"); + return obj_nil; + } + if (car->type != OBJ_TYPE_FIXNUM) { + fprintf(stderr, "addition not supported for type %d\n", car->type); + 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, "addition not supported for type %d\n", car->type); - return NULL; + return obj_nil; } tot += car->fixnum; args = args->cdr; @@ -88,21 +123,27 @@ proc_add(Object *args) { Object * proc_sub(Object *args) { - if (args->type != OBJ_TYPE_PAIR) { - fprintf(stderr, "substraction not supported for type %d\n", args->type); - return NULL; - } - // Extract first parameter. Object *car = eval(args->car); + if (car == NULL) { + fprintf(stderr, "error: not enough arguments\n"); + return obj_nil; + } + if (car->type != OBJ_TYPE_FIXNUM) { + fprintf(stderr, "error: sub not supported for type %d\n", car->type); + return obj_nil; + } args = args->cdr; ssize_t tot = car->fixnum; while (args->type == OBJ_TYPE_PAIR) { - Object *car = eval(args->car); + car = eval(args->car); + if (car == NULL) { + car = obj_nil; + } if (car->type != OBJ_TYPE_FIXNUM) { - fprintf(stderr, "substraction not supported for type %d\n", car->type); - return NULL; + fprintf(stderr, "error: sub not supported for type %d\n", car->type); + return obj_nil; } tot -= car->fixnum; args = args->cdr; @@ -112,12 +153,27 @@ proc_sub(Object *args) { Object * proc_mul(Object *args) { - ssize_t tot = 1; + // Extract first parameter. + Object *car = eval(args->car); + if (car == NULL) { + fprintf(stderr, "error: not enough arguments\n"); + return obj_nil; + } + if (car->type != OBJ_TYPE_FIXNUM) { + fprintf(stderr, "error: mult not supported for type %d\n", car->type); + 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, "multiply not supported for type %d\n", car->type); - return NULL; + fprintf(stderr, "error: mult not supported for type %d\n", car->type); + return obj_nil; } tot *= car->fixnum; args = args->cdr; @@ -127,21 +183,27 @@ proc_mul(Object *args) { Object * proc_div(Object *args) { - if (args->type != OBJ_TYPE_PAIR) { - fprintf(stderr, "substraction not supported for type %d\n", args->type); - return NULL; - } - // 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, "div not supported for type %d\n", car->type); - return NULL; + 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; @@ -149,3 +211,13 @@ proc_div(Object *args) { return make_fixnum(tot); } +Object * +proc_display(Object *args) { + if (args == NULL) { + return obj_nil; + } + if (args->type == OBJ_TYPE_PAIR) { + display(eval(args->car)); + } + return obj_nil; +} -- cgit v1.2.1