Work on packages
This commit is contained in:
187
src/lisp.h
187
src/lisp.h
@ -31,6 +31,7 @@ typedef enum {
|
||||
TYPE_FUNCTION,
|
||||
TYPE_HASHTABLE,
|
||||
TYPE_USER_POINTER,
|
||||
TYPE_PACKAGE,
|
||||
N_LISP_TYPES,
|
||||
} LispType;
|
||||
|
||||
@ -60,6 +61,7 @@ typedef struct {
|
||||
LISP_OBJECT_HEADER;
|
||||
|
||||
LispString *name;
|
||||
LispVal *package;
|
||||
LispVal *plist;
|
||||
LispVal *function;
|
||||
LispVal *value;
|
||||
@ -122,7 +124,10 @@ typedef struct {
|
||||
bool allow_other_keys;
|
||||
LispVal *rest_arg;
|
||||
union {
|
||||
lisp_function_ptr_t builtin;
|
||||
struct {
|
||||
lisp_function_ptr_t builtin;
|
||||
bool distinguish_unpassed;
|
||||
};
|
||||
LispVal *body;
|
||||
};
|
||||
|
||||
@ -159,6 +164,14 @@ typedef struct {
|
||||
} LispUserPointer;
|
||||
#define USERPTR(type, obj) ((type *) ((LispUserPointer *) (obj))->data)
|
||||
|
||||
typedef struct {
|
||||
LISP_OBJECT_HEADER;
|
||||
LispString *name;
|
||||
LispVal *obarray; // str -> sym
|
||||
LispVal *exported_sym_table; // sym -> bool
|
||||
LispVal *imported; // list of (package . (str -> bool))
|
||||
} LispPackage;
|
||||
|
||||
// #######################
|
||||
// # nil, unbound, and t #
|
||||
// #######################
|
||||
@ -193,12 +206,17 @@ extern LispSymbol _Qt;
|
||||
#define FUNCTIONP(v) (TYPEOF(v) == TYPE_FUNCTION)
|
||||
#define HASHTABLEP(v) (TYPEOF(v) == TYPE_HASHTABLE)
|
||||
#define USER_POINTER_P(v) (TYPEOF(v) == TYPE_USER_POINTER)
|
||||
#define PACKAGEP(v) (TYPEOF(v) == TYPE_PACKAGE)
|
||||
|
||||
#define ATOM(v) (TYPEOF(v) != TYPE_PAIR)
|
||||
|
||||
extern LispVal *package_table;
|
||||
extern LispVal *system_package;
|
||||
extern LispVal *keyword_package;
|
||||
extern LispVal *current_package;
|
||||
|
||||
inline static bool KEYWORDP(LispVal *v) {
|
||||
return SYMBOLP(v) && ((LispSymbol *) v)->name->length
|
||||
&& ((LispSymbol *) v)->name->data[0] == ':';
|
||||
return SYMBOLP(v) && ((LispSymbol *) v)->package == keyword_package;
|
||||
}
|
||||
|
||||
inline static bool LISTP(LispVal *v) {
|
||||
@ -224,8 +242,9 @@ inline static bool NUMBERP(LispVal *v) {
|
||||
static LispSymbol _Q##c_name = { \
|
||||
.type = TYPE_SYMBOL, \
|
||||
.name = &_Q##c_name##_symnamestr, \
|
||||
.package = Qnil, \
|
||||
.plist = Qnil, \
|
||||
.function = Qunbound, \
|
||||
.function = Qnil, \
|
||||
.value = Qunbound, \
|
||||
.is_constant = false, \
|
||||
}; \
|
||||
@ -234,62 +253,67 @@ inline static bool NUMBERP(LispVal *v) {
|
||||
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, static_kw) \
|
||||
static_kw LispVal *F##c_name c_args; \
|
||||
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, \
|
||||
.oargs = Qnil, \
|
||||
.rest_arg = Qnil, \
|
||||
.kwargs = Qnil, \
|
||||
.lexenv = Qnil, \
|
||||
}; \
|
||||
static LispSymbol _Q##c_name = { \
|
||||
.type = TYPE_SYMBOL, \
|
||||
.name = &_Q##c_name##_fnnamestr, \
|
||||
.plist = Qnil, \
|
||||
.value = Qunbound, \
|
||||
.function = LISPVAL(&_Q##c_name##_function), \
|
||||
.is_constant = false, \
|
||||
}; \
|
||||
LispVal *Q##c_name = (LispVal *) &_Q##c_name; \
|
||||
#define _INTERNAL_DEFUN_EXTENDED(macrop, du, c_name, lisp_name, c_args, \
|
||||
static_kw) \
|
||||
static_kw LispVal *F##c_name c_args; \
|
||||
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, \
|
||||
.distinguish_unpassed = du, \
|
||||
.name = LISPVAL(&_Q##c_name), \
|
||||
.doc = Qnil, \
|
||||
.args = Qnil, \
|
||||
.rargs = Qnil, \
|
||||
.oargs = Qnil, \
|
||||
.rest_arg = Qnil, \
|
||||
.kwargs = Qnil, \
|
||||
.lexenv = Qnil, \
|
||||
}; \
|
||||
static LispSymbol _Q##c_name = { \
|
||||
.type = TYPE_SYMBOL, \
|
||||
.name = &_Q##c_name##_fnnamestr, \
|
||||
.package = Qnil, \
|
||||
.plist = Qnil, \
|
||||
.value = Qunbound, \
|
||||
.function = LISPVAL(&_Q##c_name##_function), \
|
||||
.is_constant = false, \
|
||||
}; \
|
||||
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, 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, 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, c_name, lisp_name, c_args, static)
|
||||
_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, c_name, lisp_name, c_args, static)
|
||||
_INTERNAL_DEFUN_EXTENDED(true, false, c_name, lisp_name, c_args, static)
|
||||
|
||||
// ###############
|
||||
// # 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->table_size; \
|
||||
++__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 HASHTABLE_FOREACH(key_var, val_var, table) \
|
||||
for (struct { \
|
||||
LispHashtable *ht; \
|
||||
size_t i; \
|
||||
} __l = {.ht = (void *) table, .i = 0}; \
|
||||
__l.i < __l.ht->table_size; ++__l.i) \
|
||||
for (LispVal *__b = (void *) __l.ht->data[__l.i], \
|
||||
*key_var = __b ? ((struct HashtableBucket *) __b)->key \
|
||||
: NULL, \
|
||||
*val_var = __b ? ((struct HashtableBucket *) __b)->value \
|
||||
: NULL; \
|
||||
__b; __b = (void *) ((struct HashtableBucket *) __b)->next, \
|
||||
key_var = __b ? ((struct HashtableBucket *) __b)->key \
|
||||
: NULL, \
|
||||
val_var = __b ? ((struct HashtableBucket *) __b)->value \
|
||||
: NULL)
|
||||
#define FOREACH(var, list) \
|
||||
for (LispVal *__foreach_cur = list, *var = HEAD(list); \
|
||||
!NILP(__foreach_cur); \
|
||||
@ -327,6 +351,7 @@ 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) \
|
||||
(make_user_pointer(lisp_malloc(sizeof(type)), &free_func))
|
||||
LispVal *make_lisp_package(LispVal *name);
|
||||
|
||||
// ########################
|
||||
// # Utility and internal #
|
||||
@ -343,15 +368,35 @@ 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));
|
||||
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) {
|
||||
DECLARE_FUNCTION(in_package, (LispVal * package));
|
||||
DECLARE_FUNCTION(package_name, (LispVal * package));
|
||||
DECLARE_FUNCTION(mapsymbols, (LispVal * func, LispVal *package));
|
||||
DECLARE_FUNCTION(set_current_package, (LispVal * package));
|
||||
DECLARE_FUNCTION(current_package, (void) );
|
||||
DECLARE_FUNCTION(export_symbol, (LispVal * symbol));
|
||||
DECLARE_FUNCTION(import_package,
|
||||
(LispVal * source, LispVal *names, LispVal *target));
|
||||
DECLARE_FUNCTION(make_package, (LispVal * name));
|
||||
DECLARE_FUNCTION(register_package, (LispVal * package));
|
||||
DECLARE_FUNCTION(find_package, (LispVal * name));
|
||||
DECLARE_FUNCTION(exported_symbol_p, (LispVal * symbol));
|
||||
DECLARE_FUNCTION(intern_soft, (LispVal * name, LispVal *def, LispVal *package,
|
||||
LispVal *included_too));
|
||||
LispVal *find_package(const char *name, size_t length);
|
||||
#define FIND_PACKAGE_STATIC(name) (find_package(name, sizeof(name)))
|
||||
LispVal *intern(const char *name, size_t length, bool take, LispVal *package,
|
||||
bool included_too);
|
||||
DECLARE_FUNCTION(intern,
|
||||
(LispVal * name, LispVal *package, LispVal *included_too));
|
||||
static inline LispVal *_internal_INTERN_STATIC(const char *name, size_t len,
|
||||
LispVal *package) {
|
||||
LispVal *kn = make_lisp_string(name, len, true, true);
|
||||
LispVal *retval = Fintern(kn);
|
||||
LispVal *retval = Fintern(kn, package, Qnil);
|
||||
refcount_unref(kn);
|
||||
return retval;
|
||||
}
|
||||
#define INTERN_STATIC(name) (_internal_INTERN_STATIC((name), sizeof(name) - 1))
|
||||
#define INTERN_STATIC(name, package) \
|
||||
(_internal_INTERN_STATIC((name), sizeof(name) - 1, package))
|
||||
|
||||
DECLARE_FUNCTION(sethead, (LispVal * pair, LispVal *head));
|
||||
DECLARE_FUNCTION(settail, (LispVal * pair, LispVal *tail));
|
||||
@ -504,8 +549,8 @@ 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 *Qkw_success;
|
||||
extern LispVal *Qkw_finally;
|
||||
extern LispVal *Qshutdown_signal;
|
||||
extern LispVal *Qtype_error;
|
||||
extern LispVal *Qread_error;
|
||||
@ -519,6 +564,9 @@ extern LispVal *Qargument_error;
|
||||
extern LispVal *Qinvalid_function_error;
|
||||
extern LispVal *Qno_applicable_method_error;
|
||||
extern LispVal *Qreturn_frame_error;
|
||||
extern LispVal *Qpackage_exists_error;
|
||||
extern LispVal *Qunknown_package_error;
|
||||
extern LispVal *Qimport_error;
|
||||
|
||||
LispVal *predicate_for_type(LispType type);
|
||||
#define CHECK_TYPE(type, val) \
|
||||
@ -530,16 +578,17 @@ LispVal *predicate_for_type(LispType type);
|
||||
Fthrow(Qtype_error, args); \
|
||||
}
|
||||
|
||||
extern LispVal *Vobarray;
|
||||
|
||||
#define REGISTER_SYMBOL_NOINTERN(sym) \
|
||||
{ \
|
||||
refcount_init_static(Q##sym); \
|
||||
refcount_init_static(((LispSymbol *) Q##sym)->name); \
|
||||
}
|
||||
#define REGISTER_SYMBOL(sym) \
|
||||
REGISTER_SYMBOL_NOINTERN(sym) \
|
||||
puthash(Vobarray, LISPVAL(((LispSymbol *) Q##sym)->name), Q##sym);
|
||||
#define REGISTER_SYMBOL_INTO(sym, pkg) \
|
||||
REGISTER_SYMBOL_NOINTERN(sym) \
|
||||
((LispSymbol *) Q##sym)->package = refcount_ref(pkg); \
|
||||
puthash(((LispPackage *) pkg)->obarray, \
|
||||
LISPVAL(((LispSymbol *) Q##sym)->name), Q##sym);
|
||||
#define REGISTER_SYMBOL(sym) REGISTER_SYMBOL_INTO(sym, system_package)
|
||||
#define REGISTER_STATIC_FUNCTION(name, args, docstr) \
|
||||
REGISTER_SYMBOL_NOINTERN(name); \
|
||||
{ \
|
||||
@ -547,14 +596,16 @@ extern LispVal *Vobarray;
|
||||
refcount_init_static(obj); \
|
||||
((LispFunction *) (obj))->doc = STATIC_STRING(docstr); \
|
||||
LispVal *src = STATIC_STRING(args); \
|
||||
LispVal *a = Fread(src); \
|
||||
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); \
|
||||
puthash(Vobarray, LISPVAL(((LispSymbol *) Q##fn)->name), Q##fn);
|
||||
#define REGISTER_FUNCTION(fn, args, docstr) \
|
||||
REGISTER_STATIC_FUNCTION(fn, args, docstr); \
|
||||
((LispSymbol *) Q##fn)->package = refcount_ref(system_package); \
|
||||
puthash(((LispPackage *) system_package)->obarray, \
|
||||
LISPVAL(((LispSymbol *) Q##fn)->name), Q##fn);
|
||||
|
||||
void lisp_init(void);
|
||||
void lisp_shutdown(void);
|
||||
@ -566,6 +617,7 @@ extern LispVal *Qcomma_at;
|
||||
DECLARE_FUNCTION(quote, (LispVal * form));
|
||||
|
||||
DECLARE_FUNCTION(breakpoint, (LispVal * id));
|
||||
DECLARE_FUNCTION(symbol_package, (LispVal * symbol));
|
||||
DECLARE_FUNCTION(symbol_name, (LispVal * symbol));
|
||||
DECLARE_FUNCTION(symbol_function, (LispVal * symbol, LispVal *resolve));
|
||||
DECLARE_FUNCTION(symbol_value, (LispVal * symbol));
|
||||
@ -605,6 +657,7 @@ DECLARE_FUNCTION(pairp, (LispVal * val));
|
||||
DECLARE_FUNCTION(integerp, (LispVal * val));
|
||||
DECLARE_FUNCTION(floatp, (LispVal * val));
|
||||
DECLARE_FUNCTION(vectorp, (LispVal * val));
|
||||
DECLARE_FUNCTION(packagep, (LispVal * val));
|
||||
DECLARE_FUNCTION(functionp, (LispVal * val));
|
||||
DECLARE_FUNCTION(macrop, (LispVal * val, LispVal *lexical_macros));
|
||||
DECLARE_FUNCTION(builtinp, (LispVal * val));
|
||||
|
||||
Reference in New Issue
Block a user