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

Builtin function argument parsing

Browse Source
This commit is contained in:
Alexander Rosenberg
2026-01-19 23:29:14 -08:00
parent c63b104bc6
commit 243a012d3e
11 changed files with 243 additions and 50 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/function.c
+181 -23
View File
@@ -6,6 +6,7 @@
#include <stdio.h>
#include <stdlib.h>
#include <string.h>
const char *llps_strerror(LambdaListParseStatus status) {
static const char *MSGS[LLPS_N_ERROS] = {
@@ -13,8 +14,11 @@ const char *llps_strerror(LambdaListParseStatus status) {
[LLPS_DOTTED] = "Dotted list",
[LLPS_REPEAT_SECTION] = "Repeated section",
[LLPS_REPEAT_NAME] = "Repeated name",
[LLPS_SYNTAX] = "Syntax error",
[LLPS_ORDER] = "Section out of order",
[LLPS_BAD_NAME] = "Invalid variable name",
[LLPS_REPEAT_REST] = "Too many rest variables",
[LLPS_AFTER_ALLOW_OTHER_KEYS] = "Variable after &allow-other-keys",
[LLPS_INVALID_OPT_SPEC] = "Invalid optional spec",
};
return MSGS[status];
}
@@ -28,6 +32,17 @@ static bool is_valid_variable_name(LispVal *val) {
return SYMBOLP(val) && !NILP(val) && val != Qt && val != Qunbound;
}
static LispVal *intern_as_keyword(LispVal *name) {
assert(SYMBOLP(name));
LispString *name_str = ((LispSymbol *) name)->name;
char *kw_name = lisp_malloc(name_str->length + 2);
kw_name[0] = ':';
memcpy(kw_name + 1, name_str->data, name_str->length);
kw_name[name_str->length + 1] = '\0';
return Fintern(
make_lisp_string(kw_name, name_str->length + 1, true, false));
}
// on error, put the object that caused the problem in entry
static LambdaListParseStatus parse_optional_arg_spec(LispVal **out,
LispVal *entry) {
@@ -64,7 +79,7 @@ static LambdaListParseStatus parse_optional_arg_spec(LispVal **out,
return LLPS_OK;
} else {
*out = entry;
return LLPS_SYNTAX;
return LLPS_INVALID_OPT_SPEC;
}
}
@@ -75,7 +90,7 @@ static LambdaListParseStatus parse_optional_arg_spec(LispVal **out,
return; \
}
void parse_lambda_list(LambdaListParseResult *result, LispVal *list) {
enum { REQ = 0, OPT = 1, KEY = 2, REST, MUST_CHANGE } mode = REQ;
enum { REQ = 0, OPT = 1, KEY = 2, REST = 4, MUST_CHANGE } mode = REQ;
unsigned int seen = 0;
result->err_obj = Qnil;
result->status = LLPS_OK;
@@ -83,31 +98,39 @@ void parse_lambda_list(LambdaListParseResult *result, LispVal *list) {
// TODO check for repeat names
out->n_req = 0;
out->n_opt = 0;
out->n_kw = 0;
out->allow_other_keys = false;
out->req = Qnil;
out->opt = Qnil;
out->kw = Qnil;
out->rest = Qnil;
size_t cur_idx = 0; // for keyword args
FOREACH_TAIL(list, tail) {
if (!LISTP(tail)) {
RETURN_ERROR(LLPS_DOTTED, list);
} else if (out->allow_other_keys) {
RETURN_ERROR(LLPS_AFTER_ALLOW_OTHER_KEYS, XCAR(tail));
}
LispVal *cur = XCAR(tail);
if (cur == Qand_allow_other_keys) {
if (out->allow_other_keys) {
RETURN_ERROR(LLPS_REPEAT_SECTION, list);
RETURN_ERROR(LLPS_REPEAT_SECTION, cur);
} else if (!(seen & KEY)) {
RETURN_ERROR(LLPS_ORDER, cur);
}
out->allow_other_keys = true;
mode = MUST_CHANGE;
} else if (cur == Qand_rest) {
if (!NILP(out->rest) || mode == REST) {
RETURN_ERROR(LLPS_REPEAT_SECTION, list)
if (seen & REST) {
RETURN_ERROR(LLPS_REPEAT_SECTION, cur)
} else if (seen & KEY) {
RETURN_ERROR(LLPS_ORDER, cur);
}
seen |= REST;
mode = REST;
} else if (cur == Qand_optional) {
if (seen & OPT) {
RETURN_ERROR(LLPS_REPEAT_SECTION, list)
RETURN_ERROR(LLPS_REPEAT_SECTION, cur)
} else if (seen & KEY || seen & REST) {
RETURN_ERROR(LLPS_ORDER, cur);
}
seen |= OPT;
mode = OPT;
@@ -117,15 +140,15 @@ void parse_lambda_list(LambdaListParseResult *result, LispVal *list) {
}
seen |= KEY;
mode = KEY;
} else if (mode == MUST_CHANGE) {
// &rest without a variable
RETURN_ERROR(LLPS_SYNTAX, list)
out->kw = Fmake_hash_table(Qnil, Qnil);
} else if (mode == REST) {
if (!is_valid_variable_name(cur)) {
if (!NILP(out->rest)) {
RETURN_ERROR(LLPS_REPEAT_REST, cur);
} else if (!is_valid_variable_name(cur)) {
RETURN_ERROR(LLPS_BAD_NAME, cur)
}
out->rest = cur;
mode = MUST_CHANGE;
++cur_idx;
} else if (mode == OPT || mode == KEY) {
LispVal *entry;
LambdaListParseStatus status = parse_optional_arg_spec(&entry, cur);
@@ -136,22 +159,20 @@ void parse_lambda_list(LambdaListParseResult *result, LispVal *list) {
out->opt = CONS(entry, out->opt);
++out->n_opt;
} else {
out->kw = CONS(entry, out->kw);
++out->n_kw;
Fputhash(out->kw, intern_as_keyword(XCAR(entry)),
CONS(MAKE_FIXNUM(cur_idx), entry));
}
++cur_idx;
} else if (!is_valid_variable_name(cur)) {
RETURN_ERROR(LLPS_BAD_NAME, cur);
} else {
out->req = CONS(cur, out->req);
++out->n_req;
++cur_idx;
}
}
if ((seen & KEY) == 0 && out->allow_other_keys) {
RETURN_ERROR(LLPS_SYNTAX, list);
}
out->req = Fnreverse(out->req);
out->opt = Fnreverse(out->opt);
out->kw = Fnreverse(out->kw);
}
#undef RETURN_ERROR
@@ -184,13 +205,16 @@ LispVal *make_builtin_function(LispVal *name, LispVal *(*cfunc)(),
fprintf(stderr, "\nLambda list: \"%s\"\n", lisp_args);
exit(1);
}
obj->args = result.lambda_list;
return obj;
}
// Calling functions
// A simple function has only required args
static ALWAYS_INLINE bool SIMPLE_FUNCTION_P(LispFunction *fobj) {
return !fobj->args.n_opt && !fobj->args.n_kw && NILP(fobj->args.rest);
return !fobj->args.n_opt
&& (NILP(fobj->args.kw) || !HASH_TABLE_COUNT(fobj->args.kw))
&& NILP(fobj->args.rest);
}
static ALWAYS_INLINE LispVal *
@@ -209,24 +233,155 @@ call_simple_native(LispVal *orig_func, LispFunction *fobj, LispVal *args) {
switch (fobj->args.n_req) {
case 0:
retval = fobj->impl.native.zero();
break;
case 1:
retval = fobj->impl.native.one(FIRST(args));
break;
case 2:
retval = fobj->impl.native.two(FIRST(args), SECOND(args));
break;
case 3:
retval =
fobj->impl.native.three(FIRST(args), SECOND(args), THIRD(args));
break;
case 4:
retval = fobj->impl.native.four(FIRST(args), SECOND(args), THIRD(args),
FOURTH(args));
break;
case 5:
retval = fobj->impl.native.five(FIRST(args), SECOND(args), THIRD(args),
FOURTH(args), FIFTH(args));
break;
default:
abort();
}
the_stack.nogc_retval = retval;
pop_stack_frame();
return retval;
}
enum ProcessArgsResult {
PROCESS_ARGS_OK,
PROCESS_ARGS_TOO_FEW,
PROCESS_ARGS_TOO_MANY,
PROCESS_ARGS_NO_KEY_VALUE,
PROCESS_ARGS_BAD_KEY,
PROCESS_ARGS_N_ERRORS,
};
static const char *process_args_strerror(enum ProcessArgsResult status) {
static const char *MSGS[PROCESS_ARGS_N_ERRORS] = {
[PROCESS_ARGS_OK] = "No error",
[PROCESS_ARGS_TOO_FEW] = "Not enough arguments",
[PROCESS_ARGS_TOO_MANY] = "Too many arguments",
[PROCESS_ARGS_NO_KEY_VALUE] = "Key without a value",
[PROCESS_ARGS_BAD_KEY] = "Unknown key",
};
return MSGS[status];
}
static ALWAYS_INLINE size_t NATIVE_FUNCTION_TOTAL_ARG_COUNT(LispVal *val) {
assert(FUNCTIONP(val));
LispFunction *fobj = val;
return fobj->args.n_req + fobj->args.n_opt + !NILP(fobj->args.rest)
+ (NILP(fobj->args.kw) ? 0 : HASH_TABLE_COUNT(fobj->args.kw));
}
static ALWAYS_INLINE enum ProcessArgsResult
process_complex_native_args(LispFunction *fobj, LispVal *args,
LispVal *restrict out[MAX_NATIVE_FUNCTION_ARGS]) {
size_t rem_req = fobj->args.n_req;
size_t rem_opt = fobj->args.n_opt;
size_t idx = 0;
while (rem_req--) {
if (NILP(args)) {
return PROCESS_ARGS_TOO_FEW;
}
out[idx++] = XCAR(args);
args = XCDR(args);
}
while (rem_opt--) {
if (NILP(args)) {
return PROCESS_ARGS_OK;
}
out[idx++] = XCAR(args);
args = XCDR(args);
}
if (!NILP(args) && (NILP(fobj->args.kw)) && NILP(fobj->args.rest)) {
return PROCESS_ARGS_TOO_MANY;
}
if (!NILP(fobj->args.rest)) {
out[idx++] = args;
}
if (NILP(fobj->args.kw)) { // we are not a keyword function
return PROCESS_ARGS_OK;
}
while (!NILP(args)) {
if (NILP(XCDR(args))) {
return PROCESS_ARGS_NO_KEY_VALUE;
}
LispVal *entry = Fgethash(fobj->args.kw, XCAR(args), Qnil);
if (!NILP(entry)) {
fixnum_t idx = XFIXNUM(XCAR(entry));
if (!out[idx]) {
out[idx] = XCAR(XCDR(args));
}
} else if (!fobj->args.allow_other_keys) {
return PROCESS_ARGS_BAD_KEY;
}
args = XCDR(XCDR(args));
}
return PROCESS_ARGS_OK;
}
static ALWAYS_INLINE LispVal *
call_complex_native(LispVal *orig_func, LispFunction *fobj, LispVal *args) {
LispVal *arg_arr[MAX_NATIVE_FUNCTION_ARGS] = {NULL};
size_t count = NATIVE_FUNCTION_TOTAL_ARG_COUNT(fobj);
enum ProcessArgsResult res =
process_complex_native_args(fobj, args, arg_arr);
if (res != PROCESS_ARGS_OK) {
// TODO better errors
printf("Bad arguments to builtin \"");
debug_print(stdout, orig_func);
printf("\": %s\n", process_args_strerror(res));
abort();
}
push_stack_frame(orig_func, fobj, args);
for (intptr_t i = 0; i < count; ++i) {
if (!arg_arr[i]) {
arg_arr[i] = Qnil;
} else {
add_local_reference(arg_arr[i]);
}
}
LispVal *retval;
switch (count) {
case 0:
retval = fobj->impl.native.zero();
break;
case 1:
retval = fobj->impl.native.one(arg_arr[0]);
break;
case 2:
retval = fobj->impl.native.two(arg_arr[0], arg_arr[1]);
break;
case 3:
retval = fobj->impl.native.three(arg_arr[0], arg_arr[1], arg_arr[2]);
break;
case 4:
retval = fobj->impl.native.four(arg_arr[0], arg_arr[1], arg_arr[2],
arg_arr[3]);
break;
case 5:
retval = fobj->impl.native.five(arg_arr[0], arg_arr[1], arg_arr[2],
arg_arr[3], arg_arr[4]);
break;
default:
abort();
}
the_stack.nogc_retval = retval;
pop_stack_frame();
// TODO probably need to protect retval from GC here
return retval;
}
@@ -235,7 +390,7 @@ static ALWAYS_INLINE LispVal *call_native(LispVal *orig_func,
if (SIMPLE_FUNCTION_P(fobj)) {
return call_simple_native(orig_func, fobj, args);
}
return Qnil;
return call_complex_native(orig_func, fobj, args);
}
DEFUN(funcall, "funcall", (LispVal * func, LispVal *args), "(func &rest args)",
@@ -249,6 +404,9 @@ DEFUN(funcall, "funcall", (LispVal * func, LispVal *args), "(func &rest args)",
// TODO error
abort();
}
if (!fobj->flags.no_eval_args) {
// TODO evaluate arguments
}
switch (fobj->flags.type) {
case FUNCTION_NATIVE:
return call_native(func, fobj, args);