* Unified some rest argument checking and handling.

libguile/ChangeLog

@@ -1,3 +1,50 @@
+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

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
+/* If SCM_DEBUG_REST_ARGUMENT is set to 1, functions that take rest arguments
- * will check whether the rest arguments actually form a proper list.
+ * will check whether the rest arguments are actually passed as a proper list.
- * Otherwise it is assumed that the rest arguments form a proper list and only
+ * Otherwise, if SCM_DEBUG_REST_ARGUMENT is 0, functions that take rest
- * the parameters themselves, which are given as rest arguments, are checked.
+ * arguments will take it for granted that these are passed as a proper list.
  */
-#ifndef SCM_DEBUG_REST_ARGUMENTS
+#ifndef SCM_DEBUG_REST_ARGUMENT
-#define SCM_DEBUG_REST_ARGUMENTS SCM_DEBUG
+#define SCM_DEBUG_REST_ARGUMENT SCM_DEBUG
 #endif
 
 /* Use this for _compile time_ type checking only, since the compiled result

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

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,
+sysdep_dynl_link (const char *filename, const char *subr)
-		  int flags,
-		  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_DEFINE (scm_dynamic_link, "dynamic-link", 1, 0, 0, 
-            (SCM fname, SCM rest),
+            (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);
-
+  handle = sysdep_dynl_link (SCM_CHARS (fname), FUNC_NAME);
-  /* 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);
-    
   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);
 }
 
 /*

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);

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 

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
+  } else {
-    {
+    SCM_VALIDATE_INUM_COPY (SCM_ARG3, value, ivalue);
-      SCM_ASSERT (SCM_INUMP (SCM_CAR (value)), value, SCM_ARG3, FUNC_NAME);
+  }
-      ivalue = SCM_INUM (SCM_CAR (value));
+
-    }
   SCM_SYSCALL (rv = fcntl (fdes, SCM_INUM (cmd), ivalue));
   if (rv == -1)
     SCM_SYSERROR;

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))));

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_VALIDATE_REST_ARGUMENT (args);
-  SCM *lloc = &res, arg;
+  if (SCM_NULLP (args)) {
-  if (SCM_IMP(args)) {
+    return SCM_EOL;
-    SCM_VALIDATE_NULL (SCM_ARGn, args);
+  } 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;
+  SCM_VALIDATE_REST_ARGUMENT (args);
- tail:
+  while (1) {
-  if (SCM_NULLP(args)) return SCM_EOL;
+    if (SCM_NULLP (args)) {
-  arg = SCM_CAR(args);
+      return SCM_EOL;
-  args = SCM_CDR(args);
+    } else {
-  if (SCM_NULLP(args)) return arg;
+      SCM arg = SCM_CAR (args);
-  if (SCM_NULLP(arg)) goto tail;
+      args = SCM_CDR (args);
-  SCM_VALIDATE_CONS (SCM_ARG1,arg);
+      if (SCM_NULLP (args)) {
-  SCM_SETCDR (scm_last_pair (arg), scm_append_x (args));
+	return arg;
-  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
 

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;

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;

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)

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;
 }

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;

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_DEFINE (scm_make_stack, "make-stack", 1, 0, 1, 
-            (SCM args),
+            (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 inner_cut, outer_cut;
-
-  SCM_ASSERT (SCM_CONSP (args),
-	      SCM_FUNC_NAME, SCM_WNA, NULL);
-  obj = SCM_CAR (args);
-  args = SCM_CDR (args);
 
   /* 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,

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);

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)) {

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,

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);

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_DEFINE (scm_transpose_array, "transpose-array", 1, 0, 1, 
-           (SCM args),
+           (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_DEFINE (scm_enclose_array, "enclose-array", 1, 0, 1, 
-           (SCM axes),
+           (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_ASSERT (0 <= noutr, scm_makfrom0str (FUNC_NAME), SCM_WNA, NULL);
-	      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_DEFINE (scm_array_in_bounds_p, "array-in-bounds?", 1, 0, 1, 
-           (SCM args),
+           (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))
 

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_transpose_array (SCM ra, SCM args);
-extern SCM scm_enclose_array (SCM axes);
+extern SCM scm_enclose_array (SCM ra, SCM axes);
-extern SCM scm_array_in_bounds_p (SCM args);
+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);

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)