Add proc_display and fix some bugs

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;
+}