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

Support for catching exceptions and reworked lexical variables

Browse Source
This commit is contained in:
Alexander Rosenberg
2025-09-19 02:34:38 -07:00
parent 91f2ab8e0a
commit 2b7f9b2fd6
4 changed files with 393 additions and 180 deletions
Download Patch File Download Diff File Expand all files Collapse all files

95
src/lisp.h
View File

@ -107,6 +107,7 @@ typedef void (*lisp_function_ptr_t)(void);
typedef struct {
LISP_OBJECT_HEADER;
LispVal *name;
LispVal *doc;
LispVal *args;
bool is_builtin;
@ -217,16 +218,16 @@ inline static bool NUMBERP(LispVal *v) {
.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, \
.name = &_Q##c_name##_name, \
.plist = Qnil, \
.function = Qunbound, \
.value = Qunbound, \
.is_constant = false, \
}; \
#define DEF_STATIC_SYMBOL(c_name, lisp_name) \
DEF_STATIC_STRING(_Q##c_name##_symnamestr, lisp_name); \
static LispSymbol _Q##c_name = { \
.type = TYPE_SYMBOL, \
.name = &_Q##c_name##_symnamestr, \
.plist = Qnil, \
.function = Qunbound, \
.value = Qunbound, \
.is_constant = false, \
}; \
LispVal *Q##c_name = LISPVAL(&_Q##c_name)
#define DECLARE_FUNCTION(c_name, args) \
LispVal *F##c_name args; \
@ -234,12 +235,14 @@ inline static bool NUMBERP(LispVal *v) {
// The args and doc fields are filled when the function is registered
#define _INTERNAL_DEFUN_EXTENDED(macrop, c_name, lisp_name, c_args, static_kw) \
static_kw LispVal *F##c_name c_args; \
DEF_STATIC_STRING(_Q##c_name##_name, lisp_name); \
DEF_STATIC_STRING(_Q##c_name##_fnnamestr, lisp_name); \
static LispSymbol _Q##c_name; \
static LispFunction _Q##c_name##_function = { \
.type = TYPE_FUNCTION, \
.is_builtin = true, \
.is_macro = macrop, \
.builtin = (void (*)(void)) & F##c_name, \
.name = LISPVAL(&_Q##c_name), \
.doc = Qnil, \
.args = Qnil, \
.rargs = Qnil, \
@ -250,7 +253,7 @@ inline static bool NUMBERP(LispVal *v) {
}; \
static LispSymbol _Q##c_name = { \
.type = TYPE_SYMBOL, \
.name = &_Q##c_name##_name, \
.name = &_Q##c_name##_fnnamestr, \
.plist = Qnil, \
.value = Qunbound, \
.function = LISPVAL(&_Q##c_name##_function), \
@ -315,8 +318,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 *lexenv, LispVal *body,
bool is_macro);
LispVal *make_lisp_function(LispVal *name, 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) \
@ -388,6 +391,28 @@ static inline LispVal *make_list(size_t len, LispVal **vals) {
}
return list;
}
static inline LispVal *push_many(LispVal *list, int count, ...) {
LispVal *new_list = list;
bool first = true;
va_list args;
va_start(args, count);
while (count--) {
new_list = Fpair(va_arg(args, LispVal *), new_list);
if (!first) {
refcount_unref(((LispPair *) new_list)->tail);
first = false;
}
}
va_end(args);
return new_list;
}
static inline void push_to_lexenv(LispVal **lexenv, LispVal *key,
LispVal *value) {
LispVal *old = *lexenv;
*lexenv = push_many(*lexenv, 2, value, key);
refcount_unref(old);
}
typedef void (*lisp_cleanup_func_t)(void *);
struct CleanupHandlerEntry {
struct CleanupHandlerEntry *next;
@ -402,15 +427,18 @@ typedef struct StackFrame {
LispVal *lexenv; // symbol -> value
bool enable_handlers;
LispVal *handlers; // symbol -> (error-var form)
LispVal *unwind_forms;
LispVal *unwind_form;
struct CleanupHandlerEntry *cleanup_handlers;
jmp_buf start;
} StackFrame;
#define STACK_EXIT_NORMAL 0
#define STACK_EXIT_THROW 1
extern StackFrame *the_stack;
extern LispVal *stack_return;
extern LispVal *Qtoplevel;
extern LispVal *Qparent_lexenv;
void stack_enter(LispVal *name, LispVal *detail, bool inherit);
void stack_leave(void);
@ -423,15 +451,26 @@ struct UnrefListData {
void unref_free_list_double_ptr(void *ptr);
void unref_double_ptr(void *ptr);
void cancel_cleanup(void *handle);
#define WITH_PUSH_FRAME_NO_REF_HANDLING_THROWS(name, detail, inherit, body, \
on_return) \
stack_enter(name, detail, inherit); \
{ \
int __with_push_frame_jmpval = setjmp(the_stack->start); \
if (__with_push_frame_jmpval == STACK_EXIT_NORMAL) { \
body \
} else if (__with_push_frame_jmpval == STACK_EXIT_THROW) { \
on_return; \
refcount_unref(stack_return); \
stack_return = NULL; \
} \
stack_leave(); \
}
#define WITH_PUSH_FRAME_NO_REF(name, detail, inherit, body) \
stack_enter(name, detail, inherit); \
if (setjmp(the_stack->start) == 0) { \
body \
} \
stack_leave();
WITH_PUSH_FRAME_NO_REF_HANDLING_THROWS(name, detail, inherit, body, )
#define WITH_PUSH_FRAME(name, detail, inherit, body) \
WITH_PUSH_FRAME_NO_REF(refcount_ref(name), refcount_ref(detail), inherit, \
body)
#define WITH_CLEANUP_DOUBLE_PTR(var, body) \
{ \
void *__with_cleanup_cleanup = register_cleanup( \
@ -450,8 +489,11 @@ void cancel_cleanup(void *handle);
}
DECLARE_FUNCTION(backtrace, (void) );
noreturn DECLARE_FUNCTION(return_from, (LispVal * name, LispVal *value));
noreturn DECLARE_FUNCTION(throw, (LispVal * signal, LispVal *rest));
extern LispVal *Qsuccess;
extern LispVal *Qfinally;
extern LispVal *Qshutdown_signal;
extern LispVal *Qtype_error;
extern LispVal *Qread_error;
@ -463,6 +505,7 @@ extern LispVal *Qmalformed_lambda_list_error;
extern LispVal *Qargument_error;
extern LispVal *Qinvalid_function_error;
extern LispVal *Qno_applicable_method_error;
extern LispVal *Qreturn_frame_error;
LispVal *predicate_for_type(LispType type);
#define CHECK_TYPE(type, val) \
@ -528,6 +571,7 @@ 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(condition_case, (LispVal * form, LispVal *rest));
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));
@ -561,6 +605,12 @@ DECLARE_FUNCTION(and, (LispVal * rest));
DECLARE_FUNCTION(or, (LispVal * rest));
DECLARE_FUNCTION(type_of, (LispVal * val));
DECLARE_FUNCTION(function_docstr, (LispVal * func));
DECLARE_FUNCTION(plist_get,
(LispVal * plist, LispVal *key, LispVal *def, LispVal *pred));
DECLARE_FUNCTION(plist_set, (LispVal * plist, LispVal *key, LispVal *value,
LispVal *pred));
DECLARE_FUNCTION(plist_rem, (LispVal * plist, LispVal *key, LispVal *pred));
DECLARE_FUNCTION(plist_assoc, (LispVal * plist, LispVal *key, LispVal *pred));
void debug_dump(FILE *stream, void *obj, bool newline);
void debug_print_hashtable(FILE *stream, LispVal *table);
@ -570,7 +620,8 @@ extern LispVal *Qopt;
extern LispVal *Qkey;
extern LispVal *Qallow_other_keys;
extern LispVal *Qrest;
extern LispVal *Qreturn_signal;
extern LispVal *Qdeclare;
extern LispVal *Qname;
// some internal functions
LispVal *puthash(LispVal *table, LispVal *key, LispVal *value);