Work on function stuff
This commit is contained in:
230
src/lisp.h
230
src/lisp.h
@ -17,6 +17,9 @@
|
||||
# define PRINTF_FORMAT(first, second)
|
||||
#endif
|
||||
|
||||
// ####################
|
||||
// # Basic Structures #
|
||||
// ####################
|
||||
typedef enum {
|
||||
TYPE_STRING,
|
||||
TYPE_SYMBOL,
|
||||
@ -34,7 +37,6 @@ struct _TypeNameEntry {
|
||||
size_t len;
|
||||
};
|
||||
extern struct _TypeNameEntry LISP_TYPE_NAMES[N_LISP_TYPES];
|
||||
#define OBJ_TYPE_NAME(obj) (LISP_TYPE_NAMES[LISPVAL(obj)->type].name)
|
||||
|
||||
#define LISP_OBJECT_HEADER \
|
||||
LispType type; \
|
||||
@ -43,9 +45,6 @@ extern struct _TypeNameEntry LISP_TYPE_NAMES[N_LISP_TYPES];
|
||||
typedef struct {
|
||||
LISP_OBJECT_HEADER;
|
||||
} LispVal;
|
||||
#define LISPVAL(obj) ((LispVal *) (obj))
|
||||
#define STATICP(v) (LISPVAL(v)->ref_count < 0)
|
||||
#define TYPEOF(v) (LISPVAL(v)->type)
|
||||
|
||||
typedef struct {
|
||||
LISP_OBJECT_HEADER;
|
||||
@ -101,8 +100,8 @@ typedef struct {
|
||||
|
||||
size_t n_req;
|
||||
size_t n_opt;
|
||||
size_t n_kw;
|
||||
LispVal **kwargs;
|
||||
LispVal *kwargs; // hash table
|
||||
bool allow_other_keys;
|
||||
bool has_rest;
|
||||
union {
|
||||
void *builtin;
|
||||
@ -134,6 +133,30 @@ typedef struct {
|
||||
LispVal *hash_fn;
|
||||
} LispHashtable;
|
||||
|
||||
// #######################
|
||||
// # nil, unbound, and t #
|
||||
// #######################
|
||||
#define LISPVAL(obj) ((LispVal *) (obj))
|
||||
|
||||
extern LispSymbol _Qnil;
|
||||
extern LispSymbol _Qunbound; // don't intern!
|
||||
extern LispSymbol _Qt;
|
||||
|
||||
#define Qnil (LISPVAL(&_Qnil))
|
||||
#define Qunbound (LISPVAL(&_Qunbound))
|
||||
#define Qt (LISPVAL(&_Qt))
|
||||
|
||||
#define LISP_BOOL(v) ((v) ? Qt : Qnil)
|
||||
|
||||
// ###################
|
||||
// # Type predicates #
|
||||
// ###################
|
||||
#define STATICP(v) (LISPVAL(v)->ref_count < 0)
|
||||
#define TYPEOF(v) (LISPVAL(v)->type)
|
||||
|
||||
// only use on symbols!
|
||||
#define VALUE_CONSTANTP(v) (((LispSymbol *) (v))->is_constant)
|
||||
|
||||
#define NILP(v) (((void *) (v)) == (void *) Qnil)
|
||||
#define STRINGP(v) (TYPEOF(v) == TYPE_STRING)
|
||||
#define SYMBOLP(v) (TYPEOF(v) == TYPE_SYMBOL)
|
||||
@ -146,13 +169,10 @@ typedef struct {
|
||||
|
||||
#define ATOM(v) (TYPEOF(v) != TYPE_PAIR)
|
||||
|
||||
extern LispSymbol _Qnil;
|
||||
extern LispSymbol _Qunbound;
|
||||
extern LispSymbol _Qt;
|
||||
|
||||
#define Qnil (LISPVAL(&_Qnil))
|
||||
#define Qunbound (LISPVAL(&_Qunbound))
|
||||
#define Qt (LISPVAL(&_Qt))
|
||||
inline static bool KEYWORDP(LispVal *v) {
|
||||
return SYMBOLP(v) && ((LispSymbol *) v)->name->length
|
||||
&& ((LispSymbol *) v)->name->data[0] == ':';
|
||||
}
|
||||
|
||||
inline static bool LISTP(LispVal *v) {
|
||||
return NILP(v) || PAIRP(v);
|
||||
@ -162,11 +182,9 @@ inline static bool NUMBERP(LispVal *v) {
|
||||
return INTEGERP(v) || FLOATP(v);
|
||||
}
|
||||
|
||||
extern LispVal *Qbackquote;
|
||||
extern LispVal *Qcomma;
|
||||
|
||||
#define LISP_BOOL(v) ((v) ? Qt : Qnil)
|
||||
|
||||
// ##################################
|
||||
// # Macros for static declarations #
|
||||
// ##################################
|
||||
#define DEF_STATIC_STRING(name, value) \
|
||||
static LispString name = { \
|
||||
.type = TYPE_STRING, \
|
||||
@ -187,7 +205,69 @@ extern LispVal *Qcomma;
|
||||
.is_constant = false, \
|
||||
}; \
|
||||
LispVal *Q##c_name = LISPVAL(&_Q##c_name);
|
||||
#define DECLARE_FUNCTION(c_name, args) \
|
||||
LispVal *F##c_name args; \
|
||||
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, \
|
||||
.doc = Qnil, \
|
||||
.args = Qnil, \
|
||||
.kwargs = Qnil, \
|
||||
.lexenv = Qnil, \
|
||||
}; \
|
||||
static LispSymbol _Q##c_name = { \
|
||||
.type = TYPE_SYMBOL, \
|
||||
.ref_count = -1, \
|
||||
.name = &_Q##c_name##_name, \
|
||||
.plist = Qnil, \
|
||||
.value = Qunbound, \
|
||||
.function = LISPVAL(&_Q##c_name##_function), \
|
||||
.is_constant = false, \
|
||||
}; \
|
||||
LispVal *Q##c_name = (LispVal *) &_Q##c_name; \
|
||||
LispVal *F##c_name c_args
|
||||
#define DEFUN(c_name, lisp_name, c_args) \
|
||||
_INTERNAL_DEFUN_EXTENDED(false, c_name, lisp_name, c_args)
|
||||
#define DEFMACRO(c_name, lisp_name, c_args) \
|
||||
_INTERNAL_DEFUN_EXTENDED(true, c_name, lisp_name, c_args)
|
||||
|
||||
// ###############
|
||||
// # Loop macros #
|
||||
// ###############
|
||||
#define HASHTABLE_FOREACH(key_var, val_var, table, body) \
|
||||
{ \
|
||||
LispHashtable *__hashtable_foreach_table = (LispHashtable *) table; \
|
||||
for (size_t __hashtable_foreach_i = 0; \
|
||||
__hashtable_foreach_i < __hashtable_foreach_table->count; \
|
||||
++__hashtable_foreach_i) { \
|
||||
struct HashtableBucket *__hashtable_foreach_cur = \
|
||||
__hashtable_foreach_table->data[__hashtable_foreach_i]; \
|
||||
while (__hashtable_foreach_cur) { \
|
||||
LispVal *key_var = __hashtable_foreach_cur->key; \
|
||||
LispVal *val_var = __hashtable_foreach_cur->value; \
|
||||
{body}; \
|
||||
__hashtable_foreach_cur = __hashtable_foreach_cur->next; \
|
||||
} \
|
||||
} \
|
||||
}
|
||||
#define FOREACH(var, list) \
|
||||
for (LispVal *__foreach_cur = list, *var = Fhead(list); \
|
||||
!NILP(__foreach_cur); \
|
||||
__foreach_cur = Ftail(__foreach_cur), var = Fhead(__foreach_cur))
|
||||
#define FOREACH_TAIL(var, list) \
|
||||
for (LispVal *var = list; !NILP(var); var = Ftail(var))
|
||||
|
||||
// #############################
|
||||
// # Allocation and references #
|
||||
// #############################
|
||||
void *lisp_malloc(size_t size);
|
||||
void *lisp_realloc(void *old_ptr, size_t size);
|
||||
#define lisp_free free
|
||||
@ -227,6 +307,9 @@ inline static void lisp_unref_double_ptr(void **val) {
|
||||
}
|
||||
#define IGNORE_REF(val) (lisp_unref(lisp_ref(val)))
|
||||
|
||||
// ################
|
||||
// # Constructors #
|
||||
// ################
|
||||
LispVal *make_lisp_string(const char *data, size_t length, bool take,
|
||||
bool is_static);
|
||||
#define STATIC_STRING(s) (make_lisp_string((s), sizeof(s) - 1, true, true))
|
||||
@ -236,76 +319,34 @@ LispVal *make_lisp_pair(LispVal *head, LispVal *tail);
|
||||
LispVal *make_lisp_integer(intmax_t value);
|
||||
LispVal *make_lisp_float(long double value);
|
||||
LispVal *make_lisp_vector(LispVal **data, size_t length);
|
||||
// TODO make_lisp_function
|
||||
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_hashtable(LispVal *eq_fn, LispVal *hash_fn);
|
||||
|
||||
#define DECLARE_FUNCTION(c_name, args) \
|
||||
LispVal *F##c_name args; \
|
||||
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, \
|
||||
.lexenv = Qnil, \
|
||||
}; \
|
||||
static LispSymbol _Q##c_name = { \
|
||||
.type = TYPE_SYMBOL, \
|
||||
.ref_count = -1, \
|
||||
.name = &_Q##c_name##_name, \
|
||||
.plist = Qnil, \
|
||||
.value = Qunbound, \
|
||||
.function = LISPVAL(&_Q##c_name##_function), \
|
||||
.is_constant = false, \
|
||||
}; \
|
||||
LispVal *Q##c_name = (LispVal *) &_Q##c_name; \
|
||||
LispVal *F##c_name c_args
|
||||
#define DEFUN(c_name, lisp_name, c_args) \
|
||||
_INTERNAL_DEFUN_EXTENDED(false, c_name, lisp_name, c_args)
|
||||
#define DEFMACRO(c_name, lisp_name, c_args) \
|
||||
_INTERNAL_DEFUN_EXTENDED(true, c_name, lisp_name, c_args)
|
||||
// ########################
|
||||
// # Utility and internal #
|
||||
// ########################
|
||||
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));
|
||||
bool strings_equal_nocase(const char *s1, const char *s2, size_t n);
|
||||
DECLARE_FUNCTION(id, (LispVal * obj));
|
||||
DECLARE_FUNCTION(eq, (LispVal * obj1, LispVal *obj2));
|
||||
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(hash_table_count, (LispVal * table));
|
||||
#define HASHTABLE_FOREACH(key_var, val_var, table, body) \
|
||||
{ \
|
||||
LispHashtable *__hashtable_foreach_table = (LispHashtable *) table; \
|
||||
for (size_t __hashtable_foreach_i = 0; \
|
||||
__hashtable_foreach_i < __hashtable_foreach_table->count; \
|
||||
++__hashtable_foreach_i) { \
|
||||
struct HashtableBucket *__hashtable_foreach_cur = \
|
||||
__hashtable_foreach_table->data[__hashtable_foreach_i]; \
|
||||
while (__hashtable_foreach_cur) { \
|
||||
LispVal *key_var = __hashtable_foreach_cur->key; \
|
||||
LispVal *val_var = __hashtable_foreach_cur->value; \
|
||||
{body}; \
|
||||
__hashtable_foreach_cur = __hashtable_foreach_cur->next; \
|
||||
} \
|
||||
} \
|
||||
}
|
||||
DECLARE_FUNCTION(intern, (LispVal * name));
|
||||
LispVal *intern(const char *name, size_t length, bool take);
|
||||
DECLARE_FUNCTION(intern, (LispVal * name));
|
||||
#define INTERN_STATIC(name) (Fintern(STATIC_STRING(name)))
|
||||
|
||||
DECLARE_FUNCTION(sethead, (LispVal * pair, LispVal *head));
|
||||
DECLARE_FUNCTION(settail, (LispVal * pair, LispVal *tail));
|
||||
size_t list_length(LispVal *obj);
|
||||
static inline LispVal *make_list(int len, ...) {
|
||||
static inline LispVal *const_list(int len, ...) {
|
||||
LispVal *list = Qnil;
|
||||
LispVal *end;
|
||||
va_list args;
|
||||
@ -324,11 +365,21 @@ static inline LispVal *make_list(int len, ...) {
|
||||
va_end(args);
|
||||
return list;
|
||||
}
|
||||
#define FOREACH(var, list) \
|
||||
for (LispVal *__foreach_cur = list, *var = Fhead(list); \
|
||||
!NILP(__foreach_cur); \
|
||||
__foreach_cur = Ftail(__foreach_cur), var = Fhead(__foreach_cur))
|
||||
|
||||
static inline LispVal *make_list(size_t len, LispVal **vals) {
|
||||
LispVal *list = Qnil;
|
||||
LispVal *end;
|
||||
for (size_t i = 0; i < len; ++i) {
|
||||
if (NILP(list)) {
|
||||
list = Fpair(vals[i], Qnil);
|
||||
end = list;
|
||||
} else {
|
||||
LispVal *new_end = Fpair(vals[i], Qnil);
|
||||
Fsettail(end, new_end);
|
||||
end = new_end;
|
||||
}
|
||||
}
|
||||
return list;
|
||||
}
|
||||
typedef void (*lisp_cleanup_func_t)(void *);
|
||||
struct CleanupHandlerEntry {
|
||||
struct CleanupHandlerEntry *next;
|
||||
@ -356,6 +407,12 @@ extern LispVal *Qparent_lexenv;
|
||||
void stack_enter(LispVal *name, LispVal *detail, bool inherit);
|
||||
void stack_leave(void);
|
||||
void *register_cleanup(lisp_cleanup_func_t fun, void *data);
|
||||
void free_double_ptr(void *ptr);
|
||||
struct UnrefListData {
|
||||
LispVal **vals;
|
||||
size_t len;
|
||||
};
|
||||
void unref_free_list_double_ptr(void *ptr);
|
||||
void cancel_cleanup(void *handle);
|
||||
#define WITH_PUSH_FRAME(name, detail, inherit, body) \
|
||||
stack_enter(name, detail, inherit); \
|
||||
@ -383,6 +440,8 @@ extern LispVal *Qeof_error;
|
||||
extern LispVal *Qvoid_variable_error;
|
||||
extern LispVal *Qvoid_function_error;
|
||||
extern LispVal *Qcircular_error;
|
||||
extern LispVal *Qmalformed_lambda_list_error;
|
||||
extern LispVal *Qargument_error;
|
||||
|
||||
#define CHECK_TYPE(type, val) \
|
||||
if (TYPEOF(val) != type) { \
|
||||
@ -391,9 +450,26 @@ extern LispVal *Qcircular_error;
|
||||
|
||||
extern LispVal *Vobarray;
|
||||
|
||||
#define REGISTER_SYMBOL(sym) \
|
||||
Fputhash(Vobarray, LISPVAL(((LispSymbol *) Q##sym)->name), Q##sym)
|
||||
#define REGISTER_STATIC_FUNCTION(obj, args, docstr) \
|
||||
((LispFunction *) (obj))->doc = STATIC_STRING(docstr); \
|
||||
{ \
|
||||
LispVal *src = STATIC_STRING(args); \
|
||||
lisp_ref(src); \
|
||||
set_function_args((LispFunction *) (obj), Fread(src)); \
|
||||
lisp_unref(src); \
|
||||
}
|
||||
#define REGISTER_FUNCTION(fn, args, docstr) \
|
||||
REGISTER_SYMBOL(fn); \
|
||||
REGISTER_STATIC_FUNCTION(((LispSymbol *) Q##fn)->function, args, docstr);
|
||||
|
||||
void lisp_init(void);
|
||||
void lisp_shutdown(void);
|
||||
void register_static_function(LispVal *func);
|
||||
|
||||
extern LispVal *Qbackquote;
|
||||
extern LispVal *Qcomma;
|
||||
DECLARE_FUNCTION(quote, (LispVal * form));
|
||||
|
||||
DECLARE_FUNCTION(symbol_function, (LispVal * symbol, LispVal *resolve));
|
||||
@ -412,8 +488,14 @@ 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(progn, (LispVal * forms));
|
||||
DECLARE_FUNCTION(fset, (LispVal * sym, LispVal *new_func));
|
||||
|
||||
void debug_dump(FILE *stream, void *obj, bool newline);
|
||||
void debug_print_hashtable(FILE *stream, LispVal *table);
|
||||
extern LispVal *Qopt;
|
||||
extern LispVal *Qkey;
|
||||
extern LispVal *Qallow_other_keys;
|
||||
extern LispVal *Qrest;
|
||||
|
||||
#endif
|
||||
|
||||
Reference in New Issue
Block a user