Beginnings of a common lisp-like type system
This commit is contained in:
67
src/lisp.c
67
src/lisp.c
@ -380,7 +380,12 @@ LispVal *make_lisp_function(LispVal *name, LispVal *return_tag, LispVal *args,
|
||||
self->oargs = Qnil;
|
||||
self->rest_arg = Qnil;
|
||||
self->kwargs = Qnil;
|
||||
void *cl = register_cleanup(&lisp_free, self);
|
||||
self->name = Qnil;
|
||||
self->return_tag = Qnil;
|
||||
self->lexenv = Qnil;
|
||||
self->doc = Qnil;
|
||||
self->body = Qnil;
|
||||
void *cl = register_cleanup(&refcount_unref_as_callback, self);
|
||||
set_function_args(self, args);
|
||||
cancel_cleanup(cl);
|
||||
|
||||
@ -1390,6 +1395,7 @@ static LispVal *call_builtin(LispVal *name, LispFunction *func, LispVal *args,
|
||||
static void process_lisp_args(LispVal *fname, LispFunction *func, LispVal *args,
|
||||
LispVal **lexenv) {
|
||||
LispVal *added_kwds = make_lisp_hashtable(Qnil, Qnil);
|
||||
void *cl_handle = register_cleanup(&refcount_unref_as_callback, added_kwds);
|
||||
enum { REQ, OPT, KEY, REST } mode = REQ;
|
||||
LispVal *rargs = func->rargs;
|
||||
LispVal *oargs = func->oargs;
|
||||
@ -1491,6 +1497,7 @@ static void process_lisp_args(LispVal *fname, LispFunction *func, LispVal *args,
|
||||
push_to_lexenv(lexenv, func->rest_arg, Qnil);
|
||||
}
|
||||
done_adding:
|
||||
cancel_cleanup(cl_handle);
|
||||
refcount_unref(added_kwds);
|
||||
return;
|
||||
// TODO different messages
|
||||
@ -1498,6 +1505,7 @@ missing_required:
|
||||
too_many_args:
|
||||
missing_value:
|
||||
unknown_key:
|
||||
cancel_cleanup(cl_handle);
|
||||
refcount_unref(added_kwds);
|
||||
Fthrow(Qargument_error, Fpair(fname, Qnil));
|
||||
}
|
||||
@ -2285,14 +2293,18 @@ DEFMACRO(defun, "defun", (LispVal * name, LispVal *args, LispVal *body)) {
|
||||
}
|
||||
LispVal *return_tag =
|
||||
make_lisp_symbol(LISPVAL(((LispSymbol *) name)->name));
|
||||
LispVal *exp_args = Fcopy_list(args);
|
||||
expand_lambda_list_for_toplevel(exp_args);
|
||||
LispVal *expanded_body = expand_function_body(name, return_tag, body);
|
||||
LispVal *func = Qnil;
|
||||
WITH_CLEANUP(exp_args, {
|
||||
WITH_CLEANUP(expanded_body, {
|
||||
func = make_lisp_function(name, return_tag, exp_args,
|
||||
the_stack->lexenv, expanded_body, false);
|
||||
WITH_CLEANUP(return_tag, {
|
||||
LispVal *exp_args = Fcopy_list(args);
|
||||
WITH_CLEANUP(exp_args, {
|
||||
expand_lambda_list_for_toplevel(exp_args);
|
||||
LispVal *expanded_body =
|
||||
expand_function_body(name, return_tag, body);
|
||||
WITH_CLEANUP(expanded_body, {
|
||||
func =
|
||||
make_lisp_function(name, return_tag, exp_args,
|
||||
the_stack->lexenv, expanded_body, false);
|
||||
});
|
||||
});
|
||||
});
|
||||
refcount_unref(Ffset(name, func));
|
||||
@ -2306,14 +2318,18 @@ DEFMACRO(defmacro, "defmacro", (LispVal * name, LispVal *args, LispVal *body)) {
|
||||
}
|
||||
LispVal *return_tag =
|
||||
make_lisp_symbol(LISPVAL(((LispSymbol *) name)->name));
|
||||
LispVal *exp_args = Fcopy_list(args);
|
||||
expand_lambda_list_for_toplevel(exp_args);
|
||||
LispVal *expanded_body = expand_function_body(name, return_tag, body);
|
||||
LispVal *func = Qnil;
|
||||
WITH_CLEANUP(exp_args, {
|
||||
WITH_CLEANUP(expanded_body, {
|
||||
func = make_lisp_function(name, return_tag, exp_args,
|
||||
the_stack->lexenv, expanded_body, true);
|
||||
WITH_CLEANUP(return_tag, {
|
||||
LispVal *exp_args = Fcopy_list(args);
|
||||
WITH_CLEANUP(exp_args, {
|
||||
expand_lambda_list_for_toplevel(exp_args);
|
||||
LispVal *expanded_body =
|
||||
expand_function_body(name, return_tag, body);
|
||||
WITH_CLEANUP(expanded_body, {
|
||||
func =
|
||||
make_lisp_function(name, return_tag, exp_args,
|
||||
the_stack->lexenv, expanded_body, true);
|
||||
});
|
||||
});
|
||||
});
|
||||
refcount_unref(Ffset(name, func));
|
||||
@ -2336,14 +2352,18 @@ DEFMACRO(lambda, "lambda", (LispVal * args, LispVal *body)) {
|
||||
return_tag = make_lisp_symbol(LISPVAL(((LispSymbol *) name)->name));
|
||||
tag_name = name;
|
||||
}
|
||||
LispVal *expanded_body = expand_function_body(tag_name, return_tag, body);
|
||||
LispVal *exp_args = Fcopy_list(args);
|
||||
expand_lambda_list_for_toplevel(exp_args);
|
||||
LispVal *func = Qnil;
|
||||
WITH_CLEANUP(exp_args, {
|
||||
WITH_CLEANUP(expanded_body, {
|
||||
func = make_lisp_function(name, return_tag, args, the_stack->lexenv,
|
||||
expanded_body, false);
|
||||
WITH_CLEANUP(return_tag, {
|
||||
LispVal *expanded_body =
|
||||
expand_function_body(tag_name, return_tag, body);
|
||||
LispVal *exp_args = Fcopy_list(args);
|
||||
WITH_CLEANUP(exp_args, {
|
||||
expand_lambda_list_for_toplevel(exp_args);
|
||||
WITH_CLEANUP(expanded_body, {
|
||||
func =
|
||||
make_lisp_function(name, return_tag, args,
|
||||
the_stack->lexenv, expanded_body, false);
|
||||
});
|
||||
});
|
||||
});
|
||||
return func;
|
||||
@ -2580,7 +2600,8 @@ DEFUN(plist_set, "plist-set",
|
||||
if (NILP(TAIL(cur))) {
|
||||
break;
|
||||
}
|
||||
return refcount_ref(HEAD(TAIL(cur)));
|
||||
Fsethead(TAIL(cur), value);
|
||||
return refcount_ref(plist);
|
||||
}
|
||||
}
|
||||
return push_many(plist, 2, value, key);
|
||||
|
Reference in New Issue
Block a user