funcs "boolean=?", "symbol=?"

Makefile

@@ -39,6 +39,7 @@ test: arcana-lisp
 	$(CAT) tests/logic_ops.scm          | ./arcana-lisp $(LIBS)
 	$(CAT) tests/syntax.scm             | ./arcana-lisp $(LIBS)
 	$(CAT) tests/type_conv.scm          | ./arcana-lisp $(LIBS)
+	$(CAT) tests/type_equiv_preds.scm   | ./arcana-lisp $(LIBS)
 	$(CAT) tests/type_preds.scm         | ./arcana-lisp $(LIBS)
 
 clean:

src/builtins.c

@@ -27,6 +27,9 @@ static struct Object *func_cons(size_t args_count, struct Object **args_array);
 static struct Object *func_list(size_t args_count, struct Object **args_array);
 // Equivalence predicates
 static struct Object *func_equal_QN(size_t args_count, struct Object **args_array);
+// Type equivalence predicates
+static struct Object *func_boolean_EQ_QN(size_t args_count, struct Object **args_array);
+static struct Object *func_symbol_EQ_QN(size_t args_count, struct Object **args_array);
 // Type conversion
 static struct Object *func_number_TO_string(size_t args_count, struct Object **args_array);
 static struct Object *func_string_TO_symbol(size_t args_count, struct Object **args_array);
@@ -56,6 +59,9 @@ static struct Object builtins[] = {
     { .type = TYPE_PROCEDURE, .procedure = { "list",            func_list                  } },
     // Equivalence predicates
     { .type = TYPE_PROCEDURE, .procedure = { "equal?",          func_equal_QN              } },
+    // Type equivalence predicates
+    { .type = TYPE_PROCEDURE, .procedure = { "boolean=?",       func_boolean_EQ_QN         } },
+    { .type = TYPE_PROCEDURE, .procedure = { "symbol=?",        func_symbol_EQ_QN          } },
     // Type conversion
     { .type = TYPE_PROCEDURE, .procedure = { "number->string",  func_number_TO_string      } },
     { .type = TYPE_PROCEDURE, .procedure = { "string->symbol",  func_string_TO_symbol      } },
@@ -332,7 +338,7 @@ struct Object *func_list(
  **************************/
 
 struct Object *func_equal_QN(
-    size_t args_count,
+    const size_t args_count,
     struct Object **const args_array
 ) {
     if (args_count <= 1) return Object_new_boolean(true);
@@ -389,6 +395,56 @@ struct Object *func_equal_QN(
     return result;
 }
 
+/*******************************
+ * Type equivalence predicates *
+ *******************************/
+
+struct Object *func_boolean_EQ_QN(
+    const size_t args_count,
+    struct Object **const args_array
+) {
+    assert(args_count > 0);
+
+    struct Object *const first = args_array[0];
+    assert(Object_is_boolean(first));
+
+    struct Object *const result = Object_new_boolean(true);
+
+    for (size_t index = 1; result->boolean && index < args_count; ++index) {
+        assert(Object_is_boolean(args_array[index]));
+    }
+
+    for (size_t index = 1; result->boolean && index < args_count; ++index) {
+        struct Object *const curr = args_array[index];
+        if (curr->boolean != first->boolean) result->boolean = false;
+    }
+
+    return result;
+}
+
+struct Object *func_symbol_EQ_QN(
+    const size_t args_count,
+    struct Object **const args_array
+) {
+    assert(args_count > 0);
+
+    struct Object *const first = args_array[0];
+    assert(Object_is_symbol(first));
+
+    struct Object *const result = Object_new_boolean(true);
+
+    for (size_t index = 1; result->boolean && index < args_count; ++index) {
+        assert(Object_is_symbol(args_array[index]));
+    }
+
+    for (size_t index = 1; result->boolean && index < args_count; ++index) {
+        struct Object *const curr = args_array[index];
+        if (strcmp(curr->s, first->s)) result->boolean = false;
+    }
+
+    return result;
+}
+
 /*******************
  * Type conversion *
  *******************/

tests/type_equiv_preds.scm

@@ -0,0 +1,39 @@
+;;; boolean=? ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(assert-true  (boolean=? #false))
+(assert-true  (boolean=? #true))
+(assert-true  (boolean=? #false #false))
+(assert-true  (boolean=? #true  #true))
+(assert-true  (boolean=? #false #false #false))
+(assert-true  (boolean=? #true  #true  #true))
+(assert-true  (boolean=? #false #false #false #false))
+(assert-true  (boolean=? #true  #true  #true  #true))
+(assert-true  (boolean=? #false #false #false #false #false))
+(assert-true  (boolean=? #true  #true  #true  #true  #true))
+(assert-false (boolean=? #false #true))
+(assert-false (boolean=? #true  #false))
+(assert-false (boolean=? #false #false #true))
+(assert-false (boolean=? #false #true  #false))
+(assert-false (boolean=? #false #true  #true))
+(assert-false (boolean=? #true  #false #false))
+(assert-false (boolean=? #true  #false #true))
+(assert-false (boolean=? #true  #true  #false))
+
+;;; symbol=? ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(assert-true  (symbol=? 'foo))
+(assert-true  (symbol=? 'bar))
+(assert-true  (symbol=? 'foo 'foo))
+(assert-true  (symbol=? 'bar 'bar))
+(assert-true  (symbol=? 'foo 'foo 'foo))
+(assert-true  (symbol=? 'bar 'bar 'bar))
+(assert-true  (symbol=? 'foo 'foo 'foo 'foo))
+(assert-true  (symbol=? 'bar 'bar 'bar 'bar))
+(assert-true  (symbol=? 'foo 'foo 'foo 'foo 'foo))
+(assert-true  (symbol=? 'bar 'bar 'bar 'bar 'bar))
+(assert-false (symbol=? 'foo 'bar))
+(assert-false (symbol=? 'bar 'foo))
+(assert-false (symbol=? 'foo 'foo 'bar))
+(assert-false (symbol=? 'foo 'bar 'foo))
+(assert-false (symbol=? 'foo 'bar 'bar))
+(assert-false (symbol=? 'bar 'foo 'foo))
+(assert-false (symbol=? 'bar 'foo 'bar))
+(assert-false (symbol=? 'bar 'bar 'foo))