diff --git a/src/lisp.c b/src/lisp.c index 969e9d9..57f5dd2 100644 --- a/src/lisp.c +++ b/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); - for (size_t i = 0; i < vec->length; ++i) { - elts[i] = Feval_in_env(vec->data[i], lexenv); + 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); } diff --git a/src/lisp.h b/src/lisp.h index 1a7cecc..572b7ea 100644 --- a/src/lisp.h +++ b/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; diff --git a/src/read.c b/src/read.c index e552ce2..8e97bc9 100644 --- a/src/read.c +++ b/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 {