(scm_list): Restore this function for use from C.

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

diff --git a/libguile/list.c b/libguile/list.c
index 9fffa22..a1a79a4 100644 (file)
--- a/libguile/list.c
+++ b/libguile/list.c
@@ -13,7 +13,7 @@
  *
  * You should have received a copy of the GNU Lesser General Public
  * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
  */
 
 
@@ -98,18 +98,28 @@ scm_list_n (SCM elt, ...)
 }
 
 
-SCM_DEFINE (scm_list, "list", 0, 0, 1, 
-           (SCM objs),
-           "Return a list containing @var{objs}, the arguments to\n"
-           "@code{list}.")
-#define FUNC_NAME s_scm_list
+SCM_DEFINE (scm_make_list, "make-list", 1, 1, 0,
+            (SCM n, SCM init),
+           "Create a list containing of @var{n} elements, where each\n"
+           "element is initialized to @var{init}.  @var{init} defaults to\n"
+           "the empty list @code{()} if not given.")
+#define FUNC_NAME s_scm_make_list
 {
-  return objs;
+  unsigned nn = scm_to_uint (n);
+  unsigned i;
+  SCM ret = SCM_EOL;
+
+  if (SCM_UNBNDP (init))
+    init = SCM_EOL;
+
+  for (i = 0; i < nn; i++)
+    ret = scm_cons (init, ret);
+  return ret;
 }
 #undef FUNC_NAME
 
 
-SCM_DEFINE (scm_cons_star, "cons*", 1, 0, 1, 
+SCM_DEFINE (scm_cons_star, "cons*", 1, 0, 1,
             (SCM arg, SCM rest),
            "Like @code{list}, but the last arg provides the tail of the\n"
            "constructed list, returning @code{(cons @var{arg1} (cons\n"
@@ -119,18 +129,20 @@ SCM_DEFINE (scm_cons_star, "cons*", 1, 0, 1,
            "Schemes and in Common LISP.")
 #define FUNC_NAME s_scm_cons_star
 {
+  SCM ret = SCM_EOL;
+  SCM *p = &ret;
+
   SCM_VALIDATE_REST_ARGUMENT (rest);
-  if (!scm_is_null (rest))
+
+  for ( ; scm_is_pair (rest); rest = SCM_CDR (rest))
     {
-      SCM prev = arg = scm_cons (arg, rest);
-      while (!scm_is_null (SCM_CDR (rest)))
-       {
-         prev = rest;
-         rest = SCM_CDR (rest);
-       }
-      SCM_SETCDR (prev, SCM_CAR (rest));
+      *p = scm_cons (arg, SCM_EOL);
+      p = SCM_CDRLOC (*p);
+      arg = SCM_CAR (rest);
     }
-  return arg;
+
+  *p = arg;
+  return ret;
 }
 #undef FUNC_NAME
 
@@ -552,6 +564,23 @@ SCM_DEFINE (scm_list_copy, "list-copy", 1, 0, 0,
 }
 #undef FUNC_NAME
 
+
+SCM_PROC (s_list, "list", 0, 0, 1, scm_list_copy);
+SCM_SNARF_DOCS (primitive, scm_list_copy, "list", (SCM objs), 0, 0, 1,
+                "Return a list containing @var{objs}, the arguments to\n"
+                "@code{list}.")
+
+/* This used to be the code for "list", but it's wrong when used via apply
+   (it should copy the list).  It seems pretty unlikely anyone would have
+   been using this from C code, since it's a no-op, but keep it for strict
+   binary compatibility.  */
+SCM
+scm_list (SCM objs)
+{
+  return objs;
+}
+
+
 \f
 /* membership tests (memq, memv, etc.) */