Fix some bugs with the reader

src/lisp.c

@@ -887,6 +887,7 @@ DEF_STATIC_SYMBOL(finally, ":finally");
 DEF_STATIC_SYMBOL(shutdown_signal, "shutdown-signal");
 DEF_STATIC_SYMBOL(type_error, "type-error");
 DEF_STATIC_SYMBOL(read_error, "read-error");
+DEF_STATIC_SYMBOL(unclosed_error, "read-error");
 DEF_STATIC_SYMBOL(eof_error, "eof-error");
 DEF_STATIC_SYMBOL(void_variable_error, "void-variable-error");
 DEF_STATIC_SYMBOL(void_function_error, "void-function-error");
@@ -1052,6 +1053,7 @@ void lisp_init(void) {
     REGISTER_SYMBOL(type_error);
     REGISTER_SYMBOL(read_error);
     REGISTER_SYMBOL(eof_error);
+    REGISTER_SYMBOL(unclosed_error);
     REGISTER_SYMBOL(void_variable_error);
     REGISTER_SYMBOL(void_function_error);
     REGISTER_SYMBOL(circular_error);
@@ -1623,9 +1625,20 @@ DEFUN(eval_in_env, "eval-in-env", (LispVal * form, LispVal *lexenv)) {
     case TYPE_VECTOR: {
         LispVector *vec = (LispVector *) form;
         LispVal **elts = lisp_malloc(sizeof(LispVal *) * vec->length);
+        if (elts) { // in case length is 0
+            memset(elts, 0, sizeof(LispVal *) * vec->length);
+        }
+        WITH_PUSH_FRAME(Qnil, Qnil, true, {
+            struct UnrefListData uld;
+            uld.vals = elts;
+            uld.len = vec->length;
+            void *cl_handler =
+                register_cleanup(&unref_free_list_double_ptr, &uld);
             for (size_t i = 0; i < vec->length; ++i) {
                 elts[i] = Feval_in_env(vec->data[i], lexenv);
             }
+            cancel_cleanup(cl_handler);
+        });
         // does not ref its arguments
         return make_lisp_vector(elts, vec->length);
     }

src/lisp.h

@@ -491,6 +491,13 @@ void cancel_cleanup(void *handle);
         cancel_cleanup(__with_cleanup_cleanup);                   \
         refcount_unref(var);                                      \
     }
+#define WITH_CLEANUP_IF_THROW(var, body)                          \
+    {                                                             \
+        void *__with_cleanup_cleanup =                            \
+            register_cleanup(&refcount_unref_as_callback, (var)); \
+        {body};                                                   \
+        cancel_cleanup(__with_cleanup_cleanup);                   \
+    }
 
 DECLARE_FUNCTION(backtrace, (void) );
 noreturn DECLARE_FUNCTION(return_from, (LispVal * name, LispVal *value));
@@ -502,6 +509,7 @@ extern LispVal *Qshutdown_signal;
 extern LispVal *Qtype_error;
 extern LispVal *Qread_error;
 extern LispVal *Qeof_error;
+extern LispVal *Qunclosed_error;
 extern LispVal *Qvoid_variable_error;
 extern LispVal *Qvoid_function_error;
 extern LispVal *Qcircular_error;

src/read.c

@@ -50,12 +50,13 @@ static inline _Noreturn void _internal_read_error(struct ReadState *state,
     LispVal *col = make_lisp_integer(state->col);
     LispVal *ctx = make_lisp_string(state->head, len, false, false);
     LispVal *args = const_list(false, 4, line, col, ctx, refcount_ref(desc));
-    WITH_CLEANUP(args, {
+    Fthrow(cause, args);
-        Fthrow(cause, args); //
-    });
 }
 #define READ_ERROR(state, len, ...) \
     _internal_read_error(state, len, sprintf_lisp(__VA_ARGS__), Qread_error)
+#define UNCLOSED_ERROR(state, type)                                       \
+    _internal_read_error(state, 1, sprintf_lisp("unterminated %s", type), \
+                         Qunclosed_error)
 #define EOF_ERROR(state)                                                   \
     _internal_read_error(state, 1, sprintf_lisp("unexpected end of file"), \
                          Qeof_error)
@@ -65,6 +66,11 @@ static inline _Noreturn void _internal_read_error(struct ReadState *state,
         popc(state);            \
     }
 #define SKIP_WHITESPACE(state) SKIP_WHILE(isspace(peekc(state)), state)
+#define SKIP_COMMENT(state)                                  \
+    for (int c = peekc(state); c == ';'; c = peekc(state)) { \
+        SKIP_WHILE(peekc(state) != '\n', state);             \
+        SKIP_WHITESPACE(state);                              \
+    }
 
 static bool is_symbol_end(int c) {
     return c == EOS || isspace(c) || c == '(' || c == ')' || c == '['
@@ -86,11 +92,12 @@ static LispVal *read_list(struct ReadState *state) {
     LispVal *list = Qnil;
     LispVal *end = list;
     SKIP_WHITESPACE(state);
+    SKIP_COMMENT(state);
     int c;
     while ((c = peekc(state)) != ')') {
         if (c == EOS) {
             refcount_unref(list);
-            EOF_ERROR(state);
+            UNCLOSED_ERROR(state, "list");
         }
         LispVal *elt = read_internal(state);
         if (is_dot_symbol(elt)) {
@@ -101,12 +108,13 @@ static LispVal *read_list(struct ReadState *state) {
             SKIP_WHITESPACE(state);
             if (c == EOS) {
                 refcount_unref(list);
-                EOF_ERROR(state);
+                UNCLOSED_ERROR(state, "list");
             }
             LispVal *last = read_internal(state);
             Fsettail(end, last);
             refcount_unref(last);
             SKIP_WHITESPACE(state);
+            SKIP_COMMENT(state);
             if (peekc(state) != ')') {
                 refcount_unref(list);
                 READ_ERROR(state, 1,
@@ -125,6 +133,7 @@ static LispVal *read_list(struct ReadState *state) {
             end = new_end;
         }
         SKIP_WHITESPACE(state);
+        SKIP_COMMENT(state);
     }
     popc(state); // close )
     return list;
@@ -135,10 +144,11 @@ static LispVal *read_vector(struct ReadState *state) {
     LispVal **values = NULL;
     size_t values_len = 0;
     SKIP_WHITESPACE(state);
+    SKIP_COMMENT(state);
     int c;
     while ((c = peekc(state)) != ']') {
         if (c == EOS) {
-            EOF_ERROR(state);
+            UNCLOSED_ERROR(state, "vector");
             for (size_t i = 0; i < values_len; ++i) {
                 refcount_unref(values[i]);
             }
@@ -149,6 +159,7 @@ static LispVal *read_vector(struct ReadState *state) {
         values = lisp_realloc(values, sizeof(LispVal *) * ++values_len);
         values[values_len - 1] = elt;
         SKIP_WHITESPACE(state);
+        SKIP_COMMENT(state);
     }
     popc(state); // close ]
     return make_lisp_vector(values, values_len);
@@ -165,7 +176,7 @@ static LispVal *read_string(struct ReadState *state) {
         c = popc(state);
         if (c == EOS) {
             lisp_free(str);
-            EOF_ERROR(state);
+            UNCLOSED_ERROR(state, "string");
             return Qnil;
         }
         if (!backslash && c == '\\') {
@@ -288,9 +299,6 @@ static LispVal *read_symbol(struct ReadState *state) {
         } else if (c == '\n') {
             free(str);
             READ_ERROR(state, 1, "backslash not escaping anything");
-        } else if (c == EOS) {
-            free(str);
-            EOF_ERROR(state);
         } else {
             str = lisp_realloc(str, ++str_len + 1);
             str[str_len - 1] = c;
@@ -374,13 +382,8 @@ change_to_symbol:
 
 static LispVal *read_internal(struct ReadState *state) {
     SKIP_WHILE(isspace(peekc(state)), state);
+    SKIP_COMMENT(state);
     int c = peekc(state);
-    // comment
-    while (c == ';') {
-        SKIP_WHILE(peekc(state) != '\n', state);
-        SKIP_WHITESPACE(state);
-        c = peekc(state);
-    }
     switch (c) {
         // list
     case EOS:
@@ -472,7 +475,10 @@ size_t read_from_buffer(const char *text, size_t length, LispVal **out) {
         .col = 0,
         .backquote_level = 0,
     };
-    LispVal *res = read_internal(&state);
+    LispVal *res = NULL;
+    WITH_PUSH_FRAME(Qnil, Qnil, true, {
+        res = read_internal(&state); //
+    });
     if (!res) {
         *out = Qnil;
         return LISP_EOF;
@@ -484,6 +490,7 @@ size_t read_from_buffer(const char *text, size_t length, LispVal **out) {
 
 DEFUN(read, "read", (LispVal * source)) {
     LispString *str = (LispString *) source;
+    CHECK_TYPE(TYPE_STRING, source);
     struct ReadState state = {
         .head = str->data,
         .left = str->length,
@@ -492,7 +499,10 @@ DEFUN(read, "read", (LispVal * source)) {
         .col = 0,
         .backquote_level = 0,
     };
-    LispVal *res = read_internal(&state);
+    LispVal *res = NULL;
+    WITH_PUSH_FRAME(Qnil, Qnil, true, {
+        res = read_internal(&state); //
+    });
     if (!res) {
         EOF_ERROR(&state);
     } else {