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))) (t (print obj)))
(when newline (when newline
(println))) (println)))
(breakpoint)
'

786
src/lisp.c
View File

File diff suppressed because it is too large Load Diff

74
src/lisp.h
View File

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

12
src/main.c
View File

@ -3,8 +3,8 @@
static int exit_status = 0; static int exit_status = 0;
STATIC_DEFUN(toplevel_exit_handler, "toplevel-exit-handler", STATIC_DEFUN(toplevel_exit_handler, "toplevel-exit-handler", (LispVal * except),
(LispVal * except)) { "(except)", "Internal function.") {
LispVal *detail = TAIL(HEAD(except)); LispVal *detail = TAIL(HEAD(except));
if (NILP(detail) || NILP(HEAD(detail))) { if (NILP(detail) || NILP(HEAD(detail))) {
exit_status = 0; exit_status = 0;
@ -17,7 +17,7 @@ STATIC_DEFUN(toplevel_exit_handler, "toplevel-exit-handler",
} }
STATIC_DEFUN(toplevel_error_handler, "toplevel-error-handler", STATIC_DEFUN(toplevel_error_handler, "toplevel-error-handler",
(LispVal * except)) { (LispVal * except), "(except)", "Internal function.") {
LispVal *type = HEAD(HEAD(except)); LispVal *type = HEAD(HEAD(except));
LispVal *detail = TAIL(HEAD(except)); LispVal *detail = TAIL(HEAD(except));
LispVal *backtrace = HEAD(TAIL(except)); LispVal *backtrace = HEAD(TAIL(except));
@ -56,8 +56,8 @@ int main(int argc, const char **argv) {
fclose(in); fclose(in);
lisp_init(); lisp_init();
REGISTER_SYMBOL(toplevel_read); REGISTER_SYMBOL(toplevel_read);
REGISTER_STATIC_FUNCTION(toplevel_error_handler, "(e)", ""); REGISTER_STATIC_FUNCTION(toplevel_error_handler);
REGISTER_STATIC_FUNCTION(toplevel_exit_handler, "(e)", ""); REGISTER_STATIC_FUNCTION(toplevel_exit_handler);
size_t pos = 0; size_t pos = 0;
WITH_PUSH_FRAME(Qtoplevel, Qnil, false, { WITH_PUSH_FRAME(Qtoplevel, Qnil, false, {
the_stack->hidden = false; the_stack->hidden = false;
@ -92,7 +92,7 @@ int main(int argc, const char **argv) {
&& list_length(tv) == 2) { && list_length(tv) == 2) {
refcount_unref(Fset_current_package(HEAD(TAIL(tv)))); refcount_unref(Fset_current_package(HEAD(TAIL(tv))));
} else { } 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; 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; LispString *str = (LispString *) source;
CHECK_TYPE(TYPE_STRING, source); CHECK_TYPE(TYPE_STRING, source);
struct ReadState state = { struct ReadState state = {
@ -600,3 +601,7 @@ DEFUN(read, "read", (LispVal * source, LispVal *package)) {
return res; 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)); DECLARE_FUNCTION(read, (LispVal * source, LispVal *package));
void register_reader_functions(void);
#endif #endif