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

Macro expansion!

Browse Source
This commit is contained in:
Zander671
2026-09-04 05:45:48 -07:00
parent 3b2ecf2b16
commit 8024bcfee3
13 changed files with 373 additions and 56 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/function.c
+67 -45
View File
@@ -235,21 +235,6 @@ LispVal *make_builtin_function(LispVal *name, LispVal *(*cfunc)(void),
}
// Calling functions
static ALWAYS_INLINE LispVal *evaluate_function_arguments(LispVal *args) {
LispVal *start = Qnil;
LispVal *end = NULL;
DOLIST(arg, args) {
if (NILP(start)) {
start = CONS(Feval(arg, Vlexical_environment), Qnil);
end = start;
} else {
RPLACD(end, CONS(Feval(arg, Vlexical_environment), Qnil));
end = XCDR(end);
}
}
return start;
}
enum ProcessArgsResult {
PROCESS_ARGS_OK,
PROCESS_ARGS_TOO_FEW,
@@ -334,13 +319,7 @@ static noreturn void signal_argument_error(enum ProcessArgsResult res) {
lisp_signal(Qargument_error, LIST(msg));
}
static ALWAYS_INLINE LispVal *call_native(LispVal *orig_func,
LispFunction *fobj, LispVal *args) {
StackFrame *stack_ref = LISP_STACK_REF();
if (!fobj->impl.native.no_eval_args) {
args = evaluate_function_arguments(args);
}
set_stack_evaluated_args(LISP_STACK_REF(), fobj, args);
static ALWAYS_INLINE LispVal *call_native(LispFunction *fobj, LispVal *args) {
LispVal *arg_arr[MAX_NATIVE_FUNCTION_ARGS] = {NULL};
size_t count = NATIVE_FUNCTION_TOTAL_ARG_COUNT(fobj);
intptr_t rest_idx;
@@ -381,7 +360,7 @@ static ALWAYS_INLINE LispVal *call_native(LispVal *orig_func,
default:
abort();
}
return UNWIND_AND_RETURN(stack_ref, retval);
return retval;
}
static ALWAYS_INLINE void push_optional_argument_to_lexenv(LispVal *spec,
@@ -455,21 +434,17 @@ push_interpreted_args_to_lexenv(LispFunction *fobj, LispVal *args) {
return PROCESS_ARGS_OK;
}
static ALWAYS_INLINE LispVal *
call_interpreted(LispVal *orig_func, LispFunction *fobj, LispVal *args) {
StackFrame *stack_ref = LISP_STACK_REF();
LispVal *evaled_args = evaluate_function_arguments(args);
set_stack_evaluated_args(LISP_STACK_REF(), fobj, evaled_args);
static ALWAYS_INLINE LispVal *call_interpreted(LispFunction *fobj,
LispVal *args) {
push_dynamic_binding(Qlexical_environment, fobj->impl.interp.lexenv);
enum ProcessArgsResult par =
push_interpreted_args_to_lexenv(fobj, evaled_args);
enum ProcessArgsResult par = push_interpreted_args_to_lexenv(fobj, args);
if (par != PROCESS_ARGS_OK) {
signal_argument_error(par);
}
return UNWIND_AND_RETURN(stack_ref, Fprogn(fobj->impl.interp.body));
return Fprogn(fobj->impl.interp.body);
}
static LispFunction *coerce_to_function(LispVal *func) {
LispFunction *coerce_to_function(LispVal *orig_name, LispVal *func) {
LispFunction *fobj = func;
if (SYMBOLP(func)) {
fobj = Fsymbol_function(func, Qt);
@@ -477,29 +452,39 @@ static LispFunction *coerce_to_function(LispVal *func) {
fobj = Feval(func, Vlexical_environment);
}
if (NILP(fobj)) {
lisp_signal(Qvoid_function_error, LIST(orig_name));
} else if (!FUNCTIONP(fobj)) {
signal_type_error(fobj, LIST(Qcallable));
}
// include symbol here for the error message
CHECK_TYPE(fobj, TYPE_FUNCTION, TYPE_SYMBOL);
assert(FUNCTIONP(fobj));
return fobj;
}
DEFUN(funcall, "funcall", (LispVal * func, LispVal *args), "(func &rest args)",
"") {
StackFrame *stack_ref = LISP_STACK_REF();
push_call_frame(func, args);
LispFunction *fobj = coerce_to_function(func);
LispVal *raw_funcall(LispVal *func, LispVal *args) {
assert(FUNCTIONP(func));
LispFunction *fobj = func;
switch (fobj->type) {
case FUNCTION_NATIVE:
return UNWIND_AND_RETURN(stack_ref, call_native(func, fobj, args));
return call_native(fobj, args);
case FUNCTION_INTERP:
return UNWIND_AND_RETURN(stack_ref, call_interpreted(func, fobj, args));
return call_interpreted(fobj, args);
default:
abort();
}
}
DEFUN(funcall, "funcall", (LispVal * func, LispVal *args), "(func &rest args)",
"") {
LispVal *res = coerce_to_function(func, func);
if (!NILP(Fspecial_form_p(res))) {
signal_type_error(res, Qfunction);
}
StackFrame *stack_ref = LISP_STACK_REF();
push_call_frame(func, args);
set_stack_evaluated_args(LISP_STACK_REF(), res, args);
return UNWIND_AND_RETURN(stack_ref, raw_funcall(res, args));
}
static LispVal *parse_lambda_declare_form(LispFunction *fobj, LispVal *body) {
while (CONSP(body) && CONSP(XCAR(body)) && EQ(XCAR(XCAR(body)), Qdeclare)) {
LispVal *decls = XCDR(XCAR(body));
@@ -519,6 +504,18 @@ static LispVal *parse_lambda_declare_form(LispFunction *fobj, LispVal *body) {
return body;
}
static void macroexpand_lambda_list(struct LambdaList *restrict ll) {
DOLIST(ent, ll->opt) {
RPLACA(XCDR(ent), Fmacroexpand_all(SECOND(ent), Qnil));
}
if (HASH_TABLE_P(ll->kw)) {
HT_FOREACH_INDEX(ll->kw, i) {
LispVal *ent = HASH_VALUE(ll->kw, i);
RPLACA(XCDR(XCDR(ent)), Fmacroexpand_all(THIRD(ent), Qnil));
}
}
}
DEFSPECIAL(lambda, "lambda", (LispVal * args, LispVal *body),
"(args &rest body)", "") {
LambdaListParseResult llpr;
@@ -542,7 +539,8 @@ DEFSPECIAL(lambda, "lambda", (LispVal * args, LispVal *body),
fobj->docstr = Qnil;
}
body = parse_lambda_declare_form(fobj, body);
fobj->impl.interp.body = body;
macroexpand_lambda_list(&fobj->args);
fobj->impl.interp.body = macroexpand_list(body, Qnil);
fobj->impl.interp.lexenv = Vlexical_environment;
return fobj;
}
@@ -556,8 +554,9 @@ DEFUN(callablep, "callablep", (LispVal * obj), "(obj)", "") {
}
DEFUN(function_arity, "function-arity", (LispVal * func), "(func)",
"Return a list of the form (NUM-REQ NUM-OPT KW-NAMES HAS-REST).") {
LispFunction *fobj = coerce_to_function(func);
"Return a list of the form (NUM-REQ NUM-OPT KW-NAMES ALLOW-OTHER-KEYS "
"HAS-REST).") {
LispFunction *fobj = coerce_to_function(func, func);
LispVal *kw = Qnil;
if (HASH_TABLE_P(fobj->args.kw)) {
HT_FOREACH_INDEX(fobj->args.kw, i) {
@@ -565,7 +564,28 @@ DEFUN(function_arity, "function-arity", (LispVal * func), "(func)",
}
}
return LIST(MAKE_FIXNUM(fobj->args.n_req), MAKE_FIXNUM(fobj->args.n_opt),
kw, NILP(fobj->args.rest) ? Qnil : Qt);
kw, fobj->args.allow_other_keys ? Qt : Qnil,
NILP(fobj->args.rest) ? Qnil : Qt);
}
bool builtin_function_p(LispVal *val, bool special_form) {
if (SYMBOLP(val)) {
val = Fsymbol_function(val, Qt);
}
if (FUNCTIONP(val)) {
LispFunction *fobj = val;
return fobj->type == FUNCTION_NATIVE
&& fobj->impl.native.no_eval_args == special_form;
}
return false;
}
DEFUN(builtin_function_p, "builtin-function-p", (LispVal * val), "(val)", "") {
return builtin_function_p(val, false) ? Qt : Qnil;
}
DEFUN(special_form_p, "special-form-p", (LispVal * val), "(val)", "") {
return builtin_function_p(val, true) ? Qt : Qnil;
}
DEFINE_SYMBOL(declare, "declare");
@@ -574,6 +594,8 @@ DEFINE_SYMBOL(name, "name");
DEFINE_SYMBOL(callable, "callable");
DEFINE_SYMBOL(argument_error, "argument-error");
DEFINE_CONDITION_CLASS(argument_error, error);
DEFINE_SYMBOL(void_function_error, "void-function-error");
DEFINE_CONDITION_CLASS(void_function_error, error);
DEFINE_SYMBOL(function_definition_error, "function-definition-error");
DEFINE_CONDITION_CLASS(function_definition_error, error);