From 581116c655df4eb753098e013dd5854df95f7865 Mon Sep 17 00:00:00 2001
From: Bad Diode <bd@badd10de.dev>
Date: Sun, 10 Oct 2021 18:41:31 +0200
Subject: Add type introspection functions and tests

---
 Makefile                    |  1 +
 examples/booleans.bdl       |  9 ------
 examples/types.bdl          | 73 +++++++++++++++++++++++++++++++++++++++++++++
 src/bootstrap/primitives.c  | 57 ++++++++++++++++++++++++-----------
 tests/booleans_expected.txt |  7 -----
 tests/types_expected.txt    | 53 ++++++++++++++++++++++++++++++++
 6 files changed, 167 insertions(+), 33 deletions(-)
 create mode 100644 examples/types.bdl
 create mode 100644 tests/types_expected.txt

diff --git a/Makefile b/Makefile
index 39d2fe0..ebb1bfb 100755
--- a/Makefile
+++ b/Makefile
@@ -50,6 +50,7 @@ tests: $(BIN)
 	./$(BIN) examples/arithmetic.bdl | diff tests/arithmetic_expected.txt -
 	./$(BIN) examples/booleans.bdl | diff tests/booleans_expected.txt -
 	./$(BIN) examples/lists.bdl | diff tests/lists_expected.txt -
+	./$(BIN) examples/types.bdl | diff tests/types_expected.txt -
 
 # Remove build directory.
 clean:
diff --git a/examples/booleans.bdl b/examples/booleans.bdl
index 8828ac2..e38fb1f 100644
--- a/examples/booleans.bdl
+++ b/examples/booleans.bdl
@@ -2,15 +2,6 @@
 ;; Boolean primitives.
 ;;
 
-;; Boolean test.
-(print "(boolean? true) -> ")       (boolean? true)
-(print "(boolean? false) -> ")      (boolean? false)
-(print "(boolean? 1) -> ")          (boolean? 1)
-(print "(boolean? 5) -> ")          (boolean? 5)
-(print "(boolean? \"string\") -> ") (boolean? "string")
-(print "(boolean? (+ 1 2 3)) -> ")  (boolean? (+ 1 2 3))
-(print "(boolean? (not 1)) -> ")    (boolean? (not 1))
-
 ;; Not.
 (print "(not true) -> ")             (not true)
 (print "(not false) -> ")            (not false)
diff --git a/examples/types.bdl b/examples/types.bdl
new file mode 100644
index 0000000..43b7be9
--- /dev/null
+++ b/examples/types.bdl
@@ -0,0 +1,73 @@
+;;
+;; Type testing.
+;;
+
+;; Boolean.
+(print "(boolean? true) -> ")       (boolean? true)
+(print "(boolean? false) -> ")      (boolean? false)
+(print "(boolean? 1) -> ")          (boolean? 1)
+(print "(boolean? 5) -> ")          (boolean? 5)
+(print "(boolean? \"string\") -> ") (boolean? "string")
+(print "(boolean? (+ 1 2 3)) -> ")  (boolean? (+ 1 2 3))
+(print "(boolean? (not 1)) -> ")    (boolean? (not 1))
+
+;; Empty list/null.
+(print "(null? true) -> ")       (null? true)
+(print "(null? false) -> ")      (null? false)
+(print "(null? 1) -> ")          (null? 1)
+(print "(null? 5) -> ")          (null? 5)
+(print "(null? \"string\") -> ") (null? "string")
+(print "(null? (+ 1 2 3)) -> ")  (null? (+ 1 2 3))
+(print "(null? (not 1)) -> ")    (null? (not 1))
+(print "(null? ()) -> ")         (null? ())
+
+;; String.
+(print "(string? true) -> ")       (string? true)
+(print "(string? false) -> ")      (string? false)
+(print "(string? 1) -> ")          (string? 1)
+(print "(string? 5) -> ")          (string? 5)
+(print "(string? \"string\") -> ") (string? "string")
+(print "(string? (+ 1 2 3)) -> ")  (string? (+ 1 2 3))
+(print "(string? (not 1)) -> ")    (string? (not 1))
+
+;; Fixnum.
+(print "(fixnum? true) -> ")       (fixnum? true)
+(print "(fixnum? false) -> ")      (fixnum? false)
+(print "(fixnum? 1) -> ")          (fixnum? 1)
+(print "(fixnum? 5) -> ")          (fixnum? 5)
+(print "(fixnum? \"string\") -> ") (fixnum? "string")
+(print "(fixnum? (+ 1 2 3)) -> ")  (fixnum? (+ 1 2 3))
+(print "(fixnum? (not 1)) -> ")    (fixnum? (not 1))
+
+;; Symbol
+;; TODO: We need quotation to test for symbols.
+(print "(symbol? true) -> ")       (symbol? true)
+(print "(symbol? false) -> ")      (symbol? false)
+(print "(symbol? 1) -> ")          (symbol? 1)
+(print "(symbol? +) -> ")          (symbol? +)
+(print "(symbol? \"string\") -> ") (symbol? "string")
+(print "(symbol? (+ 1 2 3)) -> ")  (symbol? (+ 1 2 3))
+(print "(symbol? (not 1)) -> ")    (symbol? (not 1))
+; (print "(symbol? 'a) -> ")         (symbol? 'a)
+; (print "(symbol? 'c) -> ")         (symbol? 'c)
+
+;; Pair.
+(print "(pair? false) -> ")        (pair? false)
+(print "(pair? 1) -> ")            (pair? 1)
+(print "(pair? 5) -> ")            (pair? 5)
+(print "(pair? \"string\") -> ")   (pair? "string")
+(print "(pair? (+ 1 2 3)) -> ")    (pair? (+ 1 2 3))
+(print "(pair? (not 1)) -> ")      (pair? (not 1))
+(print "(pair? (cons 1 2)) -> ")   (pair? (cons 1 2))
+(print "(pair? (list 1 2 3)) -> ") (pair? (list 1 2 3))
+
+; ;; Procedure.
+(print "(procedure? false) -> ")      (procedure? false)
+(print "(procedure? 1) -> ")          (procedure? 1)
+(print "(procedure? 5) -> ")          (procedure? 5)
+(print "(procedure? \"string\") -> ") (procedure? "string")
+(print "(procedure? (+ 1 2 3)) -> ")  (procedure? (+ 1 2 3))
+(print "(procedure? (not 1)) -> ")    (procedure? (not 1))
+(print "(procedure? +) -> ")          (procedure? +)
+(print "(procedure? -) -> ")          (procedure? -)
+(print "(procedure? procedure?) -> ") (procedure? procedure?)
diff --git a/src/bootstrap/primitives.c b/src/bootstrap/primitives.c
index 6300067..806656e 100644
--- a/src/bootstrap/primitives.c
+++ b/src/bootstrap/primitives.c
@@ -300,49 +300,72 @@ proc_print(Object *args) {
 
 Object *
 proc_is_boolean(Object *args) {
-    Object *obj = NULL;
-    if (args->type == OBJ_TYPE_PAIR) {
-        obj = eval(args->car);
-    } else {
-        obj = eval(args);
+    if (args->type != OBJ_TYPE_PAIR) {
+        fprintf(stderr, "error: wrong number of arguments.\n");
+        return NULL;
     }
+    Object *obj = eval(args->car);
     return (obj == obj_true || obj == obj_false) ? obj_true : obj_false;
 }
 
 Object *
 proc_is_null(Object *args) {
-    // TODO: stub
-    return NULL;
+    if (args->type != OBJ_TYPE_PAIR) {
+        fprintf(stderr, "error: wrong number of arguments.\n");
+        return NULL;
+    }
+    Object *obj = eval(args->car);
+    return obj == obj_nil ? obj_true : obj_false;
 }
 
 Object *
 proc_is_symbol(Object *args) {
-    // TODO: stub
-    return NULL;
+    if (args->type != OBJ_TYPE_PAIR) {
+        fprintf(stderr, "error: wrong number of arguments.\n");
+        return NULL;
+    }
+    Object *obj = eval(args->car);
+    return obj->type == OBJ_TYPE_SYMBOL ? obj_true : obj_false;
 }
 
 Object *
 proc_is_string(Object *args) {
-    // TODO: stub
-    return NULL;
+    if (args->type != OBJ_TYPE_PAIR) {
+        fprintf(stderr, "error: wrong number of arguments.\n");
+        return NULL;
+    }
+    Object *obj = eval(args->car);
+    return obj->type == OBJ_TYPE_STRING ? obj_true : obj_false;
 }
 
 Object *
 proc_is_fixnum(Object *args) {
-    // TODO: stub
-    return NULL;
+    if (args->type != OBJ_TYPE_PAIR) {
+        fprintf(stderr, "error: wrong number of arguments.\n");
+        return NULL;
+    }
+    Object *obj = eval(args->car);
+    return obj->type == OBJ_TYPE_FIXNUM ? obj_true : obj_false;
 }
 
 Object *
 proc_is_pair(Object *args) {
-    // TODO: stub
-    return NULL;
+    if (args->type != OBJ_TYPE_PAIR) {
+        fprintf(stderr, "error: wrong number of arguments.\n");
+        return NULL;
+    }
+    Object *obj = eval(args->car);
+    return obj->type == OBJ_TYPE_PAIR ? obj_true : obj_false;
 }
 
 Object *
 proc_is_procedure(Object *args) {
-    // TODO: stub
-    return NULL;
+    if (args->type != OBJ_TYPE_PAIR) {
+        fprintf(stderr, "error: wrong number of arguments.\n");
+        return NULL;
+    }
+    Object *obj = eval(args->car);
+    return obj->type == OBJ_TYPE_PROCEDURE ? obj_true : obj_false;
 }
 
 //
diff --git a/tests/booleans_expected.txt b/tests/booleans_expected.txt
index 5919767..f47d32f 100644
--- a/tests/booleans_expected.txt
+++ b/tests/booleans_expected.txt
@@ -1,10 +1,3 @@
-(boolean? true) -> true
-(boolean? false) -> true
-(boolean? 1) -> false
-(boolean? 5) -> false
-(boolean? "string") -> false
-(boolean? (+ 1 2 3)) -> false
-(boolean? (not 1)) -> true
 (not true) -> false
 (not false) -> true
 (not (not true)) -> true
diff --git a/tests/types_expected.txt b/tests/types_expected.txt
new file mode 100644
index 0000000..3a5a2de
--- /dev/null
+++ b/tests/types_expected.txt
@@ -0,0 +1,53 @@
+(boolean? true) -> true
+(boolean? false) -> true
+(boolean? 1) -> false
+(boolean? 5) -> false
+(boolean? "string") -> false
+(boolean? (+ 1 2 3)) -> false
+(boolean? (not 1)) -> true
+(null? true) -> false
+(null? false) -> false
+(null? 1) -> false
+(null? 5) -> false
+(null? "string") -> false
+(null? (+ 1 2 3)) -> false
+(null? (not 1)) -> false
+(null? ()) -> true
+(string? true) -> false
+(string? false) -> false
+(string? 1) -> false
+(string? 5) -> false
+(string? "string") -> true
+(string? (+ 1 2 3)) -> false
+(string? (not 1)) -> false
+(fixnum? true) -> false
+(fixnum? false) -> false
+(fixnum? 1) -> true
+(fixnum? 5) -> true
+(fixnum? "string") -> false
+(fixnum? (+ 1 2 3)) -> true
+(fixnum? (not 1)) -> false
+(symbol? true) -> false
+(symbol? false) -> false
+(symbol? 1) -> false
+(symbol? +) -> false
+(symbol? "string") -> false
+(symbol? (+ 1 2 3)) -> false
+(symbol? (not 1)) -> false
+(pair? false) -> false
+(pair? 1) -> false
+(pair? 5) -> false
+(pair? "string") -> false
+(pair? (+ 1 2 3)) -> false
+(pair? (not 1)) -> false
+(pair? (cons 1 2)) -> true
+(pair? (list 1 2 3)) -> true
+(procedure? false) -> false
+(procedure? 1) -> false
+(procedure? 5) -> false
+(procedure? "string") -> false
+(procedure? (+ 1 2 3)) -> false
+(procedure? (not 1)) -> false
+(procedure? +) -> true
+(procedure? -) -> true
+(procedure? procedure?) -> true
-- 
cgit v1.2.1