Add eq? primitive procedure

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).