#include "function.h" #include "lisp.h" #include "list.h" #include "read.h" #include #include const char *llps_strerror(LambdaListParseStatus status) { static const char *MSGS[LLPS_N_ERROS] = { [LLPS_OK] = "No error", [LLPS_DOTTED] = "Dotted list", [LLPS_REPEAT_SECTION] = "Repeated section", [LLPS_REPEAT_NAME] = "Repeated name", [LLPS_SYNTAX] = "Syntax error", [LLPS_BAD_NAME] = "Invalid variable name", }; return MSGS[status]; } DEFINE_SYMBOL(and_optional, "&optional"); DEFINE_SYMBOL(and_rest, "&rest"); DEFINE_SYMBOL(and_key, "&key"); DEFINE_SYMBOL(and_allow_other_keys, "&allow-other-keys"); static bool is_valid_variable_name(LispVal *val) { return SYMBOLP(val) && !NILP(val) && val != Qt && val != Qunbound; } // on error, put the object that caused the problem in entry static LambdaListParseStatus parse_optional_arg_spec(LispVal **out, LispVal *entry) { // single symbol if (SYMBOLP(entry)) { if (!is_valid_variable_name(entry)) { *out = entry; return LLPS_BAD_NAME; } *out = LIST(entry, Qnil, Qnil); return LLPS_OK; } else if (!CONSP(entry)) { *out = entry; return LLPS_BAD_NAME; } // list LispVal *name = XCAR(entry); if (!is_valid_variable_name(name)) { *out = name; return LLPS_BAD_NAME; } if (list_length_eq(entry, 1)) { *out = LIST(XCAR(entry), Qnil, Qnil); return LLPS_OK; } else if (list_length_eq(entry, 2)) { *out = LIST(name, XCAR(XCDR(entry)), Qnil); return LLPS_OK; } else if (list_length_eq(entry, 3)) { LispVal *pvar = XCAR(XCDR(XCDR(entry))); if (!is_valid_variable_name(pvar)) { return LLPS_BAD_NAME; } *out = LIST(XCAR(entry), XCAR(XCDR(entry)), pvar); return LLPS_OK; } else { *out = entry; return LLPS_SYNTAX; } } #define RETURN_ERROR(err, obj) \ { \ result->status = err; \ result->err_obj = (obj); \ return; \ } void parse_lambda_list(LambdaListParseResult *result, LispVal *list) { enum { REQ = 0, OPT = 1, KEY = 2, REST, MUST_CHANGE } mode = REQ; unsigned int seen = 0; result->err_obj = Qnil; result->status = LLPS_OK; struct LambdaList *out = &result->lambda_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; FOREACH_TAIL(list, tail) { if (!LISTP(tail)) { RETURN_ERROR(LLPS_DOTTED, list); } LispVal *cur = XCAR(tail); if (cur == Qand_allow_other_keys) { if (out->allow_other_keys) { RETURN_ERROR(LLPS_REPEAT_SECTION, list); } 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) } mode = REST; } else if (cur == Qand_optional) { if (seen & OPT) { RETURN_ERROR(LLPS_REPEAT_SECTION, list) } seen |= OPT; mode = OPT; } else if (cur == Qand_key) { if (seen & KEY) { RETURN_ERROR(LLPS_REPEAT_SECTION, list) } seen |= KEY; mode = KEY; } else if (mode == MUST_CHANGE) { // &rest without a variable RETURN_ERROR(LLPS_SYNTAX, list) } else if (mode == REST) { if (!is_valid_variable_name(cur)) { RETURN_ERROR(LLPS_BAD_NAME, cur) } out->rest = cur; mode = MUST_CHANGE; } else if (mode == OPT || mode == KEY) { LispVal *entry; LambdaListParseStatus status = parse_optional_arg_spec(&entry, cur); if (status != LLPS_OK) { RETURN_ERROR(status, entry) } if (mode == OPT) { out->opt = CONS(entry, out->opt); ++out->n_opt; } else { out->kw = CONS(entry, out->kw); ++out->n_kw; } } else if (!is_valid_variable_name(cur)) { RETURN_ERROR(LLPS_BAD_NAME, cur); } else { out->req = CONS(cur, out->req); ++out->n_req; } } out->req = Fnreverse(out->req); out->opt = Fnreverse(out->opt); out->kw = Fnreverse(out->kw); } #undef RETURN_ERROR LispVal *make_builtin_function(LispVal *name, LispVal *(*cfunc)(), const char *lisp_args, size_t args_len, LispVal *docstr) { LispFunction *obj = lisp_alloc_object(sizeof(LispFunction), TYPE_FUNCTION); obj->name = name; obj->is_native = true; obj->docstr = docstr; obj->impl.native.zero = cfunc; ReadStream stream; read_stream_init(&stream, lisp_args, args_len); LispVal *args_form = read(&stream); if (!args_form) { fprintf(stderr, "Builtin function lambda list had a syntax error\n"); fprintf(stderr, "Name: "); debug_print(stderr, name); fprintf(stderr, "\nLambda list: \"%s\"\n", lisp_args); exit(1); } LambdaListParseResult result; parse_lambda_list(&result, args_form); if (result.status != LLPS_OK) { fprintf(stderr, "Error parsing builtin lambda list: %s\n", llps_strerror(result.status)); fprintf(stderr, "Name: "); debug_print(stderr, name); fprintf(stderr, "\nLambda list: \"%s\"\n", lisp_args); exit(1); } return obj; }