Exception handling

src/base.c

@@ -102,6 +102,19 @@ LispVal *make_vector(LispVal **data, size_t length, bool take) {
     return obj;
 }
 
+DEFUN(vector, "vector", (LispVal * data), "(&rest data)", "") {
+    intptr_t length = list_length(data);
+    if (length == -1) {
+        lisp_signal(Qcircular_list_error, Qnil);
+    }
+    LispVal **vec_data = lisp_malloc(sizeof(LispVal *) * length);
+    size_t i = 0;
+    DOLIST(datum, data) {
+        vec_data[i++] = datum;
+    }
+    return make_vector(vec_data, length, true);
+}
+
 DEFUN(make_symbol, "make-symbol", (LispVal * name), "(name)",
       "Return an uninterned symbol called NAME.") {
     LispSymbol *obj = lisp_alloc_object(sizeof(LispSymbol), TYPE_SYMBOL);
@@ -191,7 +204,7 @@ DEFINE_SYMBOL(float, "float");
 // cons defined in list.c
 DEFINE_SYMBOL(string, "strin");
 DEFINE_SYMBOL(symbol, "symbol");
-DEFINE_SYMBOL(vector, "vector");
+// vector defined above
 DEFINE_SYMBOL(hash_table, "hash-table");
 DEFINE_SYMBOL(function, "function");
 
@@ -258,63 +271,55 @@ DEFUN(signal, "signal", (LispVal * name, LispVal *data), "(name data)", "") {
     abort();
 }
 
-static void check_condition_case_handlers(LispVal *handlers) {
-    DOTAILS(rest, handlers) {
-        LispVal *handler = XCAR(rest);
-        if (ATOM(handler)) {
-            // TODO type error
+static void check_handler_bind_handlers(LispVal *handlers) {
+    DOLIST(handler, handlers) {
+        CHECK_LISTP(handler);
+        if (!list_length_eq(handler, 2)) {
+            // TODO error
             abort();
-        } else if (LISTP(XCAR(handler))) {
+        }
+        CHECK_TYPE(XCDR(handler), TYPE_FUNCTION);
+        if (LISTP(XCAR(handler))) {
             // make sure each condition is a symbol
             DOTAILS(rest, XCAR(handler)) {
-                if (!SYMBOLP(XCAR(rest))) {
-                    // TODO error
-                    abort();
-                }
+                CHECK_TYPE(XCAR(rest), TYPE_SYMBOL);
             }
         } else if (!SYMBOLP(XCAR(handler))) {
             // if the condition is not a list or symbol, it's an error
-            // TODO type error
-            abort();
+            signal_type_error(XCAR(handler), LIST(Qsymbol, Qlist));
         }
     }
 }
 
-DEFUN(condition_case, "condition-case",
-      (LispVal * var, LispVal *form, LispVal *handlers),
-      "(var form &rest handlers)", "") {
-    CHECK_TYPE(var, TYPE_SYMBOL);
-    check_condition_case_handlers(handlers);
+DEFUN(handler_bind, "handler-bind", (LispVal * thunk, LispVal *handlers),
+      "(thunk &rest handlers)", "") {
+    check_handler_bind_handlers(handlers);
     StackFrame *stack_ref = LISP_STACK_REF();
     jmp_buf jmp_target;
-    LispVal *success_handler = Qnil;
+    size_t nhandlers = list_length(handlers);
+    LispVal **handler_vec = lisp_malloc(sizeof(LispVal *) * nhandlers);
+    bool **enabled_vec = lisp_malloc(sizeof(bool *) * nhandlers);
     size_t idx = 0;
     DOLIST(handler, handlers) {
-        if (EQ(XCAR(handler), Qkw_success)) {
-            success_handler = XCDR(handler);
-        } else {
-            push_condition_case_frame(&jmp_target, XCAR(handler), idx);
-        }
+        handler_vec[idx] = XCDR(handler);
+        enabled_vec[idx] =
+            push_handler_bind_frame(&jmp_target, XCAR(handler), idx);
         ++idx;
     }
     if (setjmp(jmp_target) == 0) {
-        LispVal *res = Feval(form, Vlexical_environment);
-        unwind_to(stack_ref);
-        if (NILP(success_handler)) {
-            return res;
-        } else {
-            return Fprogn(success_handler);
-        }
+        return UNWIND_AND_RETURN(stack_ref, CALL0(thunk));
     } else {
-        unwind_to(stack_ref);
-        if (!NILP(var)) {
-            push_copy_lexenv();
-            new_lexical_variable(var, CONS(EXCEPTION_NAME(), EXCEPTION_DATA()));
+        size_t handler_idx = EXCEPTION_HANDLER_FRAME()->handler_bind.datum;
+        for (size_t i = 0; i < nhandlers; ++i) {
+            *enabled_vec[i] = false;
         }
-        UNWIND_AND_RETURN(
-            stack_ref, Fprogn(XCDR(nth(EXCEPTION_HANDLER_DATUM(), handlers))));
+        CALL(handler_vec[handler_idx],
+             CONS(EXCEPTION_NAME(), EXCEPTION_DATA()));
+        for (size_t i = 0; i < nhandlers; ++i) {
+            *enabled_vec[i] = true;
+        }
+        continue_unwinding();
     }
-    return Qnil;
 }
 
 DEFUN(error, "error", (LispVal * data), "(data)", "") {