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

Refactor function definitions

Browse Source
This commit is contained in:
Alexander Rosenberg
2025-10-03 13:55:30 -07:00
parent 5ad4e054e0
commit 6e58ad5e3e
6 changed files with 560 additions and 324 deletions
Download Patch File Download Diff File Expand all files Collapse all files

3
src/kernel.sl
View File

@ -444,6 +444,3 @@
(t (print obj)))
(when newline
(println)))
(breakpoint)
'

784
src/lisp.c
View File

File diff suppressed because it is too large Load Diff

58
src/lisp.h
View File

@ -161,6 +161,16 @@ typedef struct {
LispVal *imported; // list of (package . (str -> bool))
} LispPackage;
typedef struct {
LISP_OBJECT_HEADER;
LispVal *class;
} LispObject;
typedef struct {
LispObject as_obj;
} LispClass;
// #######################
// # nil, unbound, and t #
// #######################
@ -258,7 +268,9 @@ inline static bool NUMBERP(LispVal *v) {
extern LispVal *Q##c_name
// The args and doc fields are filled when the function is registered
#define _INTERNAL_DEFUN_EXTENDED(macrop, du, c_name, lisp_name, c_args, \
static_kw) \
static_kw, lisp_args, doc_cstr) \
static const char _F##c_name##lisp_args_cstr[] = lisp_args; \
static const char _F##c_name##doccstr[] = doc_cstr; \
static_kw LispVal *F##c_name c_args; \
DEF_STATIC_STRING(_Q##c_name##_fnnamestr, lisp_name); \
static LispSymbol _Q##c_name; \
@ -288,16 +300,21 @@ inline static bool NUMBERP(LispVal *v) {
}; \
LispVal *Q##c_name = (LispVal *) &_Q##c_name; \
static_kw LispVal *F##c_name c_args
#define DEFUN(c_name, lisp_name, c_args) \
_INTERNAL_DEFUN_EXTENDED(false, false, c_name, lisp_name, c_args, )
#define DEFUN_DISTINGUISHED(c_name, lisp_name, c_args) \
_INTERNAL_DEFUN_EXTENDED(false, true, c_name, lisp_name, c_args, )
#define DEFMACRO(c_name, lisp_name, c_args) \
_INTERNAL_DEFUN_EXTENDED(true, false, c_name, lisp_name, c_args, )
#define STATIC_DEFUN(c_name, lisp_name, c_args) \
_INTERNAL_DEFUN_EXTENDED(false, false, c_name, lisp_name, c_args, static)
#define STATIC_DEFMACRO(c_name, lisp_name, c_args) \
_INTERNAL_DEFUN_EXTENDED(true, false, c_name, lisp_name, c_args, static)
#define DEFUN(c_name, lisp_name, c_args, lisp_args, doc_cstr) \
_INTERNAL_DEFUN_EXTENDED(false, false, c_name, lisp_name, c_args, , \
lisp_args, doc_cstr)
#define DEFUN_DISTINGUISHED(c_name, lisp_name, c_args, lisp_args, doc_cstr) \
_INTERNAL_DEFUN_EXTENDED(false, true, c_name, lisp_name, c_args, , \
lisp_args, doc_cstr)
#define DEFMACRO(c_name, lisp_name, c_args, lisp_args, doc_cstr) \
_INTERNAL_DEFUN_EXTENDED(true, false, c_name, lisp_name, c_args, , \
lisp_args, doc_cstr)
#define STATIC_DEFUN(c_name, lisp_name, c_args, lisp_args, doc_cstr) \
_INTERNAL_DEFUN_EXTENDED(false, false, c_name, lisp_name, c_args, static, \
lisp_args, doc_cstr)
#define STATIC_DEFMACRO(c_name, lisp_name, c_args, lisp_args, doc_cstr) \
_INTERNAL_DEFUN_EXTENDED(true, false, c_name, lisp_name, c_args, static, \
lisp_args, doc_cstr)
// registration
#define REGISTER_SYMBOL_NOINTERN(sym) \
@ -313,20 +330,20 @@ inline static bool NUMBERP(LispVal *v) {
REGISTER_SYMBOL_NOINTERN(sym) \
REGISTER_DO_INTERN(sym, pkg)
#define REGISTER_SYMBOL(sym) REGISTER_SYMBOL_INTO(sym, system_package)
#define REGISTER_STATIC_FUNCTION(name, args, docstr) \
#define REGISTER_STATIC_FUNCTION(name) \
REGISTER_SYMBOL_NOINTERN(name); \
{ \
LispVal *obj = ((LispSymbol *) Q##name)->function; \
refcount_init_static(obj); \
((LispFunction *) (obj))->doc = STATIC_STRING(docstr); \
LispVal *src = STATIC_STRING(args); \
((LispFunction *) (obj))->doc = STATIC_STRING(_F##name##doccstr); \
LispVal *src = STATIC_STRING(_F##name##lisp_args_cstr); \
LispVal *a = Fread(src, system_package); \
set_function_args((LispFunction *) (obj), a); \
refcount_unref(src); \
refcount_unref(a); \
}
#define REGISTER_FUNCTION(fn, args, docstr) \
REGISTER_STATIC_FUNCTION(fn, args, docstr); \
#define REGISTER_FUNCTION(fn) \
REGISTER_STATIC_FUNCTION(fn); \
((LispSymbol *) Q##fn)->package = refcount_ref(system_package); \
puthash(((LispPackage *) system_package)->obarray, \
LISPVAL(((LispSymbol *) Q##fn)->name), Q##fn);
@ -400,8 +417,7 @@ DECLARE_FUNCTION(user_pointer_p, (LispVal * val));
// ##################################
// # Evaluation and Macro Expansion #
// ##################################
DECLARE_FUNCTION(eval_in_env, (LispVal * form, LispVal *lexenv));
DECLARE_FUNCTION(eval, (LispVal * form));
DECLARE_FUNCTION(eval, (LispVal * form, LispVal *lexenv));
DECLARE_FUNCTION(funcall, (LispVal * function, LispVal *rest));
DECLARE_FUNCTION(apply, (LispVal * function, LispVal *rest));
DECLARE_FUNCTION(macroexpand_1, (LispVal * form, LispVal *lexical_macros));
@ -507,7 +523,7 @@ DECLARE_FUNCTION(quote_symbol_name, (LispVal * name));
DECLARE_FUNCTION(symbol_accessible_p, (LispVal * symbol, LispVal *package));
extern LispVal *Qkw_as_needed;
DECLARE_FUNCTION(quote_symbol_for_read,
(LispVal * target, LispVal *include_package));
(LispVal * target, LispVal *include_package, LispVal *from));
LispVal *intern(const char *name, size_t length, bool take, LispVal *package,
bool included_too);
@ -521,7 +537,7 @@ DECLARE_FUNCTION(hash_table_count, (LispVal * table));
DECLARE_FUNCTION(maphash, (LispVal * func, LispVal *table));
DECLARE_FUNCTION(puthash, (LispVal * table, LispVal *key, LispVal *value));
DECLARE_FUNCTION(gethash, (LispVal * table, LispVal *key, LispVal *def));
DECLARE_FUNCTION(remhash, (LispVal * table, LispVal *key));
DECLARE_FUNCTION(remhash, (LispVal * table, LispVal *key, LispVal *def));
struct HashtableDataArray {
size_t size;
struct HashtableEntry *entries;
@ -531,7 +547,7 @@ void free_hash_table_data_array(void *data);
// Don't ref their return value
LispVal *puthash(LispVal *table, LispVal *key, LispVal *value);
LispVal *gethash(LispVal *table, LispVal *key, LispVal *def);
LispVal *remhash(LispVal *table, LispVal *key);
void remhash(LispVal *table, LispVal *key);
// #####################
// # Numeric Functions #

12
src/main.c
View File

@ -3,8 +3,8 @@
static int exit_status = 0;
STATIC_DEFUN(toplevel_exit_handler, "toplevel-exit-handler",
(LispVal * except)) {
STATIC_DEFUN(toplevel_exit_handler, "toplevel-exit-handler", (LispVal * except),
"(except)", "Internal function.") {
LispVal *detail = TAIL(HEAD(except));
if (NILP(detail) || NILP(HEAD(detail))) {
exit_status = 0;
@ -17,7 +17,7 @@ STATIC_DEFUN(toplevel_exit_handler, "toplevel-exit-handler",
}
STATIC_DEFUN(toplevel_error_handler, "toplevel-error-handler",
(LispVal * except)) {
(LispVal * except), "(except)", "Internal function.") {
LispVal *type = HEAD(HEAD(except));
LispVal *detail = TAIL(HEAD(except));
LispVal *backtrace = HEAD(TAIL(except));
@ -56,8 +56,8 @@ int main(int argc, const char **argv) {
fclose(in);
lisp_init();
REGISTER_SYMBOL(toplevel_read);
REGISTER_STATIC_FUNCTION(toplevel_error_handler, "(e)", "");
REGISTER_STATIC_FUNCTION(toplevel_exit_handler, "(e)", "");
REGISTER_STATIC_FUNCTION(toplevel_error_handler);
REGISTER_STATIC_FUNCTION(toplevel_exit_handler);
size_t pos = 0;
WITH_PUSH_FRAME(Qtoplevel, Qnil, false, {
the_stack->hidden = false;
@ -92,7 +92,7 @@ int main(int argc, const char **argv) {
&& list_length(tv) == 2) {
refcount_unref(Fset_current_package(HEAD(TAIL(tv))));
} else {
refcount_unref(Feval(tv)); //
refcount_unref(Feval(tv, the_stack->lexenv)); //
}
});
}

7
src/read.c
View File

@ -575,7 +575,8 @@ size_t read_from_buffer(const char *text, size_t length, LispVal *package,
return state.off;
}
DEFUN(read, "read", (LispVal * source, LispVal *package)) {
DEFUN(read, "read", (LispVal * source, LispVal *package), "(source package)",
"Read a single form from SOURCE.") {
LispString *str = (LispString *) source;
CHECK_TYPE(TYPE_STRING, source);
struct ReadState state = {
@ -600,3 +601,7 @@ DEFUN(read, "read", (LispVal * source, LispVal *package)) {
return res;
}
}
void register_reader_functions(void) {
REGISTER_FUNCTION(read);
}

2
src/read.h
View File

@ -13,4 +13,6 @@ size_t read_from_buffer(const char *text, size_t length, LispVal *package,
DECLARE_FUNCTION(read, (LispVal * source, LispVal *package));
void register_reader_functions(void);
#endif