From 33c9c0cd69f6a3f5954222704755771f03c2ea04 Mon Sep 17 00:00:00 2001
From: Bad Diode <bd@badd10de.dev>
Date: Fri, 8 Oct 2021 19:14:36 +0200
Subject: Add support for arithmetic procedures

---
 src/bootstrap/main.c | 171 ++++++++++++++++++++++++++++++++++++++++++++++++++-
 1 file changed, 169 insertions(+), 2 deletions(-)

diff --git a/src/bootstrap/main.c b/src/bootstrap/main.c
index a8e39f5..3c5663a 100755
--- a/src/bootstrap/main.c
+++ b/src/bootstrap/main.c
@@ -211,6 +211,7 @@ typedef enum ObjectType {
     OBJ_TYPE_SYMBOL,
     OBJ_TYPE_STRING,
     OBJ_TYPE_PAIR,
+    OBJ_TYPE_PROCEDURE,
 } ObjectType;
 
 typedef struct Object {
@@ -239,6 +240,9 @@ typedef struct Object {
             char *symbol;
             size_t symbol_n;
         };
+
+        // OBJ_TYPE_PROCEDURE
+        struct Object *(*proc)(struct Object *args);
     };
 } Object;
 
@@ -248,6 +252,19 @@ typedef struct Object {
 
 Object *empty_list;
 
+//
+// Environment.
+//
+
+typedef struct EnvSymbol {
+    Object *symbol;
+    Object *value;
+} EnvSymbol;
+
+#define ENV_SIZE 256
+static EnvSymbol environment[ENV_SIZE];
+static size_t env_n = 0;
+
 Object *
 make_fixnum(ssize_t num) {
     Object *obj = malloc(sizeof(Object));
@@ -325,7 +342,7 @@ bool
 token_is_fixnum(StringView token) {
     for (size_t i = 0; i < token.n; i++) {
         char c = token.start[i];
-        if (i == 0 && c == '-') {
+        if (i == 0 && c == '-' && token.n > 1) {
             continue;
         }
         if (!isdigit(c)) {
@@ -473,10 +490,160 @@ display(Object *root) {
 
 #define REPL_PROMPT "bdl> "
 
+Object * eval(Object *root);
+
+Object *
+proc_add(Object *args) {
+    ssize_t tot = 0;
+    while (args->type == OBJ_TYPE_PAIR) {
+        Object *car = eval(args->car);
+        if (car->type != OBJ_TYPE_FIXNUM) {
+            fprintf(stderr, "addition not supported for type %d\n", car->type);
+            return NULL;
+        }
+        tot += car->fixnum;
+        args = args->cdr;
+    }
+    return make_fixnum(tot);
+}
+
+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);
+    args = args->cdr;
+    ssize_t tot = car->fixnum;
+
+    while (args->type == OBJ_TYPE_PAIR) {
+        Object *car = eval(args->car);
+        if (car->type != OBJ_TYPE_FIXNUM) {
+            fprintf(stderr, "substraction not supported for type %d\n", car->type);
+            return NULL;
+        }
+        tot -= car->fixnum;
+        args = args->cdr;
+    }
+    return make_fixnum(tot);
+}
+
+Object *
+proc_mul(Object *args) {
+    ssize_t tot = 1;
+    while (args->type == OBJ_TYPE_PAIR) {
+        Object *car = eval(args->car);
+        if (car->type != OBJ_TYPE_FIXNUM) {
+            fprintf(stderr, "multiply not supported for type %d\n", car->type);
+            return NULL;
+        }
+        tot *= car->fixnum;
+        args = args->cdr;
+    }
+    return make_fixnum(tot);
+}
+
+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);
+    args = args->cdr;
+    ssize_t tot = car->fixnum;
+
+    while (args->type == OBJ_TYPE_PAIR) {
+        Object *car = eval(args->car);
+        if (car->type != OBJ_TYPE_FIXNUM) {
+            fprintf(stderr, "div not supported for type %d\n", car->type);
+            return NULL;
+        }
+        tot /= car->fixnum;
+        args = args->cdr;
+    }
+    return make_fixnum(tot);
+}
+
+bool
+symbol_eq(Object *a, Object *b) {
+    if (a->type != b->type || a->type != OBJ_TYPE_SYMBOL || 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;
+        }
+    }
+    return true;
+}
+
+Object *
+find_environment_symbol(Object *symbol) {
+    for (size_t i = 0; i < env_n; i++) {
+        if (symbol_eq(environment[i].symbol, symbol)) {
+            return environment[i].value;
+        }
+    }
+    return NULL;
+}
+
 void
 init(void) {
+    // Clear env.
+    for (size_t i = 0; i < ENV_SIZE; i++) {
+        environment[i] = (EnvSymbol){0};
+    }
+
     // Initialize singletons.
     empty_list = make_empty_list();
+
+    // Add primitive functions.
+    environment[env_n++] = (EnvSymbol){make_symbol("+", 1), make_procedure(proc_add)};
+    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)};
+}
+
+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: {
+            return root;
+        } break;
+        case OBJ_TYPE_PAIR: {
+            if (root->car->type == OBJ_TYPE_SYMBOL) {
+                Object *value = find_environment_symbol(root->car);
+                if (value == NULL) {
+                    printf("error: symbol not found: `");
+                    display(root->car);
+                    printf("`\n");
+                    return NULL;
+                }
+                if (value->type == OBJ_TYPE_PROCEDURE) {
+                    return value->proc(root->cdr);
+                }
+            }
+        } break;
+        default: {
+            printf("TYPE NOT IMPLEMENTED FOR EVAL.\n");
+        } break;
+    }
+
+    return NULL;
 }
 
 int
@@ -489,7 +656,7 @@ main(void) {
         Tokens tokens = tokenize(line);
         Object *ast = build_ast(&tokens);
         if (ast) {
-            display(ast);
+            display(eval(ast));
             printf("\n");
         }
     }
-- 
cgit v1.2.1