-/* Copyright (C) 1995,1996,1997, 2000 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1997,2000,2001 Free Software Foundation, Inc.
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* whether to permit this exception to apply to your modifications.
* If you do not wish that, delete this exception notice. */
-/* Software engineering face-lift by Greg J. Badros, 11-Dec-1999,
- gjb@cs.washington.edu, http://www.cs.washington.edu/homes/gjb */
\f
-#include <stdio.h>
#include "libguile/_scm.h"
#include "libguile/eq.h"
\f
/* creating lists */
+#define SCM_I_CONS(cell,x,y) \
+do { \
+ SCM_NEWCELL (cell); \
+ SCM_SET_CELL_OBJECT_1 (cell, y); \
+ SCM_SET_CELL_OBJECT_0 (cell, x); \
+} while (0)
+
+SCM
+scm_list_1 (SCM e1)
+{
+ SCM c1;
+ SCM_I_CONS (c1, e1, SCM_EOL);
+ return c1;
+}
+
+SCM
+scm_list_2 (SCM e1, SCM e2)
+{
+ SCM c1, c2;
+ SCM_I_CONS (c2, e2, SCM_EOL);
+ SCM_I_CONS (c1, e1, c2);
+ return c1;
+}
+
SCM
-scm_listify (SCM elt, ...)
+scm_list_3 (SCM e1, SCM e2, SCM e3)
+{
+ SCM c1, c2, c3;
+ SCM_I_CONS (c3, e3, SCM_EOL);
+ SCM_I_CONS (c2, e2, c3);
+ SCM_I_CONS (c1, e1, c2);
+ return c1;
+}
+
+SCM
+scm_list_4 (SCM e1, SCM e2, SCM e3, SCM e4)
+{
+ return scm_cons2 (e1, e2, scm_list_2 (e3, e4));
+}
+
+SCM
+scm_list_5 (SCM e1, SCM e2, SCM e3, SCM e4, SCM e5)
+{
+ return scm_cons2 (e1, e2, scm_list_3 (e3, e4, e5));
+}
+
+SCM
+scm_list_n (SCM elt, ...)
{
va_list foo;
SCM answer = SCM_EOL;
SCM_DEFINE (scm_list, "list", 0, 0, 1,
(SCM objs),
- "Return a list containing OBJS, the arguments to `list'.")
+ "Return a list containing @var{objs}, the arguments to\n"
+ "@code{list}.")
#define FUNC_NAME s_scm_list
{
return objs;
#undef FUNC_NAME
-#if (SCM_DEBUG_DEPRECATED == 0)
-
-SCM_REGISTER_PROC (s_list_star, "list*", 1, 0, 1, scm_cons_star);
-
-#endif /* SCM_DEBUG_DEPRECATED == 0 */
-
SCM_DEFINE (scm_cons_star, "cons*", 1, 0, 1,
(SCM arg, SCM rest),
- "Like `list', but the last arg provides the tail of the constructed list,\n"
- "returning (cons ARG1 (cons ARG2 (cons ... ARGn))).\n"
- "Requires at least one argument. If given one argument, that argument\n"
- "is returned as result.\n"
- "This function is called `list*' in some other Schemes and in Common LISP.")
+ "Like @code{list}, but the last arg provides the tail of the\n"
+ "constructed list, returning @code{(cons @var{arg1} (cons\n"
+ "@var{arg2} (cons @dots{} @var{argn})))}. Requires at least one\n"
+ "argument. If given one argument, that argument is returned as\n"
+ "result. This function is called @code{list*} in some other\n"
+ "Schemes and in Common LISP.")
#define FUNC_NAME s_scm_cons_star
{
SCM_VALIDATE_REST_ARGUMENT (rest);
SCM_DEFINE (scm_null_p, "null?", 1, 0, 0,
(SCM x),
- "Return #t iff X is the empty list, else #f.")
+ "Return @code{#t} iff @var{x} is the empty list, else @code{#f}.")
#define FUNC_NAME s_scm_null_p
{
return SCM_BOOL (SCM_NULLP (x));
SCM_DEFINE (scm_list_p, "list?", 1, 0, 0,
(SCM x),
- "Return #t iff X is a proper list, else #f.")
+ "Return @code{#t} iff @var{x} is a proper list, else @code{#f}.")
#define FUNC_NAME s_scm_list_p
{
return SCM_BOOL (scm_ilength (x) >= 0);
SCM_DEFINE (scm_length, "length", 1, 0, 0,
(SCM lst),
- "Return the number of elements in list LST.")
+ "Return the number of elements in list @var{lst}.")
#define FUNC_NAME s_scm_length
{
- int i;
+ long i;
SCM_VALIDATE_LIST_COPYLEN (1,lst,i);
return SCM_MAKINUM (i);
}
SCM_DEFINE (scm_append, "append", 0, 0, 1,
(SCM args),
- "Returns a list consisting of the elements of the first LIST\n"
- "followed by the elements of the other LISTs.\n\n"
- "@example\n"
- " (append '(x) '(y)) => (x y)\n"
- " (append '(a) '(b c d)) => (a b c d)\n"
- " (append '(a (b)) '((c))) => (a (b) (c))\n"
- "@end example\n\n"
- "The resulting list is always newly allocated, except that it shares\n"
- "structure with the last LIST argument. The last argument may\n"
- "actually be any object; an improper list results if the last\n"
- "argument is not a proper list.\n\n"
- "@example\n"
- " (append '(a b) '(c . d)) => (a b c . d)\n"
- " (append '() 'a) => a\n"
- "@end example")
+ "Return a list consisting of the elements the lists passed as\n"
+ "arguments.\n"
+ "@lisp\n"
+ "(append '(x) '(y)) @result{} (x y)\n"
+ "(append '(a) '(b c d)) @result{} (a b c d)\n"
+ "(append '(a (b)) '((c))) @result{} (a (b) (c))\n"
+ "@end lisp\n"
+ "The resulting list is always newly allocated, except that it\n"
+ "shares structure with the last list argument. The last\n"
+ "argument may actually be any object; an improper list results\n"
+ "if the last argument is not a proper list.\n"
+ "@lisp\n"
+ "(append '(a b) '(c . d)) @result{} (a b c . d)\n"
+ "(append '() 'a) @result{} a\n"
+ "@end lisp")
#define FUNC_NAME s_scm_append
{
SCM_VALIDATE_REST_ARGUMENT (args);
SCM_DEFINE (scm_append_x, "append!", 0, 0, 1,
- (SCM args),
- "A destructive version of @code{append} (@pxref{Pairs and Lists,,,r4rs,\n"
- "The Revised^4 Report on Scheme}). The cdr field of each list's final\n"
- "pair is changed to point to the head of the next list, so no consing is\n"
- "performed. Return a pointer to the mutated list.")
+ (SCM lists),
+ "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 mutated list.")
#define FUNC_NAME s_scm_append_x
{
- SCM_VALIDATE_REST_ARGUMENT (args);
+ SCM_VALIDATE_REST_ARGUMENT (lists);
while (1) {
- if (SCM_NULLP (args)) {
+ if (SCM_NULLP (lists)) {
return SCM_EOL;
} else {
- SCM arg = SCM_CAR (args);
- args = SCM_CDR (args);
- if (SCM_NULLP (args)) {
+ SCM arg = SCM_CAR (lists);
+ lists = SCM_CDR (lists);
+ if (SCM_NULLP (lists)) {
return arg;
} else if (!SCM_NULLP (arg)) {
SCM_VALIDATE_CONS (SCM_ARG1, arg);
- SCM_SETCDR (scm_last_pair (arg), scm_append_x (args));
+ SCM_SETCDR (scm_last_pair (arg), scm_append_x (lists));
return arg;
}
}
tortoise = SCM_CDR(tortoise);
}
while (! SCM_EQ_P (hare, tortoise));
- SCM_MISC_ERROR ("Circular structure in position 1: ~S", SCM_LIST1 (lst));
+ SCM_MISC_ERROR ("Circular structure in position 1: ~S", scm_list_1 (lst));
}
#undef FUNC_NAME
SCM_DEFINE (scm_reverse, "reverse", 1, 0, 0,
(SCM lst),
- "Return a new list that contains the elements of LST but in reverse order.")
+ "Return a new list that contains the elements of @var{lst} but\n"
+ "in reverse order.")
#define FUNC_NAME s_scm_reverse
{
SCM result = SCM_EOL;
tortoise = SCM_CDR (tortoise);
}
while (! SCM_EQ_P (hare, tortoise));
- SCM_MISC_ERROR ("Circular structure in position 1: ~S", SCM_LIST1 (lst));
+ SCM_MISC_ERROR ("Circular structure in position 1: ~S", scm_list_1 (lst));
}
#undef FUNC_NAME
SCM_DEFINE (scm_reverse_x, "reverse!", 1, 1, 0,
(SCM lst, SCM new_tail),
- "A destructive version of @code{reverse} (@pxref{Pairs and Lists,,,r4rs,\n"
- "The Revised^4 Report on Scheme}). The cdr of each cell in @var{lst} is\n"
+ "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"
"Caveat: because the list is modified in place, the tail of the original\n"
"@code{reverse!}")
#define FUNC_NAME s_scm_reverse_x
{
- SCM_ASSERT (scm_ilength (lst) >= 0, lst, SCM_ARG1, FUNC_NAME);
+ SCM_VALIDATE_LIST (1, lst);
if (SCM_UNBNDP (new_tail))
new_tail = SCM_EOL;
else
- SCM_ASSERT (scm_ilength (new_tail) >= 0, new_tail, SCM_ARG2, FUNC_NAME);
+ SCM_VALIDATE_LIST (2, new_tail);
while (SCM_NNULLP (lst))
{
SCM_DEFINE (scm_list_ref, "list-ref", 2, 0, 0,
(SCM list, SCM k),
- "Return the Kth element from LIST.")
+ "Return the @var{k}th element from @var{list}.")
#define FUNC_NAME s_scm_list_ref
{
SCM lst = list;
SCM * fill_here;
SCM from_here;
+ SCM_VALIDATE_LIST (1, lst);
+
newlst = SCM_EOL;
fill_here = &newlst;
from_here = lst;
\f
/* membership tests (memq, memv, etc.) */
-SCM_DEFINE (scm_sloppy_memq, "sloppy-memq", 2, 0, 0,
- (SCM x, SCM lst),
- "This procedure behaves like @code{memq}, but does no type or error checking.\n"
- "Its use is recommended only in writing Guile internals,\n"
- "not for high-level Scheme programs.")
-#define FUNC_NAME s_scm_sloppy_memq
-{
- for(; SCM_CONSP (lst); lst = SCM_CDR(lst))
- {
- if (SCM_EQ_P (SCM_CAR (lst), x))
- return lst;
- }
- return lst;
-}
-#undef FUNC_NAME
-
-
-SCM_DEFINE (scm_sloppy_memv, "sloppy-memv", 2, 0, 0,
- (SCM x, SCM lst),
- "This procedure behaves like @code{memv}, but does no type or error checking.\n"
- "Its use is recommended only in writing Guile internals,\n"
- "not for high-level Scheme programs.")
-#define FUNC_NAME s_scm_sloppy_memv
-{
- for(; SCM_CONSP (lst); lst = SCM_CDR(lst))
- {
- if (! SCM_FALSEP (scm_eqv_p (SCM_CAR (lst), x)))
- return lst;
- }
- return lst;
-}
-#undef FUNC_NAME
-
-
-SCM_DEFINE (scm_sloppy_member, "sloppy-member", 2, 0, 0,
- (SCM x, SCM lst),
- "This procedure behaves like @code{member}, but does no type or error checking.\n"
- "Its use is recommended only in writing Guile internals,\n"
- "not for high-level Scheme programs.")
-#define FUNC_NAME s_scm_sloppy_member
+/* The function scm_c_memq returns the first sublist of list whose car is
+ * 'eq?' obj, where the sublists of list are the non-empty lists returned by
+ * (list-tail list k) for k less than the length of list. If obj does not
+ * occur in list, then #f (not the empty list) is returned.
+ * List must be a proper list, otherwise scm_c_memq may crash or loop
+ * endlessly.
+ */
+SCM
+scm_c_memq (SCM obj, SCM list)
{
- for(; SCM_CONSP (lst); lst = SCM_CDR(lst))
+ for (; !SCM_NULLP (list); list = SCM_CDR (list))
{
- if (! SCM_FALSEP (scm_equal_p (SCM_CAR (lst), x)))
- return lst;
+ if (SCM_EQ_P (SCM_CAR (list), obj))
+ return list;
}
- return lst;
+ return SCM_BOOL_F;
}
-#undef FUNC_NAME
-
SCM_DEFINE (scm_memq, "memq", 2, 0, 0,
(SCM x, SCM lst),
- "Return the first sublist of LST whose car is `eq?' to X\n"
- "where the sublists of LST are the non-empty lists returned\n"
- "by `(list-tail LST K)' for K less than the length of LST. If\n"
- "X does not occur in LST, then `#f' (not the empty list) is\n"
- "returned.")
+ "Return the first sublist of @var{lst} whose car is @code{eq?}\n"
+ "to @var{x} where the sublists of @var{lst} are the non-empty\n"
+ "lists returned by @code{(list-tail @var{lst} @var{k})} for\n"
+ "@var{k} less than the length of @var{lst}. If @var{x} does not\n"
+ "occur in @var{lst}, then @code{#f} (not the empty list) is\n"
+ "returned.")
#define FUNC_NAME s_scm_memq
{
- SCM answer;
- SCM_VALIDATE_LIST (2,lst);
- answer = scm_sloppy_memq (x, lst);
- return (SCM_NULLP (answer)) ? SCM_BOOL_F : answer;
+ SCM_VALIDATE_LIST (2, lst);
+ return scm_c_memq (x, lst);
}
#undef FUNC_NAME
-
SCM_DEFINE (scm_memv, "memv", 2, 0, 0,
(SCM x, SCM lst),
- "Return the first sublist of LST whose car is `eqv?' to X\n"
- "where the sublists of LST are the non-empty lists returned\n"
- "by `(list-tail LST K)' for K less than the length of LST. If\n"
- "X does not occur in LST, then `#f' (not the empty list) is\n"
- "returned.")
+ "Return the first sublist of @var{lst} whose car is @code{eqv?}\n"
+ "to @var{x} where the sublists of @var{lst} are the non-empty\n"
+ "lists returned by @code{(list-tail @var{lst} @var{k})} for\n"
+ "@var{k} less than the length of @var{lst}. If @var{x} does not\n"
+ "occur in @var{lst}, then @code{#f} (not the empty list) is\n"
+ "returned.")
#define FUNC_NAME s_scm_memv
{
- SCM answer;
- SCM_VALIDATE_LIST (2,lst);
- answer = scm_sloppy_memv (x, lst);
- return (SCM_NULLP (answer)) ? SCM_BOOL_F : answer;
+ SCM_VALIDATE_LIST (2, lst);
+ for (; !SCM_NULLP (lst); lst = SCM_CDR (lst))
+ {
+ if (! SCM_FALSEP (scm_eqv_p (SCM_CAR (lst), x)))
+ return lst;
+ }
+ return SCM_BOOL_F;
}
#undef FUNC_NAME
SCM_DEFINE (scm_member, "member", 2, 0, 0,
(SCM x, SCM lst),
- "Return the first sublist of LST whose car is `equal?' to X\n"
- "where the sublists of LST are the non-empty lists returned\n"
- "by `(list-tail LST K)' for K less than the length of LST. If\n"
- "X does not occur in LST, then `#f' (not the empty list) is\n"
- "returned.")
+ "Return the first sublist of @var{lst} whose car is\n"
+ "@code{equal?} to @var{x} where the sublists of @var{lst} are\n"
+ "the non-empty lists returned by @code{(list-tail @var{lst}\n"
+ "@var{k})} for @var{k} less than the length of @var{lst}. If\n"
+ "@var{x} does not occur in @var{lst}, then @code{#f} (not the\n"
+ "empty list) is returned.")
#define FUNC_NAME s_scm_member
{
- SCM answer;
- SCM_VALIDATE_LIST (2,lst);
- answer = scm_sloppy_member (x, lst);
- return (SCM_NULLP (answer)) ? SCM_BOOL_F : answer;
+ SCM_VALIDATE_LIST (2, lst);
+ for (; !SCM_NULLP (lst); lst = SCM_CDR (lst))
+ {
+ if (! SCM_FALSEP (scm_equal_p (SCM_CAR (lst), x)))
+ return lst;
+ }
+ return SCM_BOOL_F;
}
#undef FUNC_NAME
-
\f
/* deleting elements from a list (delq, etc.) */
SCM_DEFINE (scm_delv_x, "delv!", 2, 0, 0,
- (SCM item, SCM lst),
- "Destructively remove all elements from LST that are `eqv?' to ITEM.")
+ (SCM item, SCM lst),
+ "Destructively remove all elements from @var{lst} that are\n"
+ "@code{eqv?} to @var{item}.")
#define FUNC_NAME s_scm_delv_x
{
SCM walk;
SCM_DEFINE (scm_delete_x, "delete!", 2, 0, 0,
- (SCM item, SCM lst),
- "Destructively remove all elements from LST that are `equal?' to ITEM.")
+ (SCM item, SCM lst),
+ "Destructively remove all elements from @var{lst} that are\n"
+ "@code{equal?} to @var{item}.")
#define FUNC_NAME s_scm_delete_x
{
SCM walk;
SCM_DEFINE (scm_delq, "delq", 2, 0, 0,
(SCM item, SCM lst),
- "Return a newly-created copy of @var{lst} with elements `eq?' to @var{item} removed.\n"
- "This procedure mirrors @code{memq}:\n"
- "@code{delq} compares elements of @var{lst} against @var{item} with\n"
- "@code{eq?}.")
+ "Return a newly-created copy of @var{lst} with elements\n"
+ "@code{eq?} to @var{item} removed. This procedure mirrors\n"
+ "@code{memq}: @code{delq} compares elements of @var{lst} against\n"
+ "@var{item} with @code{eq?}.")
#define FUNC_NAME s_scm_delq
{
SCM copy = scm_list_copy (lst);
SCM_DEFINE (scm_delv, "delv", 2, 0, 0,
(SCM item, SCM lst),
- "Return a newly-created copy of @var{lst} with elements `eqv?' to @var{item} removed.\n"
- "This procedure mirrors @code{memv}:\n"
- "@code{delv} compares elements of @var{lst} against @var{item} with\n"
- "@code{eqv?}.")
+ "Return a newly-created copy of @var{lst} with elements\n"
+ "@code{eqv?} to @var{item} removed. This procedure mirrors\n"
+ "@code{memv}: @code{delv} compares elements of @var{lst} against\n"
+ "@var{item} with @code{eqv?}.")
#define FUNC_NAME s_scm_delv
{
SCM copy = scm_list_copy (lst);
SCM_DEFINE (scm_delete, "delete", 2, 0, 0,
(SCM item, SCM lst),
- "Return a newly-created copy of @var{lst} with elements `equal?' to @var{item} removed.\n"
- "This procedure mirrors @code{member}:\n"
- "@code{delete} compares elements of @var{lst} against @var{item} with\n"
- "@code{equal?}.")
+ "Return a newly-created copy of @var{lst} with elements\n"
+ "@code{equal?} to @var{item} removed. This procedure mirrors\n"
+ "@code{member}: @code{delete} compares elements of @var{lst}\n"
+ "against @var{item} with @code{equal?}.")
#define FUNC_NAME s_scm_delete
{
SCM copy = scm_list_copy (lst);
SCM_DEFINE (scm_delq1_x, "delq1!", 2, 0, 0,
(SCM item, SCM lst),
- "Like `delq!', but only deletes the first occurrence of ITEM from LST.\n"
- "Tests for equality using `eq?'. See also `delv1!' and `delete1!'.")
+ "Like @code{delq!}, but only deletes the first occurrence of\n"
+ "@var{item} from @var{lst}. Tests for equality using\n"
+ "@code{eq?}. See also @code{delv1!} and @code{delete1!}.")
#define FUNC_NAME s_scm_delq1_x
{
SCM walk;
SCM_DEFINE (scm_delv1_x, "delv1!", 2, 0, 0,
(SCM item, SCM lst),
- "Like `delv!', but only deletes the first occurrence of ITEM from LST.\n"
- "Tests for equality using `eqv?'. See also `delq1!' and `delete1!'.")
+ "Like @code{delv!}, but only deletes the first occurrence of\n"
+ "@var{item} from @var{lst}. Tests for equality using\n"
+ "@code{eqv?}. See also @code{delq1!} and @code{delete1!}.")
#define FUNC_NAME s_scm_delv1_x
{
SCM walk;
SCM_DEFINE (scm_delete1_x, "delete1!", 2, 0, 0,
(SCM item, SCM lst),
- "Like `delete!', but only deletes the first occurrence of ITEM from LST.\n"
- "Tests for equality using `equal?'. See also `delq1!' and `delv1!'.")
+ "Like @code{delete!}, but only deletes the first occurrence of\n"
+ "@var{item} from @var{lst}. Tests for equality using\n"
+ "@code{equal?}. See also @code{delq1!} and @code{delv1!}.")
#define FUNC_NAME s_scm_delete1_x
{
SCM walk;
void
scm_init_list ()
{
+#ifndef SCM_MAGIC_SNARFER
#include "libguile/list.x"
+#endif
}
/*