Allow default values for optional argumnts

This commit is contained in:
2025-07-04 02:18:40 +09:00
parent 625b8238e6
commit 2d4b963199
3 changed files with 236 additions and 65 deletions

View File

@ -29,6 +29,7 @@ typedef enum {
TYPE_VECTOR,
TYPE_FUNCTION,
TYPE_HASHTABLE,
TYPE_USER_POINTER,
N_LISP_TYPES,
} LispType;
@ -90,6 +91,15 @@ typedef struct {
size_t length;
} LispVector;
struct OptArgDesc {
size_t index; // only for keywords
LispVal *name;
LispVal *default_form;
LispVal *pred_var;
};
void free_opt_arg_desc(void *obj);
typedef struct {
LISP_OBJECT_HEADER;
@ -135,6 +145,14 @@ typedef struct {
LispVal *hash_fn;
} LispHashtable;
typedef struct {
LISP_OBJECT_HEADER;
void *data;
void (*free_func)(void *);
} LispUserPointer;
#define USERPTR(type, obj) ((type *) ((LispUserPointer *) (obj))->data)
// #######################
// # nil, unbound, and t #
// #######################
@ -159,15 +177,16 @@ extern LispSymbol _Qt;
// 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)
#define PAIRP(v) (TYPEOF(v) == TYPE_PAIR)
#define INTEGERP(v) (TYPEOF(v) == TYPE_INTEGER)
#define FLOATP(v) (TYPEOF(v) == TYPE_FLOAT)
#define VECTORP(v) (TYPEOF(v) == TYPE_VECTOR)
#define FUNCTIONP(v) (TYPEOF(v) == TYPE_FUNCTION)
#define HASHTABLEP(v) (TYPEOF(v) == TYPE_HASHTABLE)
#define NILP(v) (((void *) (v)) == (void *) Qnil)
#define STRINGP(v) (TYPEOF(v) == TYPE_STRING)
#define SYMBOLP(v) (TYPEOF(v) == TYPE_SYMBOL)
#define PAIRP(v) (TYPEOF(v) == TYPE_PAIR)
#define INTEGERP(v) (TYPEOF(v) == TYPE_INTEGER)
#define FLOATP(v) (TYPEOF(v) == TYPE_FLOAT)
#define VECTORP(v) (TYPEOF(v) == TYPE_VECTOR)
#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 ATOM(v) (TYPEOF(v) != TYPE_PAIR)
@ -328,6 +347,9 @@ 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);
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))
// ########################
// # Utility and internal #
@ -346,7 +368,13 @@ 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));
#define INTERN_STATIC(name) (Fintern(STATIC_STRING(name)))
static inline LispVal *_internal_INTERN_STATIC(const char *name, size_t len) {
LispVal *kn = lisp_ref(make_lisp_string(name, len, true, true));
LispVal *retval = Fintern(kn);
lisp_unref(kn);
return retval;
}
#define INTERN_STATIC(name) (_internal_INTERN_STATIC((name), sizeof(name) - 1))
DECLARE_FUNCTION(sethead, (LispVal * pair, LispVal *head));
DECLARE_FUNCTION(settail, (LispVal * pair, LispVal *tail));