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

Change to using RefCount

Browse Source
This commit is contained in:
Alexander Rosenberg
2025-09-10 02:57:48 -07:00
parent a38fef7857
commit 994827431c
6 changed files with 1110 additions and 779 deletions
Download Patch File Download Diff File Expand all files Collapse all files

19
CMakeLists.txt
View File

@ -1,10 +1,23 @@
cmake_minimum_required(VERSION 3.10)
set(CMAKE_C_STANDARD 11)
set(CMAKE_EXPORT_COMPILE_COMMANDS TRUE)
project(simple-lisp)
project(
simple-lisp
VERSION 1.0
LANGUAGES C)
add_compile_options(-Wall -fsanitize=address,leak,undefined)
include(FetchContent)
FetchContent_Declare(
refcount
GIT_REPOSITORY https://git.zander.im/Zander671/refcount.git
GIT_TAG ae7b645b7a4919c20c75f68348347038601229f7)
FetchContent_MakeAvailable(refcount)
add_compile_options(-fsanitize=address,leak,undefined)
add_link_options(-fsanitize=address,leak,undefined)
add_executable(simple-lisp src/main.c src/lisp.c src/read.c)
target_link_libraries(simple-lisp PUBLIC refcount)
target_compile_options(simple-lisp PRIVATE -Wall -Wpedantic)

1402
src/lisp.c
View File

File diff suppressed because it is too large Load Diff

150
src/lisp.h
View File

@ -1,6 +1,7 @@
#ifndef INCLUDED_LISP_H
#define INCLUDED_LISP_H
#include <refcount/refcount.h>
#include <setjmp.h>
#include <stdarg.h>
#include <stdbool.h>
@ -10,7 +11,7 @@
#include <stdlib.h>
#include <stdnoreturn.h>
#if __has_attribute(format)
#if defined(__has_attribute) && __has_attribute(format)
# define PRINTF_FORMAT(first, second) \
__attribute__((format(printf, first, second)))
#else
@ -41,9 +42,7 @@ extern struct _TypeNameEntry LISP_TYPE_NAMES[N_LISP_TYPES];
#define LISP_OBJECT_HEADER \
LispType type; \
void *gc_root; \
ptrdiff_t ref_count; \
bool finalizing;
RefcountEntry refcount
typedef struct {
LISP_OBJECT_HEADER;
@ -91,6 +90,7 @@ typedef struct {
LispVal **data;
size_t length;
bool is_static;
} LispVector;
struct OptArgDesc {
@ -102,6 +102,8 @@ struct OptArgDesc {
void free_opt_arg_desc(void *obj);
typedef void (*lisp_function_ptr_t)(void);
typedef struct {
LISP_OBJECT_HEADER;
@ -118,7 +120,7 @@ typedef struct {
bool allow_other_keys;
LispVal *rest_arg;
union {
void *builtin;
lisp_function_ptr_t builtin;
LispVal *body;
};
@ -211,36 +213,33 @@ inline static bool NUMBERP(LispVal *v) {
#define DEF_STATIC_STRING(name, value) \
static LispString name = { \
.type = TYPE_STRING, \
.ref_count = -1, \
.data = value, \
.length = sizeof(value) - 1, \
.is_static = true, \
};
}
#define DEF_STATIC_SYMBOL(c_name, lisp_name) \
DEF_STATIC_STRING(_Q##c_name##_name, lisp_name); \
static LispSymbol _Q##c_name = { \
.type = TYPE_SYMBOL, \
.ref_count = -1, \
.name = &_Q##c_name##_name, \
.plist = Qnil, \
.function = Qunbound, \
.value = Qunbound, \
.is_constant = false, \
}; \
LispVal *Q##c_name = LISPVAL(&_Q##c_name);
LispVal *Q##c_name = LISPVAL(&_Q##c_name)
#define DECLARE_FUNCTION(c_name, args) \
LispVal *F##c_name args; \
extern LispVal *Q##c_name;
extern LispVal *Q##c_name
// The args and doc fields are filled when the function is registered
#define _INTERNAL_DEFUN_EXTENDED(macrop, c_name, lisp_name, c_args) \
LispVal *F##c_name c_args; \
DEF_STATIC_STRING(_Q##c_name##_name, lisp_name); \
static LispFunction _Q##c_name##_function = { \
.type = TYPE_FUNCTION, \
.ref_count = -1, \
.is_builtin = true, \
.is_macro = macrop, \
.builtin = &F##c_name, \
.builtin = (void (*)(void)) & F##c_name, \
.doc = Qnil, \
.args = Qnil, \
.rargs = Qnil, \
@ -251,7 +250,6 @@ inline static bool NUMBERP(LispVal *v) {
}; \
static LispSymbol _Q##c_name = { \
.type = TYPE_SYMBOL, \
.ref_count = -1, \
.name = &_Q##c_name##_name, \
.plist = Qnil, \
.value = Qunbound, \
@ -285,11 +283,11 @@ inline static bool NUMBERP(LispVal *v) {
} \
}
#define FOREACH(var, list) \
for (LispVal *__foreach_cur = list, *var = Fhead(list); \
for (LispVal *__foreach_cur = list, *var = HEAD(list); \
!NILP(__foreach_cur); \
__foreach_cur = Ftail(__foreach_cur), var = Fhead(__foreach_cur))
__foreach_cur = TAIL(__foreach_cur), var = HEAD(__foreach_cur))
#define FOREACH_TAIL(var, list) \
for (LispVal *var = list; !NILP(var); var = Ftail(var))
for (LispVal *var = list; !NILP(var); var = TAIL(var))
// #############################
// # Allocation and references #
@ -300,16 +298,7 @@ void *lisp_malloc(size_t size);
void *lisp_realloc(void *old_ptr, size_t size);
#define lisp_free free
void *lisp_ref(void *val);
void *lisp_float_ref(void *val);
void garbage_collect();
void *lisp_unref(void *val);
#define UNREF_INPLACE(variable) \
{ \
variable = lisp_unref(variable); \
}
void lisp_unref_double_ptr(void **val);
#define IGNORE_REF(val) (lisp_unref(lisp_ref(val)))
void garbage_collect(void);
// ################
// # Constructors #
@ -324,8 +313,8 @@ LispVal *make_lisp_integer(intmax_t value);
LispVal *make_lisp_float(long double value);
LispVal *make_lisp_vector(LispVal **data, size_t length);
void set_function_args(LispFunction *func, LispVal *args);
LispVal *make_lisp_function(LispVal *args, LispVal *doc, LispVal *lexenv,
LispVal *body, bool is_macro);
LispVal *make_lisp_function(LispVal *args, LispVal *lexenv, LispVal *body,
bool is_macro);
LispVal *make_lisp_hashtable(LispVal *eq_fn, LispVal *hash_fn);
LispVal *make_user_pointer(void *data, void (*free_func)(void *));
#define ALLOC_USERPTR(type, free_func) \
@ -336,7 +325,6 @@ LispVal *make_user_pointer(void *data, void (*free_func)(void *));
// ########################
bool strings_equal_nocase(const char *s1, const char *s2, size_t n);
DECLARE_FUNCTION(type_of, (LispVal * obj));
DECLARE_FUNCTION(pair, (LispVal * head, LispVal *tail));
DECLARE_FUNCTION(hash_string, (LispVal * obj));
DECLARE_FUNCTION(strings_equal, (LispVal * obj1, LispVal *obj2));
@ -349,9 +337,9 @@ DECLARE_FUNCTION(hash_table_count, (LispVal * table));
LispVal *intern(const char *name, size_t length, bool take);
DECLARE_FUNCTION(intern, (LispVal * name));
static inline LispVal *_internal_INTERN_STATIC(const char *name, size_t len) {
LispVal *kn = lisp_ref(make_lisp_string(name, len, true, true));
LispVal *kn = make_lisp_string(name, len, true, true);
LispVal *retval = Fintern(kn);
lisp_unref(kn);
refcount_unref(kn);
return retval;
}
#define INTERN_STATIC(name) (_internal_INTERN_STATIC((name), sizeof(name) - 1))
@ -372,6 +360,7 @@ static inline LispVal *const_list(int len, ...) {
} else {
LispVal *new_end = Fpair(elt, Qnil);
Fsettail(end, new_end);
refcount_unref(new_end);
end = new_end;
}
}
@ -388,6 +377,7 @@ static inline LispVal *make_list(size_t len, LispVal **vals) {
} else {
LispVal *new_end = Fpair(vals[i], Qnil);
Fsettail(end, new_end);
refcount_unref(new_end);
end = new_end;
}
}
@ -426,6 +416,7 @@ struct UnrefListData {
size_t len;
};
void unref_free_list_double_ptr(void *ptr);
void unref_double_ptr(void *ptr);
void cancel_cleanup(void *handle);
#define WITH_PUSH_FRAME(name, detail, inherit, body) \
stack_enter(name, detail, inherit); \
@ -434,16 +425,15 @@ void cancel_cleanup(void *handle);
} \
stack_leave();
#define WITH_CLEANUP(var, body) \
lisp_ref(var); \
{ \
void *__with_cleanup_cleanup = register_cleanup( \
(lisp_cleanup_func_t) & lisp_unref_double_ptr, &(var)); \
(lisp_cleanup_func_t) & unref_double_ptr, &(var)); \
{body}; \
cancel_cleanup(__with_cleanup_cleanup); \
lisp_unref(var); \
refcount_unref(var); \
}
DECLARE_FUNCTION(backtrace, ());
DECLARE_FUNCTION(backtrace, (void) );
noreturn DECLARE_FUNCTION(throw, (LispVal * signal, LispVal *rest));
extern LispVal *Qshutdown_signal;
@ -455,36 +445,35 @@ extern LispVal *Qvoid_function_error;
extern LispVal *Qcircular_error;
extern LispVal *Qmalformed_lambda_list_error;
extern LispVal *Qargument_error;
extern LispVal *Qinvalid_function_error;
extern LispVal *Qno_applicable_method_error;
LispVal *predicate_for_type(LispType type);
#define CHECK_TYPE(type, val) \
if (TYPEOF(val) != type) { \
Fthrow(Qtype_error, Qnil); \
LispVal *inner_list = const_list(1, predicate_for_type(type)); \
LispVal *args = const_list(2, inner_list, Ftype_of(LISPVAL(val))); \
refcount_unref(inner_list); \
Fthrow(Qtype_error, args); \
}
struct StaticReference {
struct StaticReference *next;
LispVal *obj;
};
extern struct StaticReference *static_references;
void add_static_reference(LispVal *obj);
extern LispVal *Vobarray;
#define REGISTER_SYMBOL(sym) \
{ \
Fputhash(Vobarray, LISPVAL(((LispSymbol *) Q##sym)->name), Q##sym); \
add_static_reference(Q##sym); \
refcount_init_static(Q##sym); \
refcount_init_static(((LispSymbol *) Q##sym)->name); \
puthash(Vobarray, LISPVAL(((LispSymbol *) Q##sym)->name), Q##sym); \
}
#define REGISTER_STATIC_FUNCTION(obj, args, docstr) \
((LispFunction *) (obj))->doc = STATIC_STRING(docstr); \
{ \
refcount_init_static(obj); \
((LispFunction *) (obj))->doc = STATIC_STRING(docstr); \
LispVal *src = STATIC_STRING(args); \
lisp_ref(src); \
set_function_args((LispFunction *) (obj), Fread(src)); \
lisp_unref(src); \
add_static_reference(obj); \
LispVal *a = Fread(src); \
set_function_args((LispFunction *) (obj), a); \
refcount_unref(src); \
refcount_unref(a); \
}
#define REGISTER_FUNCTION(fn, args, docstr) \
REGISTER_SYMBOL(fn); \
@ -496,33 +485,84 @@ void register_static_function(LispVal *func);
extern LispVal *Qbackquote;
extern LispVal *Qcomma;
extern LispVal *Qcomma_at;
DECLARE_FUNCTION(quote, (LispVal * form));
DECLARE_FUNCTION(breakpoint, (LispVal * id));
DECLARE_FUNCTION(symbol_function, (LispVal * symbol, LispVal *resolve));
DECLARE_FUNCTION(symbol_value, (LispVal * symbol));
DECLARE_FUNCTION(eval_in_env, (LispVal * form, LispVal *lexenv));
DECLARE_FUNCTION(eval, (LispVal * form));
DECLARE_FUNCTION(funcall, (LispVal * function, LispVal *rest));
DECLARE_FUNCTION(apply, (LispVal * function, LispVal *rest));
DECLARE_FUNCTION(head, (LispVal * list));
DECLARE_FUNCTION(tail, (LispVal * list));
noreturn DECLARE_FUNCTION(exit, (LispVal * code));
DECLARE_FUNCTION(print, (LispVal * obj));
DECLARE_FUNCTION(println, (LispVal * obj));
DECLARE_FUNCTION(not, (LispVal * obj));
DECLARE_FUNCTION(when, (LispVal * cond, LispVal *t));
DECLARE_FUNCTION(if, (LispVal * cond, LispVal *t, LispVal *nil));
DECLARE_FUNCTION(add, (LispVal * n1, LispVal *n2));
DECLARE_FUNCTION(setq, (LispVal * name, LispVal *value));
DECLARE_FUNCTION(add, (LispVal * args));
DECLARE_FUNCTION(sub, (LispVal * args));
DECLARE_FUNCTION(setq, (LispVal * args));
DECLARE_FUNCTION(progn, (LispVal * forms));
DECLARE_FUNCTION(fset, (LispVal * sym, LispVal *new_func));
DECLARE_FUNCTION(defun, (LispVal * name, LispVal *args, LispVal *body));
DECLARE_FUNCTION(defmacro, (LispVal * name, LispVal *args, LispVal *body));
DECLARE_FUNCTION(lambda, (LispVal * args, LispVal *body));
DECLARE_FUNCTION(while, (LispVal * condition, LispVal *body));
DECLARE_FUNCTION(make_symbol, (LispVal * name));
DECLARE_FUNCTION(macroexpand_1, (LispVal * form));
DECLARE_FUNCTION(stringp, (LispVal * val));
DECLARE_FUNCTION(symbolp, (LispVal * val));
DECLARE_FUNCTION(pairp, (LispVal * val));
DECLARE_FUNCTION(integerp, (LispVal * val));
DECLARE_FUNCTION(floatp, (LispVal * val));
DECLARE_FUNCTION(vectorp, (LispVal * val));
DECLARE_FUNCTION(functionp, (LispVal * val));
DECLARE_FUNCTION(macrop, (LispVal * val));
DECLARE_FUNCTION(hashtablep, (LispVal * val));
DECLARE_FUNCTION(user_pointer_p, (LispVal * val));
DECLARE_FUNCTION(atom, (LispVal * val));
DECLARE_FUNCTION(listp, (LispVal * val));
DECLARE_FUNCTION(keywordp, (LispVal * val));
DECLARE_FUNCTION(numberp, (LispVal * val));
DECLARE_FUNCTION(list_length, (LispVal * list));
DECLARE_FUNCTION(num_eq, (LispVal * n1, LispVal *n2));
DECLARE_FUNCTION(num_gt, (LispVal * n1, LispVal *n2));
DECLARE_FUNCTION(and, (LispVal * rest));
DECLARE_FUNCTION(or, (LispVal * rest));
DECLARE_FUNCTION(type_of, (LispVal * val));
DECLARE_FUNCTION(function_docstr, (LispVal * func));
void debug_dump(FILE *stream, void *obj, bool newline);
void debug_print_hashtable(FILE *stream, LispVal *table);
void debug_print_tree(FILE *stream, void *obj);
extern LispVal *Qopt;
extern LispVal *Qkey;
extern LispVal *Qallow_other_keys;
extern LispVal *Qrest;
// some internal functions
LispVal *puthash(LispVal *table, LispVal *key, LispVal *value);
LispVal *gethash(LispVal *table, LispVal *key, LispVal *def);
LispVal *remhash(LispVal *table, LispVal *key);
static inline LispVal *HEAD(LispVal *list) {
if (NILP(list)) {
return Qnil;
}
CHECK_TYPE(TYPE_PAIR, list);
return ((LispPair *) list)->head;
}
static inline LispVal *TAIL(LispVal *list) {
if (NILP(list)) {
return Qnil;
}
CHECK_TYPE(TYPE_PAIR, list);
return ((LispPair *) list)->tail;
}
#endif

169
src/main.c
View File

@ -6,10 +6,9 @@ static int exit_status = 0;
LispVal *Ftoplevel_exit_handler(LispVal *except);
static LispFunction _Ftoplevel_exit_handler_function = {
.type = TYPE_FUNCTION,
.ref_count = -1,
.is_builtin = 1,
.is_macro = 0,
.builtin = &Ftoplevel_exit_handler,
.is_builtin = true,
.is_macro = false,
.builtin = (lisp_function_ptr_t) &Ftoplevel_exit_handler,
.args = Qnil,
.kwargs = Qnil,
.rargs = Qnil,
@ -20,13 +19,13 @@ static LispFunction _Ftoplevel_exit_handler_function = {
#define Ftoplevel_exit_handler_function \
LISPVAL(&_Ftoplevel_exit_handler_function)
LispVal *Ftoplevel_exit_handler(LispVal *except) {
LispVal *detail = Ftail(Fhead(except));
if (NILP(detail) || NILP(Fhead(detail))) {
LispVal *detail = TAIL(HEAD(except));
if (NILP(detail) || NILP(HEAD(detail))) {
exit_status = 0;
} else if (!INTEGERP(Fhead(detail))) {
} else if (!INTEGERP(HEAD(detail))) {
exit_status = 1;
} else {
exit_status = ((LispInteger *) Fhead(detail))->value;
exit_status = ((LispInteger *) HEAD(detail))->value;
}
return Qnil;
}
@ -34,10 +33,9 @@ LispVal *Ftoplevel_exit_handler(LispVal *except) {
LispVal *Ftoplevel_error_handler(LispVal *except);
static LispFunction _Ftoplevel_error_handler_function = {
.type = TYPE_FUNCTION,
.ref_count = -1,
.is_builtin = 1,
.is_macro = 0,
.builtin = &Ftoplevel_error_handler,
.is_builtin = true,
.is_macro = false,
.builtin = (lisp_function_ptr_t) &Ftoplevel_error_handler,
.args = Qnil,
.kwargs = Qnil,
.lexenv = Qnil,
@ -48,9 +46,9 @@ static LispFunction _Ftoplevel_error_handler_function = {
#define Ftoplevel_error_handler_function \
LISPVAL(&_Ftoplevel_error_handler_function)
LispVal *Ftoplevel_error_handler(LispVal *except) {
LispVal *type = Fhead(Fhead(except));
LispVal *detail = Ftail(Fhead(except));
LispVal *backtrace = Fhead(Ftail(except));
LispVal *type = HEAD(HEAD(except));
LispVal *detail = TAIL(HEAD(except));
LispVal *backtrace = HEAD(TAIL(except));
fprintf(stderr, "Caught signal of type ");
debug_dump(stderr, type, true);
if (!NILP(detail)) {
@ -69,95 +67,56 @@ LispVal *Ftoplevel_error_handler(LispVal *except) {
DEF_STATIC_SYMBOL(toplevel_read, "toplevel-read");
int main(int argc, const char **argv) {
if (argc < 2) {
fprintf(stderr, "No input file!\n");
return 1;
}
FILE *in = fopen(argv[1], "r");
if (!in) {
perror("fopen");
return 1;
}
fseek(in, 0, SEEK_END);
off_t file_len = ftello(in);
rewind(in);
char buffer[file_len];
fread(buffer, 1, file_len, in);
fclose(in);
/* if (argc < 2) { */
/* fprintf(stderr, "No input file!\n"); */
/* return 1; */
/* } */
/* FILE *in = fopen(argv[1], "r"); */
/* if (!in) { */
/* perror("fopen"); */
/* return 1; */
/* } */
/* fseek(in, 0, SEEK_END); */
/* off_t file_len = ftello(in); */
/* rewind(in); */
/* char buffer[file_len]; */
/* fread(buffer, 1, file_len, in); */
/* fclose(in); */
lisp_init();
REGISTER_STATIC_FUNCTION(Ftoplevel_error_handler_function, "(e)", "");
REGISTER_STATIC_FUNCTION(Ftoplevel_exit_handler_function, "(e)", "");
size_t pos = 0;
// WITH_PUSH_FRAME(Qtoplevel, Qnil, false, {
// the_stack->hidden = true;
// LispVal *err_var = INTERN_STATIC("err-var");
// Fputhash(
// the_stack->handlers, Qt,
// // simply call the above function
// const_list(3, err_var, Ftoplevel_error_handler_function,
// err_var));
// Fputhash(
// the_stack->handlers, Qshutdown_signal,
// // simply call the above function
// const_list(3, err_var, Ftoplevel_exit_handler_function,
// err_var));
// Fputhash(the_stack->handlers, Qeof_error,
// // ignore
// Fpair(Qnil, Qnil));
// while (pos < file_len) {
// LispVal *tv;
// WITH_PUSH_FRAME(Qtoplevel_read, Qnil, false, {
// pos += read_from_buffer(buffer + pos, file_len - pos, &tv);
// });
// WITH_CLEANUP(tv, {
// IGNORE_REF(Feval(tv)); //
// });
// }
// });
stack_enter(Qtoplevel, (((LispVal *) (&_Qnil))), 0);
if (_setjmp(the_stack->start) == 0) {
{
the_stack->hidden = 1;
LispVal *err_var =
(_internal_INTERN_STATIC(("err-var"), sizeof("err-var") - 1));
Fputhash(
the_stack->handlers, (((LispVal *) (&_Qt))),
const_list(3, err_var,
((LispVal *) (&_Ftoplevel_error_handler_function)),
err_var));
Fputhash(
the_stack->handlers, Qshutdown_signal,
const_list(3, err_var,
((LispVal *) (&_Ftoplevel_exit_handler_function)),
err_var));
Fputhash(the_stack->handlers, Qeof_error,
Fpair((((LispVal *) (&_Qnil))), (((LispVal *) (&_Qnil)))));
while (pos < file_len) {
LispVal *tv;
stack_enter(Qtoplevel_read, (((LispVal *) (&_Qnil))), 0);
if (_setjmp(the_stack->start) == 0) {
{
pos +=
read_from_buffer(buffer + pos, file_len - pos, &tv);
}
}
stack_leave();
;
lisp_ref(tv);
{
void *__with_cleanup_cleanup = register_cleanup(
(lisp_cleanup_func_t) &lisp_unref_double_ptr, &(tv));
{{(lisp_unref(lisp_ref(Feval(tv))));
}
};
cancel_cleanup(__with_cleanup_cleanup);
lisp_unref(tv);
};
}
}
}
stack_leave();
;
lisp_shutdown();
return exit_status;
/* refcount_init_static(Qtoplevel_read); */
/* REGISTER_STATIC_FUNCTION(Ftoplevel_error_handler_function, "(e)", ""); */
/* REGISTER_STATIC_FUNCTION(Ftoplevel_exit_handler_function, "(e)", ""); */
/* size_t pos = 0; */
/* WITH_PUSH_FRAME(Qtoplevel, Qnil, false, { */
/* the_stack->hidden = true; */
/* LispVal *err_var = INTERN_STATIC("err-var"); */
/* puthash( */
/* the_stack->handlers, Qt, */
/* // simply call the above function */
/* const_list(3, err_var, Ftoplevel_error_handler_function,
* err_var)); */
/* puthash( */
/* the_stack->handlers, Qshutdown_signal, */
/* // simply call the above function */
/* const_list(3, err_var, Ftoplevel_exit_handler_function,
* err_var)); */
/* LispVal *nil_nil = Fpair(Qnil, Qnil); */
/* puthash(the_stack->handlers, Qeof_error, */
/* // ignore */
/* nil_nil); */
/* refcount_unref(nil_nil); */
/* refcount_unref(err_var); */
/* while (pos < file_len) { */
/* LispVal *tv; */
/* WITH_PUSH_FRAME(Qtoplevel_read, Qnil, false, { */
/* pos += read_from_buffer(buffer + pos, file_len - pos, &tv);
*/
/* }); */
/* WITH_CLEANUP(tv, { */
/* refcount_unref(Feval(tv)); // */
/* }); */
/* } */
/* }); */
lisp_shutdown();
return exit_status;
}

104
src/read.c
View File

@ -45,9 +45,13 @@ static inline void _internal_read_error(struct ReadState *state, size_t len,
if (len > state->left) {
len = state->left;
}
LispVal *args = const_list(
4, make_lisp_integer(state->line), make_lisp_integer(state->col),
make_lisp_string(state->head, len, false, false), desc);
LispVal *line = make_lisp_integer(state->line);
LispVal *col = make_lisp_integer(state->col);
LispVal *ctx = make_lisp_string(state->head, len, false, false);
LispVal *args = const_list(4, line, col, ctx, desc);
refcount_unref(line);
refcount_unref(col);
refcount_unref(ctx);
WITH_CLEANUP(args, {
Fthrow(cause, args); //
});
@ -71,6 +75,14 @@ static bool is_symbol_end(int c) {
static LispVal *read_internal(struct ReadState *state);
static bool is_dot_symbol(LispVal *val) {
if (!SYMBOLP(val)) {
return false;
}
LispString *name = ((LispSymbol *) val)->name;
return name->length == 1 && name->data[0] == '.';
}
static LispVal *read_list(struct ReadState *state) {
popc(state); // open (
LispVal *list = Qnil;
@ -79,17 +91,36 @@ static LispVal *read_list(struct ReadState *state) {
int c;
while ((c = peekc(state)) != ')') {
if (c == EOS) {
UNREF_INPLACE(list);
refcount_unref(list);
EOF_ERROR(state);
return Qnil;
}
LispVal *elt = read_internal(state);
if (is_dot_symbol(elt)) {
if (NILP(list)) {
READ_ERROR(state, 1, "Dot cannot start a list");
}
SKIP_WHITESPACE(state);
if (c == EOS) {
refcount_unref(list);
EOF_ERROR(state);
}
LispVal *last = read_internal(state);
Fsettail(end, last);
refcount_unref(last);
SKIP_WHITESPACE(state);
if (peekc(state) != ')') {
refcount_unref(list);
READ_ERROR(state, 1,
"Dot must be second to last element in list.");
}
break;
} else if (NILP(list)) {
list = Fpair(elt, Qnil);
end = list;
} else {
LispVal *new_end = Fpair(elt, Qnil);
Fsettail(end, new_end);
refcount_unref(new_end);
end = new_end;
}
SKIP_WHITESPACE(state);
@ -108,12 +139,12 @@ static LispVal *read_vector(struct ReadState *state) {
if (c == EOS) {
EOF_ERROR(state);
for (size_t i = 0; i < values_len; ++i) {
lisp_unref(values[i]);
refcount_unref(values[i]);
}
lisp_free(values);
return Qnil;
}
LispVal *elt = lisp_ref(read_internal(state));
LispVal *elt = read_internal(state);
values = lisp_realloc(values, sizeof(LispVal *) * ++values_len);
values[values_len - 1] = elt;
SKIP_WHITESPACE(state);
@ -130,12 +161,12 @@ static LispVal *read_string(struct ReadState *state) {
str[0] = '\0';
size_t str_len = 0;
while (backslash || peekc(state) != '"') {
c = popc(state);
if (c == EOS) {
lisp_free(str);
EOF_ERROR(state);
return Qnil;
}
c = popc(state);
if (!backslash && c == '\\') {
backslash = true;
} else if (backslash && c == '\n') {
@ -157,10 +188,10 @@ static LispVal *read_string(struct ReadState *state) {
c = '\0';
break;
case '"':
c = '"';
case '\\':
// the same character
break;
default:
// TODO make this point at the correct thing
lisp_free(str);
READ_ERROR(state, 1, "unknown escape sequence");
}
@ -169,7 +200,7 @@ static LispVal *read_string(struct ReadState *state) {
str[str_len - 1] = c;
}
}
str[str_len] = '\n';
str[str_len] = '\0';
popc(state); // close "
return make_lisp_string(str, str_len, true, false);
}
@ -240,12 +271,33 @@ static int parse_base(size_t left, const char *c) {
}
static LispVal *read_symbol(struct ReadState *state) {
const char *start = state->head;
// TODO allow escaping characters
while (!is_symbol_end(peekc(state))) {
popc(state);
bool backslash = false;
int c;
char *str = lisp_malloc(1);
str[0] = '\0';
size_t str_len = 0;
while (backslash || !is_symbol_end(peekc(state))) {
c = popc(state);
if (!backslash && c == '\\') {
backslash = true;
} else if (!backslash
&& (c == '`' || c == ',' || c == '\'' || c == '"')) {
free(str);
READ_ERROR(state, 1, "invalid character for symbol name");
} 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;
backslash = false;
}
return intern(start, state->head - start, false);
}
str[str_len] = '\0';
return intern(str, str_len, true);
}
static LispVal *read_number_or_symbol(struct ReadState *state, int base) {
@ -350,7 +402,10 @@ static LispVal *read_internal(struct ReadState *state) {
case '\'': {
popc(state); // '
LispVal *tail = read_internal(state);
return Fpair(Qquote, Fpair(tail, Qnil));
LispVal *res = Fpair(Qquote, Fpair(tail, Qnil));
refcount_unref(tail);
refcount_unref(TAIL(res));
return res;
}
// backquote
case '`': {
@ -358,16 +413,27 @@ static LispVal *read_internal(struct ReadState *state) {
++state->backquote_level;
LispVal *tail = read_internal(state);
--state->backquote_level;
return Fpair(Qbackquote, Fpair(tail, Qnil));
LispVal *res = Fpair(Qbackquote, Fpair(tail, Qnil));
refcount_unref(tail);
refcount_unref(TAIL(res));
return res;
}
// comma
case ',':
popc(state); // ,
if (state->backquote_level) {
LispVal *func = Qcomma;
if (peekc(state) == '@') {
popc(state);
func = Qcomma_at;
}
--state->backquote_level;
LispVal *tail = read_internal(state);
++state->backquote_level;
return Fpair(Qcomma, Fpair(tail, Qnil));
LispVal *res = Fpair(func, Fpair(tail, Qnil));
refcount_unref(tail);
refcount_unref(TAIL(res));
return res;
} else {
READ_ERROR(state, 1, "comma not inside backquote");
return Qnil;

5
src/read.h
View File

@ -5,11 +5,6 @@
#include <stddef.h>
typedef enum {
SEVERITY_WARN,
SEVERITY_ERROR,
} ReadErrorSeverity;
size_t read_from_buffer(const char *text, size_t length, LispVal **out);
DECLARE_FUNCTION(read, (LispVal * source));