Zander671/glisp
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Clean some stuff up

Browse Source
This commit is contained in:
Alexander Rosenberg
2026-01-29 21:42:47 -08:00
parent e5def8a0ad
commit a76e6a335d
3 changed files with 28 additions and 31 deletions
Download Patch File Download Diff File Expand all files Collapse all files

2
src/base.h
View File

@ -271,7 +271,7 @@ DEFOBJTYPE(Vector, VECTOR, VECTORP, {
REGISTER_GLOBAL_SYMBOL(cname); \ REGISTER_GLOBAL_SYMBOL(cname); \
((LispSymbol *) Q##cname)->function = BUILTIN_FUNCTION_OBJ(cname); \ ((LispSymbol *) Q##cname)->function = BUILTIN_FUNCTION_OBJ(cname); \
((LispFunction *) ((LispSymbol *) Q##cname)->function) \ ((LispFunction *) ((LispSymbol *) Q##cname)->function) \
->flags.no_eval_args = true; \ ->impl.native.no_eval_args = true; \
} }
DECLARE_SYMBOL(nil); DECLARE_SYMBOL(nil);

27
src/function.c
View File

@ -206,10 +206,10 @@ LispVal *make_builtin_function(LispVal *name, LispVal *(*cfunc)(void),
LispVal *docstr) { LispVal *docstr) {
LispFunction *obj = lisp_alloc_object(sizeof(LispFunction), TYPE_FUNCTION); LispFunction *obj = lisp_alloc_object(sizeof(LispFunction), TYPE_FUNCTION);
obj->name = name; obj->name = name;
obj->flags.type = FUNCTION_NATIVE; obj->type = FUNCTION_NATIVE;
obj->flags.no_eval_args = false;
obj->docstr = docstr; obj->docstr = docstr;
obj->impl.native.zero = cfunc; obj->impl.native.no_eval_args = false;
obj->impl.native.addr.zero = cfunc;
ReadStream stream; ReadStream stream;
read_stream_init(&stream, lisp_args, args_len); read_stream_init(&stream, lisp_args, args_len);
LispVal *args_form = read(&stream); LispVal *args_form = read(&stream);
@ -331,7 +331,7 @@ process_complex_native_args(LispFunction *fobj, LispVal *args,
static ALWAYS_INLINE LispVal *call_native(LispVal *orig_func, static ALWAYS_INLINE LispVal *call_native(LispVal *orig_func,
LispFunction *fobj, LispVal *args) { LispFunction *fobj, LispVal *args) {
push_stack_frame(orig_func, fobj, args); push_stack_frame(orig_func, fobj, args);
if (!fobj->flags.no_eval_args) { if (!fobj->impl.native.no_eval_args) {
args = evaluate_function_arguments(args); args = evaluate_function_arguments(args);
} }
set_stack_evaluated_args(args); set_stack_evaluated_args(args);
@ -356,23 +356,24 @@ static ALWAYS_INLINE LispVal *call_native(LispVal *orig_func,
LispVal *retval; LispVal *retval;
switch (count) { switch (count) {
case 0: case 0:
retval = fobj->impl.native.zero(); retval = fobj->impl.native.addr.zero();
break; break;
case 1: case 1:
retval = fobj->impl.native.one(arg_arr[0]); retval = fobj->impl.native.addr.one(arg_arr[0]);
break; break;
case 2: case 2:
retval = fobj->impl.native.two(arg_arr[0], arg_arr[1]); retval = fobj->impl.native.addr.two(arg_arr[0], arg_arr[1]);
break; break;
case 3: case 3:
retval = fobj->impl.native.three(arg_arr[0], arg_arr[1], arg_arr[2]); retval =
fobj->impl.native.addr.three(arg_arr[0], arg_arr[1], arg_arr[2]);
break; break;
case 4: case 4:
retval = fobj->impl.native.four(arg_arr[0], arg_arr[1], arg_arr[2], retval = fobj->impl.native.addr.four(arg_arr[0], arg_arr[1], arg_arr[2],
arg_arr[3]); arg_arr[3]);
break; break;
case 5: case 5:
retval = fobj->impl.native.five(arg_arr[0], arg_arr[1], arg_arr[2], retval = fobj->impl.native.addr.five(arg_arr[0], arg_arr[1], arg_arr[2],
arg_arr[3], arg_arr[4]); arg_arr[3], arg_arr[4]);
break; break;
default: default:
@ -485,13 +486,12 @@ DEFUN(funcall, "funcall", (LispVal * func, LispVal *args), "(func &rest args)",
} }
// include symbol here for the error message // include symbol here for the error message
CHECK_TYPE(fobj, TYPE_FUNCTION, TYPE_SYMBOL); CHECK_TYPE(fobj, TYPE_FUNCTION, TYPE_SYMBOL);
switch (fobj->flags.type) { switch (fobj->type) {
case FUNCTION_NATIVE: case FUNCTION_NATIVE:
return call_native(func, fobj, args); return call_native(func, fobj, args);
case FUNCTION_INTERP: case FUNCTION_INTERP:
return call_interpreted(func, fobj, args); return call_interpreted(func, fobj, args);
default: default:
// TODO implement
abort(); abort();
} }
} }
@ -531,8 +531,7 @@ DEFSPECIAL(lambda, "lambda", (LispVal * args, LispVal *body),
LispFunction *fobj = lisp_alloc_object(sizeof(LispFunction), TYPE_FUNCTION); LispFunction *fobj = lisp_alloc_object(sizeof(LispFunction), TYPE_FUNCTION);
fobj->name = Qnil; fobj->name = Qnil;
fobj->args = llpr.lambda_list; fobj->args = llpr.lambda_list;
fobj->flags.type = FUNCTION_INTERP; fobj->type = FUNCTION_INTERP;
fobj->flags.no_eval_args = false;
if (STRINGP(XCAR(body))) { if (STRINGP(XCAR(body))) {
fobj->docstr = XCAR(body); fobj->docstr = XCAR(body);
if (CONSP(XCDR(body))) { if (CONSP(XCDR(body))) {

14
src/function.h
View File

@ -21,13 +21,16 @@ struct LambdaList {
}; };
#define MAX_NATIVE_FUNCTION_ARGS 5 #define MAX_NATIVE_FUNCTION_ARGS 5
union native_function { struct native_function {
bool no_eval_args;
union {
LispVal *(*zero)(void); LispVal *(*zero)(void);
LispVal *(*one)(LispVal *); LispVal *(*one)(LispVal *);
LispVal *(*two)(LispVal *, LispVal *); LispVal *(*two)(LispVal *, LispVal *);
LispVal *(*three)(LispVal *, LispVal *, LispVal *); LispVal *(*three)(LispVal *, LispVal *, LispVal *);
LispVal *(*four)(LispVal *, LispVal *, LispVal *, LispVal *); LispVal *(*four)(LispVal *, LispVal *, LispVal *, LispVal *);
LispVal *(*five)(LispVal *, LispVal *, LispVal *, LispVal *, LispVal *); LispVal *(*five)(LispVal *, LispVal *, LispVal *, LispVal *, LispVal *);
} addr;
}; };
struct interp_function { struct interp_function {
@ -40,18 +43,13 @@ typedef enum {
FUNCTION_INTERP, FUNCTION_INTERP,
} LispFunctionType; } LispFunctionType;
struct function_flags {
LispFunctionType type : 2;
unsigned int no_eval_args : 1;
};
DEFOBJTYPE(Function, FUNCTION, FUNCTIONP, { DEFOBJTYPE(Function, FUNCTION, FUNCTIONP, {
LispVal *name; // symbol (or nil for a lambda) LispVal *name; // symbol (or nil for a lambda)
struct function_flags flags; LispFunctionType type;
struct LambdaList args; struct LambdaList args;
LispVal *docstr; LispVal *docstr;
union { union {
union native_function native; struct native_function native;
struct interp_function interp; struct interp_function interp;
} impl; } impl;
}); });