Commit 82eb3001 authored by Jean-Claude Beaudoin's avatar Jean-Claude Beaudoin
Browse files

Get rid of "@(defun ...) forms and replace them with explicit C code. Major...

Get rid of "@(defun ...) forms and replace them with explicit C code. Major step toward retirement of dpp.
parent 38d7fe2f
......@@ -4,7 +4,7 @@
*/
/*
Copyright (c) 2001, Juan Jose Garcia Ripoll.
Copyright (c) 2011-2016, Jean-Claude Beaudoin.
Copyright (c) 2011-2016,2021, Jean-Claude Beaudoin.
MKCL is free software; you can redistribute it and/or
modify it under the terms of the GNU Lesser General Public
......@@ -1530,13 +1530,18 @@ mkcl_object mk_si_scrub_values(MKCL)
mkcl_return_no_value;
}
@(defun si::gc (&optional area)
@
mk_si_trim_dynamic_cons_stack(env);
mk_si_scrub_values(env);
MKCL_GC_NO_INTR(env, MK_GC_gcollect());
mkcl_return_no_value;
@)
mkcl_object mk_si_gc(MKCL, mkcl_narg narg, ...)
{
mkcl_call_stack_check(env);
{
mkcl_object area = mk_cl_Cnil;
MKCL_RECEIVE_1_OPTIONAL_ARGUMENT(env, @'si::gc', narg, 0, narg, &area);
mk_si_trim_dynamic_cons_stack(env);
mk_si_scrub_values(env);
MKCL_GC_NO_INTR(env, MK_GC_gcollect());
mkcl_return_no_value;
}
}
mkcl_object
mk_si_gc_dump(MKCL)
......
......@@ -6,7 +6,7 @@
Copyright (c) 1984, Taiichi Yuasa and Masami Hagiya.
Copyright (c) 1990, Giuseppe Attardi.
Copyright (c) 2001, Juan Jose Garcia Ripoll.
Copyright (c) 2010-2017, Jean-Claude Beaudoin.
Copyright (c) 2010-2017,2021, Jean-Claude Beaudoin.
MKCL is free software; you can redistribute it and/or
modify it under the terms of the GNU Lesser General Public
......@@ -50,46 +50,53 @@ mk_cl_set(MKCL, mkcl_object var, mkcl_object val)
mkcl_return1(val);
}
@(defun si::fset (fname def &optional macro pprint)
mkcl_object sym = mk_si_function_block_name(env, fname);
mkcl_object pack;
bool mflag;
int type;
@
if (mkcl_Null(sym)) sym = mk_cl_Cnil_symbol;
if (mkcl_Null(mk_cl_functionp(env, def))) mkcl_FEinvalid_function(env, def);
pack = mkcl_symbol_package(env, sym);
if (pack != mk_cl_Cnil && pack->pack.closed) {
mkcl_CEpackage_error(env, pack,
"Attempt to redefine function ~S in closed package ~S.",
"Ignore closing and proceed", 2, fname, pack);
}
mflag = !mkcl_Null(macro);
type = mkcl_symbol_type(env, sym);
if ((type & mkcl_stp_special_form) && !mflag) {
mkcl_FEerror(env, "Given that ~S is a special form, ~S cannot be defined as a function.",
2, sym, fname);
}
if (MKCL_SYMBOLP(fname)) {
if (mflag) {
type |= mkcl_stp_macro;
mkcl_object mk_si_fset(MKCL, mkcl_narg narg, mkcl_object fname, mkcl_object def, ...)
{
mkcl_call_stack_check(env);
{
mkcl_object sym = mk_si_function_block_name(env, fname);
mkcl_object pack;
bool mflag;
int type;
mkcl_object macro = mk_cl_Cnil;
mkcl_object pprint = mk_cl_Cnil;
MKCL_RECEIVE_2_OPTIONAL_ARGUMENTS(env, @'si::fset', narg, 2, def, &macro, &pprint);
if (mkcl_Null(sym)) sym = mk_cl_Cnil_symbol;
if (mkcl_Null(mk_cl_functionp(env, def))) mkcl_FEinvalid_function(env, def);
pack = mkcl_symbol_package(env, sym);
if (pack != mk_cl_Cnil && pack->pack.closed) {
mkcl_CEpackage_error(env, pack,
"Attempt to redefine function ~S in closed package ~S.",
"Ignore closing and proceed", 2, fname, pack);
}
mflag = !mkcl_Null(macro);
type = mkcl_symbol_type(env, sym);
if ((type & mkcl_stp_special_form) && !mflag) {
mkcl_FEerror(env, "Given that ~S is a special form, ~S cannot be defined as a function.",
2, sym, fname);
}
if (MKCL_SYMBOLP(fname)) {
if (mflag) {
type |= mkcl_stp_macro;
} else {
type &= ~mkcl_stp_macro;
}
mkcl_symbol_type_set(env, sym, type);
MKCL_SYM_FUN(sym) = def;
if (!MKCL_INSTANCEP(def) && mkcl_Null(mk_si_compiled_function_name(env, def)))
mk_si_set_compiled_function_name(env, def, sym);
} else {
type &= ~mkcl_stp_macro;
if (mflag)
mkcl_FEerror(env, "~S is not a valid name for a macro.", 1, fname);
mk_si_put_sysprop(env, sym, @'si::setf-symbol', def);
mk_si_rem_sysprop(env, sym, @'si::setf-lambda');
mk_si_rem_sysprop(env, sym, @'si::setf-method');
mk_si_rem_sysprop(env, sym, @'si::setf-update');
}
mkcl_symbol_type_set(env, sym, type);
MKCL_SYM_FUN(sym) = def;
if (!MKCL_INSTANCEP(def) && mkcl_Null(mk_si_compiled_function_name(env, def)))
mk_si_set_compiled_function_name(env, def, sym);
} else {
if (mflag)
mkcl_FEerror(env, "~S is not a valid name for a macro.", 1, fname);
mk_si_put_sysprop(env, sym, @'si::setf-symbol', def);
mk_si_rem_sysprop(env, sym, @'si::setf-lambda');
mk_si_rem_sysprop(env, sym, @'si::setf-method');
mk_si_rem_sysprop(env, sym, @'si::setf-update');
mkcl_return_value(def);
}
mkcl_return_value(def);
@)
}
mkcl_object
mk_cl_makunbound(MKCL, mkcl_object sym)
......
......@@ -116,14 +116,19 @@ mkcl_string_case(const mkcl_object str)
else return str_case;
}
@(defun digit_char_p (c &optional (radix MKCL_MAKE_FIXNUM(10)))
@
mkcl_object mk_cl_digit_char_p(MKCL, mkcl_narg narg, mkcl_object c, ...)
{
mkcl_call_stack_check(env);
{
mkcl_word basis = mkcl_fixnum_in_range(env, @'digit-char-p',"radix", radix, 2, 36);
mkcl_word value = mkcl_digitp(mkcl_char_code(env, c), basis);
mkcl_return_value(((value < 0)? mk_cl_Cnil: MKCL_MAKE_FIXNUM(value)));
}
@)
mkcl_object radix = MKCL_MAKE_FIXNUM(10);
MKCL_RECEIVE_1_OPTIONAL_ARGUMENT(env, @'digit-char-p', narg, 1, c, &radix);
{
mkcl_word basis = mkcl_fixnum_in_range(env, @'digit-char-p',"radix", radix, 2, 36);
mkcl_word value = mkcl_digitp(mkcl_char_code(env, c), basis);
mkcl_return_value(((value < 0)? mk_cl_Cnil: MKCL_MAKE_FIXNUM(value)));
}
}
}
/*
Mkcl_Digitp(i, r) returns the weight of code i
......@@ -494,30 +499,38 @@ mk_cl_char_downcase(MKCL, mkcl_object c)
mkcl_return_value(MKCL_CODE_CHAR(mkcl_char_downcase(code)));
}
@(defun digit_char (weight &optional (radix MKCL_MAKE_FIXNUM(10)))
@ {
mkcl_word basis = mkcl_fixnum_in_range(env, @'digit-char',"radix",radix,2,36);
mkcl_object output = mk_cl_Cnil;
AGAIN:
switch (mkcl_type_of(weight)) {
case mkcl_t_fixnum: {
mkcl_word value = mkcl_fixnum_to_word(weight);
if (value >= 0) {
int dw = mkcl_digit_char(value, basis);
if (dw >= 0) {
output = MKCL_CODE_CHAR(dw);
}
mkcl_object mk_cl_digit_char(MKCL, mkcl_narg narg, mkcl_object weight, ...)
{
mkcl_call_stack_check(env);
{
mkcl_object radix = MKCL_MAKE_FIXNUM(10);
MKCL_RECEIVE_1_OPTIONAL_ARGUMENT(env, @'digit-char', narg, 1, weight, &radix);
{
mkcl_word basis = mkcl_fixnum_in_range(env, @'digit-char',"radix",radix,2,36);
mkcl_object output = mk_cl_Cnil;
AGAIN:
switch (mkcl_type_of(weight)) {
case mkcl_t_fixnum: {
mkcl_word value = mkcl_fixnum_to_word(weight);
if (value >= 0) {
int dw = mkcl_digit_char(value, basis);
if (dw >= 0) {
output = MKCL_CODE_CHAR(dw);
}
}
break;
}
break;
}
case mkcl_t_bignum:
break;
default:
weight = mkcl_type_error(env, @'digit-char',"weight",weight,@'integer');
goto AGAIN;
case mkcl_t_bignum:
break;
default:
weight = mkcl_type_error(env, @'digit-char',"weight",weight,@'integer');
goto AGAIN;
}
mkcl_return_value(output);
}
mkcl_return_value(output);
} @)
}
}
short
mkcl_digit_char(mkcl_word w, mkcl_word r)
......
......@@ -6,7 +6,7 @@
Copyright (c) 1984, Taiichi Yuasa and Masami Hagiya.
Copyright (c) 1990, Giuseppe Attardi.
Copyright (c) 2001, Juan Jose Garcia Ripoll.
Copyright (c) 2010-2016, Jean-Claude Beaudoin.
Copyright (c) 2010-2016,2021 Jean-Claude Beaudoin.
MKCL is free software; you can redistribute it and/or
modify it under the terms of the GNU Lesser General Public
......@@ -166,7 +166,7 @@ mkcl_grab_rest_args(MKCL, mkcl_va_list args, bool dynamic)
return rest;
}
void
void /* old, swiss knife version. JCB */
mkcl_parse_key(MKCL,
mkcl_va_list args, /* actual args */
const mkcl_word nkey, /* number of keywords */
......@@ -222,6 +222,248 @@ mkcl_parse_key(MKCL,
mkcl_FEprogram_error(env, "Unknown keyword ~S", 1, unknown_keyword);
}
/* new, targeted version. JCB */
void mkcl_receive_1_keyword_argument(MKCL, const mkcl_object fname, mkcl_va_list ARGS, const mkcl_object key_arg_symbol, mkcl_object * const key_var_ref)
{
bool key_arg_seen = false;
bool extra_would_be_keyword_seen = false;
mkcl_object extra_would_be_keyword = mk_cl_Cnil;
bool allow_other_keys_argument_seen = false;
mkcl_object allow_other_keys_argument_value = mk_cl_Cnil;
if (ARGS[0].narg % 2) mkcl_FEprogram_error(env, "Function ~S received an odd number of arguments for &key", 1, fname);
do {
const mkcl_object keyword = mkcl_va_arg(ARGS);
const mkcl_object value = mkcl_va_arg(ARGS);
if (keyword == key_arg_symbol)
{
if (!key_arg_seen)
{ *key_var_ref = value; key_arg_seen = true; }
}
else if (keyword == @':allow-other-keys')
{
if (!allow_other_keys_argument_seen)
{ allow_other_keys_argument_value = value; allow_other_keys_argument_seen = true; }
}
else if (!extra_would_be_keyword_seen)
{ extra_would_be_keyword = keyword; extra_would_be_keyword_seen = true; }
} while (ARGS[0].narg > 0);
if (extra_would_be_keyword_seen)
if (!allow_other_keys_argument_seen || (allow_other_keys_argument_value == mk_cl_Cnil))
mkcl_FEprogram_error(env, "In LAMBDA-LIST &KEY part of ~S: expected ~S, instead got ~S.", 3, fname, key_arg_symbol, extra_would_be_keyword);
}
void mkcl_receive_0_keyword_arguments(MKCL, const mkcl_object fname, mkcl_va_list ARGS)
{
bool extra_would_be_keyword_seen = false;
mkcl_object extra_would_be_keyword = mk_cl_Cnil;
bool allow_other_keys_argument_seen = false;
mkcl_object allow_other_keys_argument_value = mk_cl_Cnil;
if (ARGS[0].narg % 2) mkcl_FEprogram_error(env, "Function ~S received an odd number of arguments for &key", 1, fname);
do {
const mkcl_object keyword = mkcl_va_arg(ARGS);
const mkcl_object value = mkcl_va_arg(ARGS);
if (keyword == @':allow-other-keys')
{
if (!allow_other_keys_argument_seen)
{ allow_other_keys_argument_value = value; allow_other_keys_argument_seen = true; }
}
else if (!extra_would_be_keyword_seen)
{ extra_would_be_keyword = keyword; extra_would_be_keyword_seen = true; }
} while (ARGS[0].narg > 0);
if (extra_would_be_keyword_seen)
if (!allow_other_keys_argument_seen || (allow_other_keys_argument_value == mk_cl_Cnil))
mkcl_FEprogram_error(env, "In LAMBDA-LIST &KEY part of ~S: expected no keyword, instead got ~S.", 2, fname, extra_would_be_keyword);
}
void mkcl_receive_2_keyword_arguments(MKCL, const mkcl_object fname, mkcl_va_list ARGS, const mkcl_object key1_arg_symbol, mkcl_object * const key1_var_ref, const mkcl_object key2_arg_symbol, mkcl_object * const key2_var_ref)
{
bool key1_arg_seen = false;
bool key2_arg_seen = false;
bool extra_would_be_keyword_seen = false;
mkcl_object extra_would_be_keyword = mk_cl_Cnil;
bool allow_other_keys_argument_seen = false;
mkcl_object allow_other_keys_argument_value = mk_cl_Cnil;
if (ARGS[0].narg % 2) mkcl_FEprogram_error(env, "Function ~S received an odd number of arguments for &key", 1, fname);
do {
const mkcl_object keyword = mkcl_va_arg(ARGS);
const mkcl_object value = mkcl_va_arg(ARGS);
if (keyword == key1_arg_symbol)
{
if (!key1_arg_seen)
{ *key1_var_ref = value; key1_arg_seen = true; }
}
else if (keyword == key2_arg_symbol)
{
if (!key2_arg_seen)
{ *key2_var_ref = value; key2_arg_seen = true; }
}
else if (keyword == @':allow-other-keys')
{
if (!allow_other_keys_argument_seen)
{ allow_other_keys_argument_value = value; allow_other_keys_argument_seen = true; }
}
else if (!extra_would_be_keyword_seen)
{ extra_would_be_keyword = keyword; extra_would_be_keyword_seen = true; }
} while (ARGS[0].narg > 0);
if (extra_would_be_keyword_seen)
if (!allow_other_keys_argument_seen || (allow_other_keys_argument_value == mk_cl_Cnil))
mkcl_FEprogram_error(env, "In LAMBDA-LIST &KEY part of ~S: expected ~S or ~S, instead got ~S.", 4, fname, key1_arg_symbol, key2_arg_symbol, extra_would_be_keyword);
}
void mkcl_receive_3_keyword_arguments(MKCL, const mkcl_object fname, mkcl_va_list ARGS, const mkcl_object key1_arg_symbol, mkcl_object * const key1_var_ref, const mkcl_object key2_arg_symbol, mkcl_object * const key2_var_ref, const mkcl_object key3_arg_symbol, mkcl_object * const key3_var_ref)
{
bool key1_arg_seen = false;
bool key2_arg_seen = false;
bool key3_arg_seen = false;
bool extra_would_be_keyword_seen = false;
mkcl_object extra_would_be_keyword = mk_cl_Cnil;
bool allow_other_keys_argument_seen = false;
mkcl_object allow_other_keys_argument_value = mk_cl_Cnil;
if (ARGS[0].narg % 2) mkcl_FEprogram_error(env, "Function ~S received an odd number of arguments for &key", 1, fname);
do {
const mkcl_object keyword = mkcl_va_arg(ARGS);
const mkcl_object value = mkcl_va_arg(ARGS);
if (keyword == key1_arg_symbol)
{
if (!key1_arg_seen)
{ *key1_var_ref = value; key1_arg_seen = true; }
}
else if (keyword == key2_arg_symbol)
{
if (!key2_arg_seen)
{ *key2_var_ref = value; key2_arg_seen = true; }
}
else if (keyword == key3_arg_symbol)
{
if (!key3_arg_seen)
{ *key3_var_ref = value; key3_arg_seen = true; }
}
else if (keyword == @':allow-other-keys')
{
if (!allow_other_keys_argument_seen)
{ allow_other_keys_argument_value = value; allow_other_keys_argument_seen = true; }
}
else if (!extra_would_be_keyword_seen)
{ extra_would_be_keyword = keyword; extra_would_be_keyword_seen = true; }
} while (ARGS[0].narg > 0);
if (extra_would_be_keyword_seen)
if (!allow_other_keys_argument_seen || (allow_other_keys_argument_value == mk_cl_Cnil))
mkcl_FEprogram_error(env, "In LAMBDA-LIST &KEY part of ~S: expected ~S or ~S or ~S, instead got ~S.", 5, fname, key1_arg_symbol, key2_arg_symbol, key3_arg_symbol, extra_would_be_keyword);
}
void mkcl_receive_4_keyword_arguments(MKCL, const mkcl_object fname, mkcl_va_list ARGS, const mkcl_object key1_arg_symbol, mkcl_object * const key1_var_ref, const mkcl_object key2_arg_symbol, mkcl_object * const key2_var_ref, const mkcl_object key3_arg_symbol, mkcl_object * const key3_var_ref, const mkcl_object key4_arg_symbol, mkcl_object * const key4_var_ref)
{
bool key1_arg_seen = false;
bool key2_arg_seen = false;
bool key3_arg_seen = false;
bool key4_arg_seen = false;
bool extra_would_be_keyword_seen = false;
mkcl_object extra_would_be_keyword = mk_cl_Cnil;
bool allow_other_keys_argument_seen = false;
mkcl_object allow_other_keys_argument_value = mk_cl_Cnil;
if (ARGS[0].narg % 2) mkcl_FEprogram_error(env, "Function ~S received an odd number of arguments for &key", 1, fname);
do {
const mkcl_object keyword = mkcl_va_arg(ARGS);
const mkcl_object value = mkcl_va_arg(ARGS);
if (keyword == key1_arg_symbol)
{
if (!key1_arg_seen)
{ *key1_var_ref = value; key1_arg_seen = true; }
}
else if (keyword == key2_arg_symbol)
{
if (!key2_arg_seen)
{ *key2_var_ref = value; key2_arg_seen = true; }
}
else if (keyword == key3_arg_symbol)
{
if (!key3_arg_seen)
{ *key3_var_ref = value; key3_arg_seen = true; }
}
else if (keyword == key4_arg_symbol)
{
if (!key4_arg_seen)
{ *key4_var_ref = value; key4_arg_seen = true; }
}
else if (keyword == @':allow-other-keys')
{
if (!allow_other_keys_argument_seen)
{ allow_other_keys_argument_value = value; allow_other_keys_argument_seen = true; }
}
else if (!extra_would_be_keyword_seen)
{ extra_would_be_keyword = keyword; extra_would_be_keyword_seen = true; }
} while (ARGS[0].narg > 0);
if (extra_would_be_keyword_seen)
if (!allow_other_keys_argument_seen || (allow_other_keys_argument_value == mk_cl_Cnil))
mkcl_FEprogram_error(env, "In LAMBDA-LIST &KEY part of ~S: expected ~S or ~S or ~S or ~S, instead got ~S.", 6, fname, key1_arg_symbol, key2_arg_symbol, key3_arg_symbol, key4_arg_symbol, extra_would_be_keyword);
}
void mkcl_receive_N_keyword_arguments(MKCL, const mkcl_object fname, mkcl_va_list ARGS, const long key_param_count, struct mkcl_key_param_spec key_params[])
{
bool extra_would_be_keyword_seen = false;
mkcl_object extra_would_be_keyword = mk_cl_Cnil;
bool allow_other_keys_argument_seen = false;
mkcl_object allow_other_keys_argument_value = mk_cl_Cnil;
long i;
if (ARGS[0].narg % 2) mkcl_FEprogram_error(env, "Function ~S received an odd number of arguments for &key", 1, fname);
do {
const mkcl_object keyword = mkcl_va_arg(ARGS);
const mkcl_object value = mkcl_va_arg(ARGS);
for (i = 0; i < key_param_count; i++)
{
if (keyword == key_params[i].key_symbol)
if (!key_params[i].key_arg_seen)
{ *(key_params[i].key_var_ref) = value; key_params[i].key_arg_seen = true; goto NEXT_ARG; }
}
if (keyword == @':allow-other-keys')
{
if (!allow_other_keys_argument_seen)
{ allow_other_keys_argument_value = value; allow_other_keys_argument_seen = true; }
}
else if (!extra_would_be_keyword_seen)
{ extra_would_be_keyword = keyword; extra_would_be_keyword_seen = true; }
NEXT_ARG:;
} while (ARGS[0].narg > 0);
if (extra_would_be_keyword_seen)
if (!allow_other_keys_argument_seen || (allow_other_keys_argument_value == mk_cl_Cnil))
{
mkcl_object key_list = mk_cl_Cnil;
for (i = 0; i < key_param_count; i++) key_list = mkcl_cons(env, key_params[i].key_symbol, key_list);
mkcl_FEprogram_error(env, "In LAMBDA-LIST &KEY part of ~S: expected one of ~S, instead got ~S.", 3, fname, key_list, extra_would_be_keyword);
}
}
static mkcl_object convert_cmp_lexical_info(MKCL, mkcl_object cmp_env)
{
mkcl_object lex_env = mk_cl_Cnil;
......
......@@ -4,7 +4,7 @@
*/
/*
Copyright (c) 2001, Juan Jose Garcia Ripoll.
Copyright (c) 2012-2014, Jean-Claude Beaudoin.
Copyright (c) 2012-2014,2021, Jean-Claude Beaudoin.
MKCL is free software; you can redistribute it and/or
modify it under the terms of the GNU Lesser General Public
......@@ -2410,42 +2410,49 @@ c_listA(MKCL, mkcl_object args, int flags)
/*
Handles special declarations, removes declarations from body
*/
@(defun si::process_declarations (body &optional doc)
mkcl_object documentation = mk_cl_Cnil, declarations = mk_cl_Cnil, specials = mk_cl_Cnil;
mkcl_object decls, vars, v;
@
/* BEGIN: SEARCH DECLARE */
for (; !mkcl_endp(env, body); body = MKCL_CONS_CDR(body)) {
mkcl_object form = MKCL_CONS_CAR(body);
if (!mkcl_Null(doc) && MKCL_STRINGP(form) && !mkcl_endp(env, MKCL_CDR(body))) {
if (documentation == mk_cl_Cnil)
documentation = form;
else
break;
continue;
}
mkcl_object mk_si_process_declarations(MKCL, mkcl_narg narg, mkcl_object body, ...)
{
mkcl_call_stack_check(env);
{
if (MKCL_ATOM(form) || (MKCL_CONS_CAR(form) != @'declare'))
break;
for (decls = MKCL_CONS_CDR(form); !mkcl_endp(env, decls); decls = MKCL_CONS_CDR(decls)) {
mkcl_object sentence = MKCL_CONS_CAR(decls);
if (MKCL_ATOM(sentence))
mkcl_FEill_formed_input(env);
push(env, sentence, declarations);
if (MKCL_CONS_CAR(sentence) == @'special')
for (vars = MKCL_CONS_CDR(sentence); !mkcl_endp(env, vars); vars = MKCL_CONS_CDR(vars)) {
v = MKCL_CONS_CAR(vars);
mkcl_assert_type_symbol(env, v);
push(env, v,specials);
}
}
}
/* END: SEARCH DECLARE */
mkcl_object documentation = mk_cl_Cnil, declarations = mk_cl_Cnil, specials = mk_cl_Cnil;
mkcl_object decls, vars, v;
mkcl_object doc = mk_cl_Cnil;
MKCL_RECEIVE_1_OPTIONAL_ARGUMENT(env, @'si::process-declarations', narg, 1, body, &doc);
/* BEGIN: SEARCH DECLARE */
for (; !mkcl_endp(env, body); body = MKCL_CONS_CDR(body)) {
mkcl_object form = MKCL_CONS_CAR(body);
if (!mkcl_Null(doc) && MKCL_STRINGP(form) && !mkcl_endp(env, MKCL_CDR(body))) {
if (documentation == mk_cl_Cnil)
documentation = form;
else
break;
continue;
}
if (MKCL_ATOM(form) || (MKCL_CONS_CAR(form) != @'declare'))
break;
for (decls = MKCL_CONS_CDR(form); !mkcl_endp(env, decls); decls = MKCL_CONS_CDR(decls)) {
mkcl_object sentence = MKCL_CONS_CAR(decls);
if (MKCL_ATOM(sentence))
mkcl_FEill_formed_input(env);
push(env, sentence, declarations);
if (MKCL_CONS_CAR(sentence) == @'special')
for (vars = MKCL_CONS_CDR(sentence); !mkcl_endp(env, vars); vars = MKCL_CONS_CDR(vars)) {
v = MKCL_CONS_CAR(vars);
mkcl_assert_type_symbol(env, v);
push(env, v,specials);
}
}
}
/* END: SEARCH DECLARE */
mkcl_return_4_values(declarations, body, documentation, specials)
@)
mkcl_return_4_values(declarations, body, documentation, specials);
}
}
#if 0
static size_t mk_si_process_lambda_ctr = 0;
......@@ -2902,65 +2909,69 @@ mk_si_make_lambda(MKCL, mkcl_object name, mkcl_object rest)
mkcl_return_value(lambda);
}
@(defun si::eval-in-env (form
&optional
(lex_env mk_cl_Cnil)
(stepping mk_cl_Cnil)
(compiler_env_p mk_cl_Cnil)
(execute mk_cl_Ct))
volatile mkcl_compiler_env_ptr old_c_env;
struct mkcl_compiler_env new_c_env;
volatile mkcl_index handle;
mkcl_object bytecode = mk_cl_Cnil, interpreter_env, compiler_env;
mkcl_env the_env;
@
the_env = env;
/*
* Compile to bytecode.
*/
if (compiler_env_p == mk_cl_Cnil) {
interpreter_env = lex_env;
compiler_env = mk_cl_Cnil;
} else {
interpreter_env = mk_cl_Cnil;
compiler_env = lex_env;