Zander671/simple-lisp
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Fix some bugs with the reader

Browse Source
This commit is contained in:
Alexander Rosenberg
2025-09-20 20:43:40 -07:00
parent 4f1c2fea55
commit 56587ed8cf
3 changed files with 51 additions and 20 deletions
Download Patch File Download Diff File Expand all files Collapse all files

13
src/lisp.c
View File

@ -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);
}

8
src/lisp.h
View File

@ -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;

46
src/read.c
View File

@ -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 {