summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--libguile/ChangeLog47
-rw-r--r--libguile/__scm.h12
-rw-r--r--libguile/async.c1
-rw-r--r--libguile/dynl.c44
-rw-r--r--libguile/dynl.h2
-rw-r--r--libguile/eval.c7
-rw-r--r--libguile/filesys.c14
-rw-r--r--libguile/hooks.c2
-rw-r--r--libguile/list.c68
-rw-r--r--libguile/ports.c2
-rw-r--r--libguile/posix.c6
-rw-r--r--libguile/print.c2
-rw-r--r--libguile/ramap.c2
-rw-r--r--libguile/regex-posix.c3
-rw-r--r--libguile/stacks.c22
-rw-r--r--libguile/stacks.h2
-rw-r--r--libguile/strings.c6
-rw-r--r--libguile/struct.c2
-rw-r--r--libguile/throw.c4
-rw-r--r--libguile/unif.c39
-rw-r--r--libguile/unif.h6
-rw-r--r--libguile/validate.h11
22 files changed, 164 insertions, 140 deletions
diff --git a/libguile/ChangeLog b/libguile/ChangeLog
index 1efa6da8d..5a19d3635 100644
--- a/libguile/ChangeLog
+++ b/libguile/ChangeLog
@@ -1,5 +1,52 @@
2000-05-17 Dirk Herrmann <D.Herrmann@tu-bs.de>
+ * __scm.h (SCM_DEBUG_REST_ARGUMENT): Renamed from
+ SCM_DEBUG_REST_ARGUMENTS in order to clarify that we don't test
+ the actual arguments in the list, but rather the rest argument as
+ a list of arguments.
+
+ * validate.h (SCM_VALIDATE_REST_ARGUMENT): Added.
+
+ * async.c (scm_noop), eval.c (scm_map, scm_for_each), list.c
+ (scm_list_star, scm_append, scm_append_x), ports.c
+ (scm_close_all_ports_except), ramap.c (scm_array_map_x,
+ scm_array_for_each), regex-posix.c (scm_make_regexp), stacks.c
+ (scm_make_stack), strings.c (scm_string_append), struct.c
+ (scm_make_struct, scm_make_vtable_vtable): Validate rest arguments.
+
+ * dynl.c (DYNL_GLOBAL, sysdep_dynl_link, kw_global, sym_global,
+ scm_dynamic_link, scm_init_dynamic_linking), dynl.h
+ (scm_dynamic_link): Removed possibility to pass flags to
+ scm_dynamic_link, as it had no effect anyway.
+
+ * filesys.c (scm_fcntl): Made single optional rest argument into
+ a standard optional argument.
+
+ * hooks.c (scm_run_hook): A list of rest arguments is never
+ SCM_UNBNDP.
+
+ * list.c (scm_append, scm_append_x), stacks.c (scm_make_stack),
+ strings.c (scm_string_append): Don't perform half-hearted checks
+ to see whether the rest argument forms a proper list any more, use
+ SCM_VALIDATE_REST_ARGUMENTS instead.
+
+ * ports.c (scm_close_all_ports_except): Accept empty list of rest
+ arguments.
+
+ * posix.c (scm_convert_exec_args), print.c (scm_simple_format):
+ Simplify verification of rest argument.
+
+ * stacks.c (scm_make_stack), stacks.h (scm_make_stack), throw.c
+ (ss_handler, handler_message): Make first mandatory rest argument
+ of scm_make_stack into a standard mandatory argument.
+
+ * unif.c (scm_transpose_array, scm_enclose_array,
+ scm_array_in_bounds_p), unif.h (scm_transpose_array,
+ scm_enclose_array, scm_array_in_bounds_p): Make first mandatory
+ rest argument into a standard mandatory argument.
+
+2000-05-17 Dirk Herrmann <D.Herrmann@tu-bs.de>
+
* __scm.h: Added SCM_DEBUG as default debug option. (Thanks to
Keisuke Nishida for the suggestion.) Added debug option
SCM_DEBUG_REST_ARGUMENTS.
diff --git a/libguile/__scm.h b/libguile/__scm.h
index 6572fd979..fc0f5ab89 100644
--- a/libguile/__scm.h
+++ b/libguile/__scm.h
@@ -167,13 +167,13 @@
#define SCM_DEBUG_DEPRECATED SCM_DEBUG
#endif
-/* If SCM_DEBUG_REST_ARGUMENTS is set to 1, functions that take rest arguments
- * will check whether the rest arguments actually form a proper list.
- * Otherwise it is assumed that the rest arguments form a proper list and only
- * the parameters themselves, which are given as rest arguments, are checked.
+/* If SCM_DEBUG_REST_ARGUMENT is set to 1, functions that take rest arguments
+ * will check whether the rest arguments are actually passed as a proper list.
+ * Otherwise, if SCM_DEBUG_REST_ARGUMENT is 0, functions that take rest
+ * arguments will take it for granted that these are passed as a proper list.
*/
-#ifndef SCM_DEBUG_REST_ARGUMENTS
-#define SCM_DEBUG_REST_ARGUMENTS SCM_DEBUG
+#ifndef SCM_DEBUG_REST_ARGUMENT
+#define SCM_DEBUG_REST_ARGUMENT SCM_DEBUG
#endif
/* Use this for _compile time_ type checking only, since the compiled result
diff --git a/libguile/async.c b/libguile/async.c
index d8b3a71ec..6b264fb17 100644
--- a/libguile/async.c
+++ b/libguile/async.c
@@ -400,6 +400,7 @@ SCM_DEFINE (scm_noop, "noop", 0, 0, 1,
"")
#define FUNC_NAME s_scm_noop
{
+ SCM_VALIDATE_REST_ARGUMENT (args);
return (SCM_NULLP (args) ? SCM_BOOL_F : SCM_CAR (args));
}
#undef FUNC_NAME
diff --git a/libguile/dynl.c b/libguile/dynl.c
index 0ba0b13b8..3e839c32b 100644
--- a/libguile/dynl.c
+++ b/libguile/dynl.c
@@ -232,14 +232,12 @@ SCM_DEFINE (scm_clear_registered_modules, "c-clear-registered-modules", 0, 0, 0,
* is executed, SCM_DEFER_INTS and SCM_ALLOW_INTS do not nest).
*/
-#define DYNL_GLOBAL 0x0001
-
#ifdef DYNAMIC_LINKING
#include <ltdl.h>
static void *
-sysdep_dynl_link (const char *fname, int flags, const char *subr)
+sysdep_dynl_link (const char *fname, const char *subr)
{
lt_dlhandle handle;
handle = lt_dlopenext (fname);
@@ -298,9 +296,7 @@ no_dynl_error (const char *subr)
}
static void *
-sysdep_dynl_link (const char *filename,
- int flags,
- const char *subr)
+sysdep_dynl_link (const char *filename, const char *subr)
{
no_dynl_error (subr);
return NULL;
@@ -348,47 +344,18 @@ print_dynl_obj (SCM exp,SCM port,scm_print_state *pstate)
return 1;
}
-static SCM kw_global;
-SCM_SYMBOL (sym_global, "-global");
-SCM_DEFINE (scm_dynamic_link, "dynamic-link", 1, 0, 1,
- (SCM fname, SCM rest),
+SCM_DEFINE (scm_dynamic_link, "dynamic-link", 1, 0, 0,
+ (SCM fname),
"Open the dynamic library @var{library-file}. A library handle\n"
"representing the opened library is returned; this handle should be used\n"
"as the @var{lib} argument to the following functions.")
#define FUNC_NAME s_scm_dynamic_link
{
void *handle;
- int flags = DYNL_GLOBAL;
SCM_COERCE_ROSTRING (1, fname);
-
- /* collect flags */
- while (SCM_CONSP (rest))
- {
- SCM kw, val;
-
- kw = SCM_CAR (rest);
- rest = SCM_CDR (rest);
-
- if (!SCM_CONSP (rest))
- SCM_MISC_ERROR ("keyword without value", SCM_EOL);
-
- val = SCM_CAR (rest);
- rest = SCM_CDR (rest);
-
- if (SCM_EQ_P (kw, kw_global))
- {
- if (SCM_FALSEP (val))
- flags &= ~DYNL_GLOBAL;
- }
- else
- SCM_MISC_ERROR ("unknown keyword argument: ~A",
- scm_cons (kw, SCM_EOL));
- }
-
- handle = sysdep_dynl_link (SCM_CHARS (fname), flags, FUNC_NAME);
-
+ handle = sysdep_dynl_link (SCM_CHARS (fname), FUNC_NAME);
SCM_RETURN_NEWSMOB2 (scm_tc16_dynamic_obj, SCM_UNPACK (fname), handle);
}
#undef FUNC_NAME
@@ -549,7 +516,6 @@ scm_init_dynamic_linking ()
scm_set_smob_print (scm_tc16_dynamic_obj, print_dynl_obj);
sysdep_dynl_init ();
#include "libguile/dynl.x"
- kw_global = scm_make_keyword_from_dash_symbol (sym_global);
}
/*
diff --git a/libguile/dynl.h b/libguile/dynl.h
index 69b2ae8ae..4fbf4e9cd 100644
--- a/libguile/dynl.h
+++ b/libguile/dynl.h
@@ -51,7 +51,7 @@ void scm_register_module_xxx (char *module_name, void *init_func);
SCM scm_registered_modules (void);
SCM scm_clear_registered_modules (void);
-SCM scm_dynamic_link (SCM fname, SCM rest);
+SCM scm_dynamic_link (SCM fname);
SCM scm_dynamic_unlink (SCM dobj);
SCM scm_dynamic_object_p (SCM obj);
SCM scm_dynamic_func (SCM symb, SCM dobj);
diff --git a/libguile/eval.c b/libguile/eval.c
index 0fa22172c..ebbf5f8d0 100644
--- a/libguile/eval.c
+++ b/libguile/eval.c
@@ -3575,6 +3575,7 @@ SCM_GPROC (s_map, "map", 2, 0, 1, scm_map, g_map);
SCM
scm_map (SCM proc, SCM arg1, SCM args)
+#define FUNC_NAME s_map
{
long i, len;
SCM res = SCM_EOL;
@@ -3584,6 +3585,7 @@ scm_map (SCM proc, SCM arg1, SCM args)
len = scm_ilength (arg1);
SCM_GASSERTn (len >= 0,
g_map, scm_cons2 (proc, arg1, args), SCM_ARG2, s_map);
+ SCM_VALIDATE_REST_ARGUMENT (args);
if (SCM_NULLP (args))
{
while (SCM_NIMP (arg1))
@@ -3614,18 +3616,21 @@ scm_map (SCM proc, SCM arg1, SCM args)
pres = SCM_CDRLOC (*pres);
}
}
+#undef FUNC_NAME
SCM_GPROC (s_for_each, "for-each", 2, 0, 1, scm_for_each, g_for_each);
SCM
scm_for_each (SCM proc, SCM arg1, SCM args)
+#define FUNC_NAME s_for_each
{
SCM *ve = &args; /* Keep args from being optimized away. */
long i, len;
len = scm_ilength (arg1);
SCM_GASSERTn (len >= 0, g_for_each, scm_cons2 (proc, arg1, args),
SCM_ARG2, s_for_each);
+ SCM_VALIDATE_REST_ARGUMENT (args);
if SCM_NULLP (args)
{
while SCM_NIMP (arg1)
@@ -3653,7 +3658,7 @@ scm_for_each (SCM proc, SCM arg1, SCM args)
scm_apply (proc, arg1, SCM_EOL);
}
}
-
+#undef FUNC_NAME
SCM
diff --git a/libguile/filesys.c b/libguile/filesys.c
index bb20f5b78..8073225cb 100644
--- a/libguile/filesys.c
+++ b/libguile/filesys.c
@@ -1112,7 +1112,7 @@ SCM_DEFINE (scm_select, "select", 3, 2, 0,
-SCM_DEFINE (scm_fcntl, "fcntl", 2, 0, 1,
+SCM_DEFINE (scm_fcntl, "fcntl", 2, 1, 0,
(SCM object, SCM cmd, SCM value),
"Apply @var{command} to the specified file descriptor or the underlying\n"
"file descriptor of the specified port. @var{value} is an optional\n"
@@ -1153,13 +1153,13 @@ SCM_DEFINE (scm_fcntl, "fcntl", 2, 0, 1,
SCM_VALIDATE_INUM (1,object);
fdes = SCM_INUM (object);
}
- if (SCM_NULLP (value))
+
+ if (SCM_UNBNDP (value)) {
ivalue = 0;
- else
- {
- SCM_ASSERT (SCM_INUMP (SCM_CAR (value)), value, SCM_ARG3, FUNC_NAME);
- ivalue = SCM_INUM (SCM_CAR (value));
- }
+ } else {
+ SCM_VALIDATE_INUM_COPY (SCM_ARG3, value, ivalue);
+ }
+
SCM_SYSCALL (rv = fcntl (fdes, SCM_INUM (cmd), ivalue));
if (rv == -1)
SCM_SYSERROR;
diff --git a/libguile/hooks.c b/libguile/hooks.c
index 413648cb8..7ec54766e 100644
--- a/libguile/hooks.c
+++ b/libguile/hooks.c
@@ -310,8 +310,6 @@ SCM_DEFINE (scm_run_hook, "run-hook", 1, 0, 1,
#define FUNC_NAME s_scm_run_hook
{
SCM_VALIDATE_HOOK (1,hook);
- if (SCM_UNBNDP (args))
- args = SCM_EOL;
if (scm_ilength (args) != SCM_HOOK_ARITY (hook))
SCM_MISC_ERROR ("Hook ~S requires ~A arguments",
SCM_LIST2 (hook,SCM_MAKINUM (SCM_HOOK_ARITY (hook))));
diff --git a/libguile/list.c b/libguile/list.c
index 35e6bdc1f..d31d90c01 100644
--- a/libguile/list.c
+++ b/libguile/list.c
@@ -94,7 +94,8 @@ SCM_DEFINE (scm_list_star, "list*", 1, 0, 1,
"Return an improper list of the arguments.")
#define FUNC_NAME s_scm_list_star
{
- if (SCM_NNULLP (rest))
+ SCM_VALIDATE_REST_ARGUMENT (rest);
+ if (!SCM_NULLP (rest))
{
SCM prev = arg = scm_cons (arg, rest);
while (SCM_NNULLP (SCM_CDR (rest)))
@@ -196,28 +197,27 @@ SCM_DEFINE (scm_append, "append", 0, 0, 1,
" (append '() 'a) => a\n")
#define FUNC_NAME s_scm_append
{
- SCM res = SCM_EOL;
- SCM *lloc = &res, arg;
- if (SCM_IMP(args)) {
- SCM_VALIDATE_NULL (SCM_ARGn, args);
+ SCM_VALIDATE_REST_ARGUMENT (args);
+ if (SCM_NULLP (args)) {
+ return SCM_EOL;
+ } else {
+ SCM res = SCM_EOL;
+ SCM *lloc = &res;
+ SCM arg = SCM_CAR (args);
+ args = SCM_CDR (args);
+ while (!SCM_NULLP (args)) {
+ while (SCM_CONSP (arg)) {
+ *lloc = scm_cons (SCM_CAR (arg), SCM_EOL);
+ lloc = SCM_CDRLOC (*lloc);
+ arg = SCM_CDR (arg);
+ }
+ SCM_VALIDATE_NULL (SCM_ARGn, arg);
+ arg = SCM_CAR (args);
+ args = SCM_CDR (args);
+ };
+ *lloc = arg;
return res;
}
- SCM_VALIDATE_CONS (SCM_ARGn, args);
- while (1) {
- arg = SCM_CAR(args);
- args = SCM_CDR(args);
- if (SCM_IMP(args)) {
- *lloc = arg;
- SCM_VALIDATE_NULL (SCM_ARGn, args);
- return res;
- }
- SCM_VALIDATE_CONS (SCM_ARGn, args);
- for (; SCM_CONSP(arg); arg = SCM_CDR(arg)) {
- *lloc = scm_cons(SCM_CAR(arg), SCM_EOL);
- lloc = SCM_CDRLOC(*lloc);
- }
- SCM_VALIDATE_NULL (SCM_ARGn, arg);
- }
}
#undef FUNC_NAME
@@ -230,16 +230,22 @@ SCM_DEFINE (scm_append_x, "append!", 0, 0, 1,
"performed. Return a pointer to the mutated list.")
#define FUNC_NAME s_scm_append_x
{
- SCM arg;
- tail:
- if (SCM_NULLP(args)) return SCM_EOL;
- arg = SCM_CAR(args);
- args = SCM_CDR(args);
- if (SCM_NULLP(args)) return arg;
- if (SCM_NULLP(arg)) goto tail;
- SCM_VALIDATE_CONS (SCM_ARG1,arg);
- SCM_SETCDR (scm_last_pair (arg), scm_append_x (args));
- return arg;
+ SCM_VALIDATE_REST_ARGUMENT (args);
+ while (1) {
+ if (SCM_NULLP (args)) {
+ return SCM_EOL;
+ } else {
+ SCM arg = SCM_CAR (args);
+ args = SCM_CDR (args);
+ if (SCM_NULLP (args)) {
+ return arg;
+ } else if (!SCM_NULLP (arg)) {
+ SCM_VALIDATE_CONS (SCM_ARG1, arg);
+ SCM_SETCDR (scm_last_pair (arg), scm_append_x (args));
+ return arg;
+ }
+ }
+ }
}
#undef FUNC_NAME
diff --git a/libguile/ports.c b/libguile/ports.c
index 7c3f04508..89a3bd3a3 100644
--- a/libguile/ports.c
+++ b/libguile/ports.c
@@ -675,7 +675,7 @@ SCM_DEFINE (scm_close_all_ports_except, "close-all-ports-except", 0, 0, 1,
#define FUNC_NAME s_scm_close_all_ports_except
{
int i = 0;
- SCM_VALIDATE_CONS (1,ports);
+ SCM_VALIDATE_REST_ARGUMENT (ports);
while (i < scm_port_table_size)
{
SCM thisport = scm_port_table[i]->port;
diff --git a/libguile/posix.c b/libguile/posix.c
index c7451bd3d..fd98dc882 100644
--- a/libguile/posix.c
+++ b/libguile/posix.c
@@ -811,13 +811,11 @@ scm_convert_exec_args (SCM args, int pos, const char *subr)
int num_args;
int i;
- SCM_ASSERT (SCM_NULLP (args)
- || (SCM_CONSP (args)),
- args, pos, subr);
num_args = scm_ilength (args);
+ SCM_ASSERT (num_args >= 0, args, pos, subr);
execargv = (char **)
scm_must_malloc ((num_args + 1) * sizeof (char *), subr);
- for (i = 0; SCM_NNULLP (args); args = SCM_CDR (args), ++i)
+ for (i = 0; !SCM_NULLP (args); args = SCM_CDR (args), ++i)
{
scm_sizet len;
char *dst;
diff --git a/libguile/print.c b/libguile/print.c
index 77782aaf3..a243b4ec0 100644
--- a/libguile/print.c
+++ b/libguile/print.c
@@ -969,7 +969,7 @@ SCM_DEFINE (scm_simple_format, "simple-format", 2, 0, 1,
SCM_VALIDATE_OPORT_VALUE (1,destination);
}
SCM_VALIDATE_STRING(2,message);
- SCM_VALIDATE_LIST(3,args);
+ SCM_VALIDATE_REST_ARGUMENT (args);
start = SCM_ROCHARS (message);
for (p = start; *p != '\0'; ++p)
diff --git a/libguile/ramap.c b/libguile/ramap.c
index 500611b40..cffdd18fa 100644
--- a/libguile/ramap.c
+++ b/libguile/ramap.c
@@ -1520,6 +1520,7 @@ SCM_DEFINE (scm_array_map_x, "array-map!", 2, 0, 1,
#define FUNC_NAME s_scm_array_map_x
{
SCM_VALIDATE_PROC (2,proc);
+ SCM_VALIDATE_REST_ARGUMENT (lra);
switch (SCM_TYP7 (proc))
{
default:
@@ -1666,6 +1667,7 @@ SCM_DEFINE (scm_array_for_each, "array-for-each", 2, 0, 1,
#define FUNC_NAME s_scm_array_for_each
{
SCM_VALIDATE_PROC (1,proc);
+ SCM_VALIDATE_REST_ARGUMENT (lra);
scm_ramapc (rafe, proc, ra0, lra, FUNC_NAME);
return SCM_UNSPECIFIED;
}
diff --git a/libguile/regex-posix.c b/libguile/regex-posix.c
index 9e4ce3ae8..5ca9e3b10 100644
--- a/libguile/regex-posix.c
+++ b/libguile/regex-posix.c
@@ -185,13 +185,14 @@ SCM_DEFINE (scm_make_regexp, "make-regexp", 1, 0, 1,
int status, cflags;
SCM_VALIDATE_ROSTRING (1,pat);
+ SCM_VALIDATE_REST_ARGUMENT (flags);
SCM_COERCE_SUBSTR (pat);
/* Examine list of regexp flags. If REG_BASIC is supplied, then
turn off REG_EXTENDED flag (on by default). */
cflags = REG_EXTENDED;
flag = flags;
- while (SCM_NNULLP (flag))
+ while (!SCM_NULLP (flag))
{
if (SCM_INUM (SCM_CAR (flag)) == REG_BASIC)
cflags &= ~REG_EXTENDED;
diff --git a/libguile/stacks.c b/libguile/stacks.c
index 2114fdaff..17116fc01 100644
--- a/libguile/stacks.c
+++ b/libguile/stacks.c
@@ -412,8 +412,8 @@ SCM_DEFINE (scm_stack_p, "stack?", 1, 0, 0,
}
#undef FUNC_NAME
-SCM_DEFINE (scm_make_stack, "make-stack", 0, 0, 1,
- (SCM args),
+SCM_DEFINE (scm_make_stack, "make-stack", 1, 0, 1,
+ (SCM obj, SCM args),
"")
#define FUNC_NAME s_scm_make_stack
{
@@ -422,12 +422,7 @@ SCM_DEFINE (scm_make_stack, "make-stack", 0, 0, 1,
scm_info_frame *iframe;
long offset = 0;
SCM stack, id;
- SCM obj, inner_cut, outer_cut;
-
- SCM_ASSERT (SCM_CONSP (args),
- SCM_FUNC_NAME, SCM_WNA, NULL);
- obj = SCM_CAR (args);
- args = SCM_CDR (args);
+ SCM inner_cut, outer_cut;
/* Extract a pointer to the innermost frame of whatever object
scm_make_stack was given. */
@@ -473,17 +468,20 @@ SCM_DEFINE (scm_make_stack, "make-stack", 0, 0, 1,
SCM_STACK (stack) -> length = n;
/* Narrow the stack according to the arguments given to scm_make_stack. */
- while (n > 0 && SCM_CONSP (args))
+ SCM_VALIDATE_REST_ARGUMENT (args);
+ while (n > 0 && !SCM_NULLP (args))
{
inner_cut = SCM_CAR (args);
args = SCM_CDR (args);
- if (SCM_CONSP (args))
+ if (SCM_NULLP (args))
+ {
+ outer_cut = SCM_INUM0;
+ }
+ else
{
outer_cut = SCM_CAR (args);
args = SCM_CDR (args);
}
- else
- outer_cut = SCM_INUM0;
narrow_stack (stack,
SCM_INUMP (inner_cut) ? SCM_INUM (inner_cut) : n,
diff --git a/libguile/stacks.h b/libguile/stacks.h
index 2a5ea828d..cbe27bbe4 100644
--- a/libguile/stacks.h
+++ b/libguile/stacks.h
@@ -116,7 +116,7 @@ extern SCM scm_stack_type;
SCM scm_stack_p (SCM obj);
-SCM scm_make_stack (SCM args);
+SCM scm_make_stack (SCM obj, SCM args);
SCM scm_stack_id (SCM stack);
SCM scm_stack_ref (SCM stack, SCM i);
SCM scm_stack_length (SCM stack);
diff --git a/libguile/strings.c b/libguile/strings.c
index 733667d19..70ec6f23f 100644
--- a/libguile/strings.c
+++ b/libguile/strings.c
@@ -308,13 +308,13 @@ SCM_DEFINE (scm_string_append, "string-append", 0, 0, 1,
register long i = 0;
register SCM l, s;
register unsigned char *data;
- for (l = args;SCM_CONSP (l);) {
+
+ SCM_VALIDATE_REST_ARGUMENT (args);
+ for (l = args; !SCM_NULLP (l); l = SCM_CDR (l)) {
s = SCM_CAR (l);
SCM_VALIDATE_ROSTRING (SCM_ARGn,s);
i += SCM_ROLENGTH (s);
- l = SCM_CDR (l);
}
- SCM_ASSERT (SCM_NULLP (l), args, SCM_ARGn, FUNC_NAME);
res = scm_makstr (i, 0);
data = SCM_UCHARS (res);
for (l = args;SCM_NIMP (l);l = SCM_CDR (l)) {
diff --git a/libguile/struct.c b/libguile/struct.c
index f89f2e7a9..520056c46 100644
--- a/libguile/struct.c
+++ b/libguile/struct.c
@@ -379,6 +379,7 @@ SCM_DEFINE (scm_make_struct, "make-struct", 2, 0, 1,
SCM_VALIDATE_VTABLE (1,vtable);
SCM_VALIDATE_INUM (2,tail_array_size);
+ SCM_VALIDATE_REST_ARGUMENT (init);
layout = SCM_PACK (SCM_STRUCT_DATA (vtable) [scm_vtable_index_layout]);
basic_size = SCM_LENGTH (layout) / 2;
@@ -474,6 +475,7 @@ SCM_DEFINE (scm_make_vtable_vtable, "make-vtable-vtable", 2, 0, 1,
SCM_VALIDATE_ROSTRING (1,extra_fields);
SCM_VALIDATE_INUM (2,tail_array_size);
+ SCM_VALIDATE_REST_ARGUMENT (init);
fields = scm_string_append (scm_listify (required_vtable_fields,
extra_fields,
diff --git a/libguile/throw.c b/libguile/throw.c
index 80ee191a1..c63007547 100644
--- a/libguile/throw.c
+++ b/libguile/throw.c
@@ -313,7 +313,7 @@ ss_handler (void *data, SCM tag, SCM throw_args)
{
/* Save the stack */
scm_fluid_set_x (SCM_CDR (scm_the_last_stack_fluid),
- scm_make_stack (scm_cons (SCM_BOOL_T, SCM_EOL)));
+ scm_make_stack (SCM_BOOL_T, SCM_EOL));
/* Throw the error */
return scm_throw (tag, throw_args);
}
@@ -438,7 +438,7 @@ handler_message (void *handler_data, SCM tag, SCM args)
if (scm_ilength (args) >= 3)
{
- SCM stack = scm_make_stack (SCM_LIST1 (SCM_BOOL_T));
+ SCM stack = scm_make_stack (SCM_BOOL_T, SCM_EOL);
SCM subr = SCM_CAR (args);
SCM message = SCM_CADR (args);
SCM parts = SCM_CADDR (args);
diff --git a/libguile/unif.c b/libguile/unif.c
index 688e26e8d..369ece452 100644
--- a/libguile/unif.c
+++ b/libguile/unif.c
@@ -785,8 +785,8 @@ SCM_DEFINE (scm_make_shared_array, "make-shared-array", 2, 0, 1,
/* args are RA . DIMS */
-SCM_DEFINE (scm_transpose_array, "transpose-array", 0, 0, 1,
- (SCM args),
+SCM_DEFINE (scm_transpose_array, "transpose-array", 1, 0, 1,
+ (SCM ra, SCM args),
"Returns an array sharing contents with @var{array}, but with dimensions\n"
"arranged in a different order. There must be one @var{dim} argument for\n"
"each dimension of @var{array}. @var{dim0}, @var{dim1}, @dots{} should\n"
@@ -806,14 +806,11 @@ SCM_DEFINE (scm_transpose_array, "transpose-array", 0, 0, 1,
"@end example")
#define FUNC_NAME s_scm_transpose_array
{
- SCM ra, res, vargs, *ve = &vargs;
+ SCM res, vargs, *ve = &vargs;
scm_array_dim *s, *r;
int ndim, i, k;
- SCM_ASSERT (SCM_NNULLP (args), scm_makfrom0str (FUNC_NAME),
- SCM_WNA, NULL);
- ra = SCM_CAR (args);
+
SCM_ASSERT (SCM_NIMP (ra), ra, SCM_ARG1, FUNC_NAME);
- args = SCM_CDR (args);
switch (SCM_TYP7 (ra))
{
default:
@@ -830,7 +827,7 @@ SCM_DEFINE (scm_transpose_array, "transpose-array", 0, 0, 1,
#ifdef HAVE_LONG_LONGS
case scm_tc7_llvect:
#endif
- SCM_ASSERT (SCM_NIMP (args) && SCM_NULLP (SCM_CDR (args)),
+ SCM_ASSERT (!SCM_NULLP (args) && SCM_NULLP (SCM_CDR (args)),
scm_makfrom0str (FUNC_NAME), SCM_WNA, NULL);
SCM_ASSERT (SCM_INUMP (SCM_CAR (args)), SCM_CAR (args), SCM_ARG2,
FUNC_NAME);
@@ -895,8 +892,8 @@ SCM_DEFINE (scm_transpose_array, "transpose-array", 0, 0, 1,
#undef FUNC_NAME
/* args are RA . AXES */
-SCM_DEFINE (scm_enclose_array, "enclose-array", 0, 0, 1,
- (SCM axes),
+SCM_DEFINE (scm_enclose_array, "enclose-array", 1, 0, 1,
+ (SCM ra, SCM axes),
"@var{dim0}, @var{dim1} @dots{} should be nonnegative integers less than\n"
"the rank of @var{array}. @var{enclose-array} returns an array\n"
"resembling an array of shared arrays. The dimensions of each shared\n"
@@ -917,16 +914,14 @@ SCM_DEFINE (scm_enclose_array, "enclose-array", 0, 0, 1,
"@end example")
#define FUNC_NAME s_scm_enclose_array
{
- SCM axv, ra, res, ra_inr;
+ SCM axv, res, ra_inr;
scm_array_dim vdim, *s = &vdim;
int ndim, j, k, ninr, noutr;
- SCM_ASSERT (SCM_NIMP (axes), scm_makfrom0str (FUNC_NAME), SCM_WNA,
- NULL);
- ra = SCM_CAR (axes);
- axes = SCM_CDR (axes);
+
if (SCM_NULLP (axes))
axes = scm_cons ((SCM_ARRAYP (ra) ? SCM_MAKINUM (SCM_ARRAY_NDIM (ra) - 1) : SCM_INUM0), SCM_EOL);
ninr = scm_ilength (axes);
+ SCM_ASSERT (0 <= ninr, scm_makfrom0str (FUNC_NAME), SCM_WNA, NULL);
ra_inr = scm_make_ra (ninr);
SCM_ASRTGO (SCM_NIMP (ra), badarg1);
switch SCM_TYP7
@@ -965,8 +960,7 @@ SCM_DEFINE (scm_enclose_array, "enclose-array", 0, 0, 1,
}
noutr = ndim - ninr;
axv = scm_make_string (SCM_MAKINUM (ndim), SCM_MAKE_CHAR (0));
- SCM_ASSERT (0 <= noutr && 0 <= ninr, scm_makfrom0str (FUNC_NAME),
- SCM_WNA, NULL);
+ SCM_ASSERT (0 <= noutr, scm_makfrom0str (FUNC_NAME), SCM_WNA, NULL);
res = scm_make_ra (noutr);
SCM_ARRAY_BASE (res) = SCM_ARRAY_BASE (ra_inr);
SCM_ARRAY_V (res) = ra_inr;
@@ -995,20 +989,17 @@ SCM_DEFINE (scm_enclose_array, "enclose-array", 0, 0, 1,
-SCM_DEFINE (scm_array_in_bounds_p, "array-in-bounds?", 0, 0, 1,
- (SCM args),
+SCM_DEFINE (scm_array_in_bounds_p, "array-in-bounds?", 1, 0, 1,
+ (SCM v, SCM args),
"Returns @code{#t} if its arguments would be acceptable to array-ref.")
#define FUNC_NAME s_scm_array_in_bounds_p
{
- SCM v, ind = SCM_EOL;
+ SCM ind = SCM_EOL;
long pos = 0;
register scm_sizet k;
register long j;
scm_array_dim *s;
- SCM_ASSERT (SCM_NIMP (args), scm_makfrom0str (FUNC_NAME),
- SCM_WNA, NULL);
- v = SCM_CAR (args);
- args = SCM_CDR (args);
+
SCM_ASRTGO (SCM_NIMP (v), badarg1);
if (SCM_NIMP (args))
diff --git a/libguile/unif.h b/libguile/unif.h
index f840c3d82..a26adc6a3 100644
--- a/libguile/unif.h
+++ b/libguile/unif.h
@@ -110,9 +110,9 @@ extern SCM scm_shap2ra (SCM args, const char *what);
extern SCM scm_dimensions_to_uniform_array (SCM dims, SCM prot, SCM fill);
extern void scm_ra_set_contp (SCM ra);
extern SCM scm_make_shared_array (SCM oldra, SCM mapfunc, SCM dims);
-extern SCM scm_transpose_array (SCM args);
-extern SCM scm_enclose_array (SCM axes);
-extern SCM scm_array_in_bounds_p (SCM args);
+extern SCM scm_transpose_array (SCM ra, SCM args);
+extern SCM scm_enclose_array (SCM ra, SCM axes);
+extern SCM scm_array_in_bounds_p (SCM v, SCM args);
extern SCM scm_uniform_vector_ref (SCM v, SCM args);
extern SCM scm_cvref (SCM v, scm_sizet pos, SCM last);
extern SCM scm_array_set_x (SCM v, SCM obj, SCM args);
diff --git a/libguile/validate.h b/libguile/validate.h
index bcd7328f6..b9f81aa89 100644
--- a/libguile/validate.h
+++ b/libguile/validate.h
@@ -1,4 +1,4 @@
-/* $Id: validate.h,v 1.10 2000-05-15 11:47:48 dirk Exp $ */
+/* $Id: validate.h,v 1.11 2000-05-18 08:47:52 dirk Exp $ */
/* Copyright (C) 1999, 2000 Free Software Foundation, Inc.
*
* This program is free software; you can redistribute it and/or modify
@@ -100,6 +100,15 @@
+#define SCM_VALIDATE_REST_ARGUMENT(x) \
+ do { \
+ if (SCM_DEBUG_REST_ARGUMENT) { \
+ if (scm_ilength (x) < 0) { \
+ SCM_MISC_ERROR ("Rest arguments do not form a proper list.", SCM_EOL); \
+ } \
+ } \
+ } while (0)
+
#define SCM_VALIDATE_NIM(pos, scm) SCM_MAKE_VALIDATE (pos, scm, NIMP)
#define SCM_VALIDATE_BOOL(pos, flag) SCM_MAKE_VALIDATE(pos, flag, BOOLP)