Commit 38d7fe2f authored by Jean-Claude Beaudoin's avatar Jean-Claude Beaudoin
Browse files

Replace instances of &rest with their C expansion. Step toward retirement of dpp.

parent ac3b64c1
......@@ -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) 2011-2017, Jean-Claude Beaudoin.
Copyright (c) 2011-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
......@@ -192,8 +192,11 @@ mk_si_row_major_aset(MKCL, mkcl_object x, mkcl_object indx, mkcl_object val)
mkcl_return_value(mkcl_aset_index(env, x, j, val));
}
@(defun array-row-major-index (x &rest indx)
@
mkcl_object mk_cl_array_row_major_index(MKCL, const mkcl_narg narg, mkcl_object x, ...)
{
mkcl_call_stack_check(env);
{
mkcl_setup_for_rest(env, @'array-row-major-index', 1, narg, x, indx);
{
mkcl_index i, j;
mkcl_index r = narg - 1;
......@@ -233,7 +236,8 @@ mk_si_row_major_aset(MKCL, mkcl_object x, mkcl_object indx, mkcl_object val)
/* By construction, "j" is a valid array index and should thus be within the range of fixnum. */
mkcl_return_value(MKCL_MAKE_FIXNUM(j));
}
@)
}
}
mkcl_index mkcl_array_row_major_index_2_t(MKCL, mkcl_object a, mkcl_object i, mkcl_object j)
{
......@@ -297,8 +301,11 @@ mkcl_index mkcl_array_row_major_index_3_t(MKCL, mkcl_object a, mkcl_object i, mk
}
}
@(defun aref (x &rest indx)
@
mkcl_object mk_cl_aref(MKCL, const mkcl_narg narg, mkcl_object x, ...)
{
mkcl_call_stack_check(env);
{
mkcl_setup_for_rest(env, @'aref', 1, narg, x, indx);
{
mkcl_index i, j;
mkcl_index r = narg - 1;
......@@ -337,7 +344,9 @@ mkcl_index mkcl_array_row_major_index_3_t(MKCL, mkcl_object a, mkcl_object i, mk
mkcl_va_end(indx);
mkcl_return_value(mkcl_aref_index(env, x, j));
}
@)
}
}
mkcl_object
mkcl_aref(MKCL, mkcl_object x, mkcl_object index)
......@@ -373,8 +382,11 @@ mkcl_vref(MKCL, mkcl_object v, mkcl_object index)
(si:aset value array dim0 ... dimN)
*/
@(defun si::aset (v x &rest dims)
@
mkcl_object mk_si_aset(MKCL, const mkcl_narg narg, mkcl_object v, mkcl_object x, ...)
{
mkcl_call_stack_check(env);
{
mkcl_setup_for_rest(env, @'si::aset', 2, narg, x, dims);
{
mkcl_index i, j;
mkcl_index r = narg - 2;
......@@ -413,7 +425,8 @@ mkcl_vref(MKCL, mkcl_object v, mkcl_object index)
mkcl_va_end(dims);
mkcl_return_value(mkcl_aset_index(env, x, j, v));
}
@)
}
}
mkcl_index mkcl_ensure_index_for_array_row_major_index(MKCL, mkcl_index i, mkcl_index dim)
{
......
......@@ -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
......@@ -486,9 +486,12 @@ mkcl_clone_cclosure(MKCL, mkcl_object c0, mkcl_object new_cenv)
must be twin closures (ie: they were closed over the same environment).
Any other object will be passed through as is to the value list without any cloning.
*/
@(defun si::clone-closure (&rest args)
mkcl_object mk_si_clone_closure(MKCL, mkcl_narg narg, ...)
{
mkcl_call_stack_check(env);
{
mkcl_object head = mk_cl_Cnil;
@
mkcl_setup_for_rest(env, @'si::clone-closure', 0, narg, narg, args);
{
mkcl_object tail;
mkcl_object c0;
......@@ -554,7 +557,8 @@ mkcl_clone_cclosure(MKCL, mkcl_object c0, mkcl_object new_cenv)
}
mkcl_va_end(args);
mkcl_return_value(head);
@)
}
}
mkcl_object
mk_si_closure_siblings_p(MKCL, mkcl_object c1, mkcl_object c2)
......
......@@ -5,7 +5,7 @@
/*
Copyright (c) 1984, Taiichi Yuasa and Masami Hagiya.
Copyright (c) 1990, Giuseppe Attardi.
Copyright (c) 2012-2019, Jean-Claude Beaudoin.
Copyright (c) 2012-2019,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
......@@ -156,15 +156,20 @@ mk_cl_alphanumericp(MKCL, mkcl_object c)
mkcl_return_value((mkcl_alphanumericp(i) ? mk_cl_Ct : mk_cl_Cnil));
}
@(defun char= (c &rest cs)
@
mkcl_object mk_cl_charE(MKCL, mkcl_narg narg, mkcl_object c, ...)
{
mkcl_call_stack_check(env);
{
mkcl_setup_for_rest(env, @'char=', 1, narg, c, cs);
/* INV: mkcl_char_eq() checks types of `c' and `cs' */
while (--narg)
if (!mkcl_char_eq(env, c, mkcl_va_arg(cs)))
{ mkcl_va_end(cs); mkcl_return_value(mk_cl_Cnil); }
mkcl_va_end(cs);
mkcl_return_value(mk_cl_Ct);
@)
}
}
bool
mkcl_char_eq(MKCL, mkcl_object x, mkcl_object y)
......@@ -172,10 +177,15 @@ mkcl_char_eq(MKCL, mkcl_object x, mkcl_object y)
return mkcl_char_code(env, x) == mkcl_char_code(env, y);
}
@(defun char/= (&rest cs)
mkcl_object mk_cl_charNE(MKCL, const mkcl_narg narg, ...)
{
int i, j;
mkcl_object c;
@
mkcl_call_stack_check(env);
{
mkcl_setup_for_rest(env, @'char=', 0, narg, narg, cs);
/* INV: mkcl_char_eq() checks types of its arguments */
if (narg == 0)
mkcl_FEwrong_num_arguments(env, @'char/=', 1, -1, 0);
......@@ -191,7 +201,8 @@ mkcl_char_eq(MKCL, mkcl_object x, mkcl_object y)
}
mkcl_va_end(cs);
mkcl_return_value(mk_cl_Ct);
@)
}
}
static mkcl_object
Lchar_cmp(MKCL, mkcl_narg narg, int s, int t, mkcl_va_list args)
......@@ -218,37 +229,61 @@ mkcl_char_cmp(MKCL, mkcl_object x, mkcl_object y)
return mkcl_char_code(env, x) - mkcl_char_code(env, y);
}
@(defun char< (&rest args)
@
mkcl_object mk_cl_charL(MKCL, const mkcl_narg narg, ...)
{
mkcl_call_stack_check(env);
{
mkcl_setup_for_rest(env, @'char<', 0, narg, narg, args);
mkcl_object val = Lchar_cmp(env, narg, 1, 1, args);
mkcl_va_end(args);
return val;
@)
}
}
@(defun char> (&rest args)
@
mkcl_object val = Lchar_cmp(env, narg,-1, 1, args);
mkcl_object mk_cl_charG(MKCL, const mkcl_narg narg, ...)
{
mkcl_call_stack_check(env);
{
mkcl_setup_for_rest(env, @'char>', 0, narg, narg, args);
mkcl_object val = Lchar_cmp(env, narg, -1, 1, args);
mkcl_va_end(args);
return val;
@)
}
}
mkcl_object mk_cl_charLE(MKCL, const mkcl_narg narg, ...)
{
mkcl_call_stack_check(env);
{
mkcl_setup_for_rest(env, @'char<=', 0, narg, narg, args);
@(defun char<= (&rest args)
@
mkcl_object val = Lchar_cmp(env, narg, 1, 0, args);
mkcl_va_end(args);
return val;
@)
}
}
@(defun char>= (&rest args)
@
mkcl_object val = Lchar_cmp(env, narg,-1, 0, args);
mkcl_object mk_cl_charGE(MKCL, const mkcl_narg narg, ...)
{
mkcl_call_stack_check(env);
{
mkcl_setup_for_rest(env, @'char>=', 0, narg, narg, args);
mkcl_object val = Lchar_cmp(env, narg, -1, 0, args);
mkcl_va_end(args);
return val;
@)
}
}
mkcl_object mk_cl_char_equal(MKCL, mkcl_narg narg, mkcl_object c, ...)
{
mkcl_narg i;
mkcl_call_stack_check(env);
{
mkcl_setup_for_rest(env, @'char-equal', 1, narg, c, cs);
@(defun char_equal (c &rest cs)
int i;
@
/* INV: mkcl_char_equal() checks the type of its arguments */
for (narg--, i = 0; i < narg; i++) {
if (!mkcl_char_equal(env, c, mkcl_va_arg(cs)))
......@@ -256,7 +291,8 @@ mkcl_char_cmp(MKCL, mkcl_object x, mkcl_object y)
}
mkcl_va_end(cs);
mkcl_return_value(mk_cl_Ct);
@)
}
}
#define char_equal_code(e, x) mkcl_char_upcase(mkcl_char_code(e, x))
......@@ -266,10 +302,14 @@ mkcl_char_equal(MKCL, mkcl_object x, mkcl_object y)
return char_equal_code(env, x) == char_equal_code(env, y);
}
@(defun char-not-equal (&rest cs)
mkcl_object mk_cl_char_not_equal(MKCL, mkcl_narg narg, ...)
{
int i, j;
mkcl_object c;
@
mkcl_call_stack_check(env);
{
mkcl_setup_for_rest(env, @'char-not-equal', 0, narg, narg, cs);
/* INV: mkcl_char_equal() checks the type of its arguments */
if (narg == 0)
mkcl_FEwrong_num_arguments(env, @'char-not-equal', 1, -1, narg);
......@@ -285,7 +325,8 @@ mkcl_char_equal(MKCL, mkcl_object x, mkcl_object y)
}
mkcl_va_end(cs);
mkcl_return_value(mk_cl_Ct);
@)
}
}
static mkcl_object
Lchar_compare(MKCL, mkcl_narg narg, int s, int t, mkcl_va_list args)
......@@ -318,33 +359,53 @@ mkcl_char_compare(MKCL, mkcl_object x, mkcl_object y)
return(1);
}
@(defun char-lessp (&rest args)
@
mkcl_object mk_cl_char_lessp(MKCL, mkcl_narg narg, ...)
{
mkcl_call_stack_check(env);
{
mkcl_setup_for_rest(env, @'char-lessp', 0, narg, narg, args);
mkcl_object val = Lchar_compare(env, narg, 1, 1, args);
mkcl_va_end(args);
return val;
@)
}
}
mkcl_object mk_cl_char_greaterp(MKCL, mkcl_narg narg, ...)
{
mkcl_call_stack_check(env);
{
mkcl_setup_for_rest(env, @'char-greaterp', 0, narg, narg, args);
@(defun char-greaterp (&rest args)
@
mkcl_object val = Lchar_compare(env, narg,-1, 1, args);
mkcl_va_end(args);
return val;
@)
}
}
mkcl_object mk_cl_char_not_greaterp(MKCL, mkcl_narg narg, ...)
{
mkcl_call_stack_check(env);
{
mkcl_setup_for_rest(env, @'char-not-greaterp', 0, narg, narg, args);
@(defun char-not-greaterp (&rest args)
@
mkcl_object val = Lchar_compare(env, narg, 1, 0, args);
mkcl_va_end(args);
return val;
@)
}
}
mkcl_object mk_cl_char_not_lessp(MKCL, mkcl_narg narg, ...)
{
mkcl_call_stack_check(env);
{
mkcl_setup_for_rest(env, @'char-not-lessp', 0, narg, narg, args);
@(defun char-not-lessp (&rest args)
@
mkcl_object val = Lchar_compare(env, narg,-1, 0, args);
mkcl_va_end(args);
return val;
@)
}
}
mkcl_object
......
......@@ -5,7 +5,7 @@
/*
Copyright (c) 1990, Giuseppe Attardi.
Copyright (c) 2001, Juan Jose Garcia Ripoll.
Copyright (c) 2011-2014, Jean-Claude Beaudoin.
Copyright (c) 2011-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
......@@ -75,13 +75,18 @@ mk_si_find_relative_package(MKCL, mkcl_object package)
mkcl_return_value(mk_cl_Cnil);
}
@(defun cerror (cformat eformat &rest args)
@
mkcl_object mk_cl_cerror(MKCL, mkcl_narg narg, mkcl_object cformat, mkcl_object eformat, ...)
{
mkcl_call_stack_check(env);
{
mkcl_setup_for_rest(env, @'cerror', 2, narg, eformat, args);
const mkcl_object rest = mkcl_grab_rest_args(env, args, FALSE);
mkcl_va_end(args);
mkcl_object val = mk_cl_apply(env, 3, @+'error', eformat, rest);
mkcl_return_value(val);
@)
}
}
static mkcl_object mk_si_simple_toplevel(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-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
......@@ -547,14 +547,19 @@ mkcl_FEwin32_stream_error(MKCL, mkcl_object stream, const char *msg, int narg, .
* Higher level interface to errors *
************************************/
@(defun error (datum &rest args)
@
mkcl_object mk_cl_error(MKCL, mkcl_narg narg, mkcl_object datum, ...)
{
mkcl_call_stack_check(env);
{
mkcl_setup_for_rest(env, @'error', 1, narg, datum, args);
mkcl_object rest = mkcl_grab_rest_args(env, args, FALSE);
mkcl_va_end(args);
mkcl_funcall2(env, @+'si::universal-error-handler', datum, rest);
mkcl_lose(env, "Should not have returned from universal-error-handler");
@)
}
}
void
......
......@@ -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-2012, Jean-Claude Beaudoin.
Copyright (c) 2010-2012,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
......@@ -125,8 +125,12 @@ mk_cl_funcall(MKCL, mkcl_narg narg, mkcl_object function, ...)
return output;
}
@(defun apply (fun lastarg &rest args)
@
mkcl_object mk_cl_apply(MKCL, mkcl_narg narg, mkcl_object fun, mkcl_object lastarg, ...)
{
mkcl_call_stack_check(env);
{
mkcl_setup_for_rest(env, @'apply', 2, narg, lastarg, args);
if (narg == 2 && mkcl_type_of(lastarg) == mkcl_t_temp_stack_frame) {
{
mkcl_object *sp = lastarg->frame.base;
......@@ -254,7 +258,8 @@ mk_cl_funcall(MKCL, mkcl_narg narg, mkcl_object function, ...)
mkcl_va_end(args);
return out;
}
@)
}
}
mkcl_object
mk_cl_eval(MKCL, mkcl_object form)
......
......@@ -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
......@@ -2272,10 +2272,15 @@ static const struct mkcl_file_ops broadcast_ops = {
generic_close
};
@(defun make_broadcast_stream (&rest ap)
mkcl_object mk_cl_make_broadcast_stream(MKCL, mkcl_narg narg, ...)
{
mkcl_object x, streams;
int i;
@
mkcl_call_stack_check(env);
{
mkcl_setup_for_rest(env, @'make-broadcast-stream', 0, narg, narg, ap);
streams = mk_cl_Cnil;
for (i = 0; i < narg; i++) {
x = mkcl_va_arg(ap);
......@@ -2294,7 +2299,8 @@ static const struct mkcl_file_ops broadcast_ops = {
x->stream.mode = mkcl_smm_broadcast;
MKCL_BROADCAST_STREAM_LIST(x) = mk_cl_nreverse(env, streams);
mkcl_return_value(x);
@)
}
}
mkcl_object
mk_cl_broadcast_stream_streams(MKCL, mkcl_object strm)
......@@ -2589,10 +2595,15 @@ static const struct mkcl_file_ops concatenated_ops = {
generic_close
};
@(defun make_concatenated_stream (&rest ap)
mkcl_object mk_cl_make_concatenated_stream(MKCL, mkcl_narg narg, ...)
{
mkcl_object x, streams;
int i;
@
mkcl_call_stack_check(env);
{
mkcl_setup_for_rest(env, @'make-concatenated-stream', 0, narg, narg, ap);
streams = mk_cl_Cnil;
for (i = 0; i < narg; i++) {
x = mkcl_va_arg(ap);
......@@ -2611,7 +2622,8 @@ static const struct mkcl_file_ops concatenated_ops = {
x->stream.ops = duplicate_dispatch_table(env, &concatenated_ops);
MKCL_CONCATENATED_STREAM_LIST(x) = mk_cl_nreverse(env, streams);
mkcl_return_value(x);
@)
}
}
mkcl_object
mk_cl_concatenated_stream_streams(MKCL, mkcl_object strm)
......
......@@ -5,7 +5,7 @@
/*
Copyright (c) 1984, Taiichi Yuasa and Masami Hagiya.
Copyright (c) 1990, Giuseppe Attardi.
Copyright (c) 2001, Juan Jose Garcia Ripoll.
Copyright (c) 2001,2021 Juan Jose Garcia Ripoll.
MKCL is free software; you can redistribute it and/or
modify it under the terms of the GNU Lesser General Public
......@@ -17,10 +17,15 @@
#include <mkcl/mkcl.h>
@(defun format (strm string &rest args)
mkcl_object mk_cl_format(MKCL, mkcl_narg narg, mkcl_object strm, mkcl_object string, ...)
{
mkcl_object output = mk_cl_Cnil;
int null_strm = 0;
@
mkcl_call_stack_check(env);
{
mkcl_setup_for_rest(env, @'format', 2, narg, string, args);
if (mkcl_Null(strm)) {
strm = mkcl_alloc_adjustable_character_string(env, 64);
null_strm = 1;
......@@ -50,4 +55,5 @@
}
mkcl_va_end(args);
mkcl_return_value(output);
@)
}
}
......@@ -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
......@@ -1288,38 +1288,57 @@ mk_cl_sxhash(MKCL, mkcl_object key)
mkcl_return_value(MKCL_MAKE_FIXNUM(output & mask));
}
@(defun si::hash-eql (&rest args)
mkcl_object mk_si_hash_eql(MKCL, mkcl_narg narg, ...)
{
mkcl_index h;
@
mkcl_call_stack_check(env);
{
mkcl_setup_for_rest(env, @'si::hash-eql', 0, narg, narg, args);
for (h = 0; narg; narg--) {
mkcl_object o = mkcl_va_arg(args);
h = _hash_eql(h, o);
}
mkcl_va_end(args);
mkcl_return_value(MKCL_MAKE_FIXNUM(h))
@)
mkcl_return_value(MKCL_MAKE_FIXNUM(h));
}
}
@(defun si::hash-equal (&rest args)
mkcl_object mk_si_hash_equal(MKCL, mkcl_narg narg, ...)
{
mkcl_index h;
@
mkcl_call_stack_check(env);
{
mkcl_setup_for_rest(env, @'si::hash-equal', 0, narg, narg, args);
for (h = 0; narg; narg--) {
mkcl_object o = mkcl_va_arg(args);
h = _hash_equal(3, h, o);
}
mkcl_va_end(args);
mkcl_return_value(MKCL_MAKE_FIXNUM(h))
@)
mkcl_return_value(MKCL_MAKE_FIXNUM(h));
}
}
@(defun si::hash-equalp (&rest args)
mkcl_object mk_si_hash_equalp(MKCL, mkcl_narg narg, ...)
{
mkcl_index h;
@
mkcl_call_stack_check(env);
{
mkcl_setup_for_rest(env, @'si::hash-equalp', 0, narg, narg, args);
for (h = 0; narg; narg--) {
mkcl_object o = mkcl_va_arg(args);
h = _hash_equalp(env, 3, h, o);
}
mkcl_va_end(args);
mkcl_return_value(MKCL_MAKE_FIXNUM(h));
@)
}
}
mkcl_object
mk_cl_maphash(MKCL, mkcl_object fun, mkcl_object ht)
......
......@@ -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-2012, Jean-Claude Beaudoin
Copyright (c) 2010-2012,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
......@@ -132,9 +132,14 @@ extern inline mkcl_object mk_cl_car(MKCL, mkcl_object x);
extern inline mkcl_object mk_cl_cdr(MKCL, mkcl_object x);