From 00cf382196f81e22256e22e5c79a9d3503db5e91 Mon Sep 17 00:00:00 2001
From: Bad Diode <bd@badd10de.dev>
Date: Wed, 13 Oct 2021 21:08:17 +0200
Subject: Add supress-errors primitive and variable tests

---
 Makefile                     |  1 +
 examples/variables.bdl       | 16 ++++++++++++++++
 src/bootstrap/errors.c       |  1 +
 src/bootstrap/main.c         | 10 +++++++---
 src/bootstrap/primitives.c   | 31 +++++++++++++++++++++++++++++++
 tests/variables_expected.txt | 11 +++++++++++
 6 files changed, 67 insertions(+), 3 deletions(-)
 create mode 100644 examples/variables.bdl
 create mode 100644 tests/variables_expected.txt

diff --git a/Makefile b/Makefile
index ebb1bfb..50e0828 100755
--- a/Makefile
+++ b/Makefile
@@ -51,6 +51,7 @@ tests: $(BIN)
 	./$(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 -
+	./$(BIN) examples/variables.bdl | diff tests/variables_expected.txt -
 
 # Remove build directory.
 clean:
diff --git a/examples/variables.bdl b/examples/variables.bdl
new file mode 100644
index 0000000..6097368
--- /dev/null
+++ b/examples/variables.bdl
@@ -0,0 +1,16 @@
+;;
+;; Variable declarations and updates
+;;
+
+(supress-errors true)
+(print "(error? (def a 1)) -> ") (error? (def a 1))
+(print "a -> ") a
+(print "(error? (def a 300)) -> ") (error? (def a 300))
+(print "a -> ") a
+(print "(error? (def a \"strings\")) -> ") (error? (def a "strings"))
+(print "a -> ") a
+(print "(error? (def a 1)) -> ") (error? (def a '(quoted symbols 123 or "strings")))
+(print "a -> ") a
+(print "(error? (set! a 42)) -> ") (error? (set! a 42))
+(print "a -> ") a
+(print "(error? (set! b 99)) -> ") (error? (set! b 99))
diff --git a/src/bootstrap/errors.c b/src/bootstrap/errors.c
index 13a2f3c..61ea902 100644
--- a/src/bootstrap/errors.c
+++ b/src/bootstrap/errors.c
@@ -46,6 +46,7 @@ static const char* error_msgs[] = {
 #define ERR_MAX_NUMBER 16
 static Error errors[ERR_MAX_NUMBER];
 static size_t errors_n = 0;
+static bool supress_errors = false;
 
 void
 error_push(Error error) {
diff --git a/src/bootstrap/main.c b/src/bootstrap/main.c
index 052f1c0..c589b2d 100755
--- a/src/bootstrap/main.c
+++ b/src/bootstrap/main.c
@@ -61,6 +61,7 @@ init(void) {
     MAKE_ENV_PROC(global_env, "fixnum?", proc_is_fixnum);
     MAKE_ENV_PROC(global_env, "pair?", proc_is_pair);
     MAKE_ENV_PROC(global_env, "procedure?", proc_is_procedure);
+    MAKE_ENV_PROC(global_env, "error?", proc_is_error);
     MAKE_ENV_PROC(global_env, "not", proc_not);
     MAKE_ENV_PROC(global_env, "and", proc_and);
     MAKE_ENV_PROC(global_env, "or", proc_or);
@@ -74,6 +75,9 @@ init(void) {
     MAKE_ENV_PROC(global_env, "eq?", proc_equal);
     MAKE_ENV_PROC(global_env, "def", proc_define);
     MAKE_ENV_PROC(global_env, "set!", proc_set);
+
+    // Runtime procedures.
+    MAKE_ENV_PROC(global_env, "supress-errors", proc_supress_errors);
 }
 
 void
@@ -125,7 +129,7 @@ run_repl(void) {
         process_source(&sv);
 
         // Check if there were any errors.
-        if (errors_n != 0) {
+        if (errors_n != 0 && !supress_errors) {
             for (size_t i = 0; i < errors_n; i++) {
                 Error err = errors[i];
                 for (size_t j = 0; j < err.col + sizeof(REPL_PROMPT) - 2; j++) {
@@ -168,7 +172,7 @@ run_file(char *file_name) {
     process_source(&sv);
 
     // Check if there were any errors.
-    if (errors_n != 0) {
+    if (errors_n != 0 && !supress_errors) {
         for (size_t i = 0; i < errors_n; i++) {
             Error err = errors[i];
             fprintf(stderr, "%s", file_name);
@@ -210,7 +214,7 @@ run_stdin(void) {
     process_source(&sv);
 
     // Check if there were any errors.
-    if (errors_n != 0) {
+    if (errors_n != 0 && !supress_errors) {
         for (size_t i = 0; i < errors_n; i++) {
             Error err = errors[i];
             fprintf(stderr, "stdin");
diff --git a/src/bootstrap/primitives.c b/src/bootstrap/primitives.c
index a3b69f6..3afeef6 100644
--- a/src/bootstrap/primitives.c
+++ b/src/bootstrap/primitives.c
@@ -319,6 +319,22 @@ proc_is_procedure(Environment *env, Object *obj) {
     return obj->type == OBJ_TYPE_PROCEDURE ? obj_true : obj_false;
 }
 
+Object *
+proc_is_error(Environment *env, Object *obj) {
+    if (obj == obj_nil) {
+        error_push((Error){
+            .type = ERR_TYPE_RUNTIME,
+            .value = ERR_NOT_ENOUGH_ARGS,
+        });
+        return obj_err;
+    }
+    obj = eval(env, obj->car);
+    if (obj == obj_err) {
+        return obj_true;
+    }
+    return obj_false;
+}
+
 //
 // Boolean/conditional procedures.
 //
@@ -693,6 +709,21 @@ proc_eval(Environment *env, Object *obj) {
     return eval(env, eval(env, obj->car));
 }
 
+Object *
+proc_supress_errors(Environment *env, Object *obj) {
+    Object *car = extract_car_with_type(env, obj, OBJ_TYPE_BOOL);
+    if (car == obj_err) {
+        return obj_err;
+    }
+
+    if (car == obj_true) {
+        supress_errors = true;
+    } else if (car == obj_false) {
+        supress_errors = false;
+    }
+    return obj_nil;
+}
+
 // TODO: map
 // TODO: apply
 // TODO: filter
diff --git a/tests/variables_expected.txt b/tests/variables_expected.txt
new file mode 100644
index 0000000..2e6e2be
--- /dev/null
+++ b/tests/variables_expected.txt
@@ -0,0 +1,11 @@
+(error? (def a 1)) -> false
+a -> 1
+(error? (def a 300)) -> false
+a -> 300
+(error? (def a "strings")) -> false
+a -> "strings"
+(error? (def a 1)) -> false
+a -> (:quoted :symbols 123 :or "strings")
+(error? (set! a 42)) -> false
+a -> 42
+(error? (set! b 99)) -> true
-- 
cgit v1.2.1