* readline.scm: moved to ./ice-9/

[bpt/guile.git] / libguile / list.c

diff --git a/libguile/list.c b/libguile/list.c
index 07a0d0d..2136137 100644 (file)
--- a/libguile/list.c
+++ b/libguile/list.c
@@ -1,4 +1,5 @@
-/* Copyright (C) 1995,1996,1997,2000,2001, 2003 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1997,2000,2001,2003,2004
+ * Free Software Foundation, Inc.
  * 
  * This library is free software; you can redistribute it and/or
  * modify it under the terms of the GNU Lesser General Public
@@ -25,13 +26,7 @@
 #include "libguile/list.h"
 #include "libguile/eval.h"
 
-#ifdef __STDC__
 #include <stdarg.h>
-#define var_start(x, y) va_start(x, y)
-#else
-#include <varargs.h>
-#define var_start(x, y) va_start(x)
-#endif
 
 \f
 /* creating lists */
@@ -87,9 +82,13 @@ scm_list_n (SCM elt, ...)
   SCM answer = SCM_EOL;
   SCM *pos = &answer;
 
-  var_start (foo, elt);
+  va_start (foo, elt);
   while (! SCM_UNBNDP (elt))
     {
+#if (SCM_DEBUG_CELL_ACCESSES == 1)
+      if (SCM_NIMP (elt))
+       SCM_VALIDATE_CELL(elt, 0);
+#endif      
       *pos = scm_cons (elt, SCM_EOL);
       pos = SCM_CDRLOC (*pos);
       elt = va_arg (foo, SCM);
@@ -231,6 +230,7 @@ SCM_DEFINE (scm_append, "append", 0, 0, 1,
     SCM res = SCM_EOL;
     SCM *lloc = &res;
     SCM arg = SCM_CAR (args);
+    int argnum = 1;
     args = SCM_CDR (args);
     while (!SCM_NULLP (args)) {
       while (SCM_CONSP (arg)) {
@@ -238,9 +238,10 @@ SCM_DEFINE (scm_append, "append", 0, 0, 1,
        lloc = SCM_CDRLOC (*lloc);
        arg = SCM_CDR (arg);
       }
-      SCM_VALIDATE_NULL_OR_NIL (SCM_ARGn, arg);
+      SCM_VALIDATE_NULL_OR_NIL (argnum, arg);
       arg = SCM_CAR (args);
       args = SCM_CDR (args);
+      argnum++;
     };
     *lloc = arg;
     return res;
@@ -254,33 +255,39 @@ SCM_DEFINE (scm_append_x, "append!", 0, 0, 1,
            "A destructive version of @code{append} (@pxref{Pairs and\n"
            "Lists,,,r5rs, The Revised^5 Report on Scheme}).  The cdr field\n"
            "of each list's final pair is changed to point to the head of\n"
-           "the next list, so no consing is performed.  Return a pointer to\n"
+           "the next list, so no consing is performed.  Return\n"
            "the mutated list.")
 #define FUNC_NAME s_scm_append_x
 {
+  SCM ret, *loc;
   SCM_VALIDATE_REST_ARGUMENT (lists);
-  while (1) {
-    if (SCM_NULLP (lists)) {
-      return SCM_EOL;
-    } else {
+
+  if (SCM_NULLP (lists))
+    return SCM_EOL;
+
+  loc = &ret;
+  for (;;)
+    {
       SCM arg = SCM_CAR (lists);
+      *loc = arg;
+
       lists = SCM_CDR (lists);
-      if (SCM_NULLP (lists)) {
-       return arg;
-      } else if (!SCM_NULL_OR_NIL_P (arg)) {
-       SCM_VALIDATE_CONS (SCM_ARG1, arg);
-       SCM_SETCDR (scm_last_pair (arg), scm_append_x (lists));
-       return arg;
-      }
+      if (SCM_NULLP (lists))
+        return ret;
+
+      if (!SCM_NULL_OR_NIL_P (arg))
+        {
+          SCM_VALIDATE_CONS (SCM_ARG1, arg);
+          loc = SCM_CDRLOC (scm_last_pair (arg));
+        }
     }
-  }
 }
 #undef FUNC_NAME
 
 
 SCM_DEFINE (scm_last_pair, "last-pair", 1, 0, 0, 
            (SCM lst),
-           "Return a pointer to the last pair in @var{lst}, signalling an error if\n"
+           "Return the last pair in @var{lst}, signalling an error if\n"
            "@var{lst} is circular.")
 #define FUNC_NAME s_scm_last_pair
 {
@@ -338,8 +345,8 @@ SCM_DEFINE (scm_reverse_x, "reverse!", 1, 1, 0,
             (SCM lst, SCM new_tail),
            "A destructive version of @code{reverse} (@pxref{Pairs and Lists,,,r5rs,\n"
            "The Revised^5 Report on Scheme}).  The cdr of each cell in @var{lst} is\n"
-           "modified to point to the previous list element.  Return a pointer to the\n"
-           "head of the reversed list.\n\n"
+           "modified to point to the previous list element.  Return the\n"
+           "reversed list.\n\n"
            "Caveat: because the list is modified in place, the tail of the original\n"
            "list now becomes its head, and the head of the original list now becomes\n"
            "the tail.  Therefore, the @var{lst} symbol to which the head of the\n"
@@ -494,6 +501,34 @@ SCM_DEFINE (scm_list_head, "list-head", 2, 0, 0,
 #undef FUNC_NAME
 
 
+/* Copy a list which is known to be finite.  The last pair may or may not have
+ * a '() in its cdr.  That is, improper lists are accepted.  */
+SCM
+scm_i_finite_list_copy (SCM list)
+{
+  if (!SCM_CONSP (list))
+    {
+      return list;
+    }
+  else
+    {
+      SCM tail;
+      const SCM result = tail = scm_list_1 (SCM_CAR (list));
+      list = SCM_CDR (list);
+      while (SCM_CONSP (list))
+        {
+          const SCM new_tail = scm_list_1 (SCM_CAR (list));
+          SCM_SETCDR (tail, new_tail);
+          tail = new_tail;
+          list = SCM_CDR (list);
+        }
+      SCM_SETCDR (tail, list);
+
+      return result;
+    }
+}
+
+
 SCM_DEFINE (scm_list_copy, "list-copy", 1, 0, 0, 
             (SCM lst),
            "Return a (newly-created) copy of @var{lst}.")
@@ -608,7 +643,7 @@ SCM_DEFINE (scm_delq_x, "delq!", 2, 0, 0,
            "@deffnx {Scheme Procedure} delv! item lst\n"
            "@deffnx {Scheme Procedure} delete! item lst\n"
            "These procedures are destructive versions of @code{delq}, @code{delv}\n"
-           "and @code{delete}: they modify the pointers in the existing @var{lst}\n"
+           "and @code{delete}: they modify the existing @var{lst}\n"
            "rather than creating a new list.  Caveat evaluator: Like other\n"
            "destructive list functions, these functions cannot modify the binding of\n"
            "@var{lst}, and so cannot be used to delete the first element of\n"