\f
#include <stdio.h>
-#include "_scm.h"
-#include "eq.h"
+#include "libguile/_scm.h"
+#include "libguile/eq.h"
-#include "scm_validate.h"
-#include "list.h"
+#include "libguile/validate.h"
+#include "libguile/list.h"
#ifdef __STDC__
#include <stdarg.h>
\f
/* creating lists */
-/* SCM_P won't help us deal with varargs here. */
SCM
scm_listify (SCM elt, ...)
{
va_list foo;
- SCM answer;
- SCM *pos;
+ SCM answer = SCM_EOL;
+ SCM *pos = &answer;
var_start (foo, elt);
- answer = SCM_EOL;
- pos = &answer;
- while (elt != SCM_UNDEFINED)
+ while (! SCM_UNBNDP (elt))
{
*pos = scm_cons (elt, SCM_EOL);
pos = SCM_CDRLOC (*pos);
SCM_DEFINE (scm_list, "list", 0, 0, 1,
(SCM objs),
-"")
+ "Return a list containing OBJS, the arguments to `list'.")
#define FUNC_NAME s_scm_list
{
return objs;
SCM_DEFINE (scm_list_star, "list*", 1, 0, 1,
(SCM arg, SCM rest),
-"")
+ "Return an improper list of the arguments.")
#define FUNC_NAME s_scm_list_star
{
if (SCM_NNULLP (rest))
SCM_DEFINE (scm_null_p, "null?", 1, 0, 0,
(SCM x),
-"")
+ "Return #t iff X is the empty list, else #f.")
#define FUNC_NAME s_scm_null_p
{
- return SCM_BOOL(SCM_NULLP(x));
+ return SCM_BOOL (SCM_NULLP (x));
}
#undef FUNC_NAME
+
SCM_DEFINE (scm_list_p, "list?", 1, 0, 0,
(SCM x),
-"")
+ "Return #t iff X is a proper list, else #f.")
#define FUNC_NAME s_scm_list_p
{
- return SCM_BOOL(scm_ilength(x)>=0);
+ return SCM_BOOL (scm_ilength (x) >= 0);
}
#undef FUNC_NAME
/* For every two steps the hare takes, the tortoise takes one. */
tortoise = SCM_CDR(tortoise);
}
- while (hare != tortoise);
+ while (! SCM_EQ_P (hare, tortoise));
/* If the tortoise ever catches the hare, then the list must contain
a cycle. */
return -1;
}
+
SCM_DEFINE (scm_length, "length", 1, 0, 0,
(SCM lst),
-"")
+ "Return the number of elements in list LST.")
#define FUNC_NAME s_scm_length
{
int i;
SCM_DEFINE (scm_append, "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.")
+ "Returns a list consisting of the elements of the first LIST\n"
+ "followed by the elements of the other LISTs.\n"
+ "\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"
+ "\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"
+
+ " (append '(a b) '(c . d)) => (a b c . d)\n"
+ " (append '() 'a) => a\n")
#define FUNC_NAME s_scm_append
{
SCM res = SCM_EOL;
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.")
#define FUNC_NAME s_scm_append_x
{
SCM arg;
hare = ahead;
tortoise = SCM_CDR(tortoise);
}
- while (hare != tortoise);
+ while (! SCM_EQ_P (hare, tortoise));
SCM_MISC_ERROR ("Circular structure in position 1: ~S", SCM_LIST1 (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.")
#define FUNC_NAME s_scm_reverse
{
SCM result = SCM_EOL;
hare = SCM_CDR (hare);
tortoise = SCM_CDR (tortoise);
}
- while (hare != tortoise);
+ while (! SCM_EQ_P (hare, tortoise));
SCM_MISC_ERROR ("Circular structure in position 1: ~S", SCM_LIST1 (lst));
}
#undef FUNC_NAME
SCM_DEFINE (scm_list_ref, "list-ref", 2, 0, 0,
(SCM lst, SCM k),
- "")
+ "Return the Kth element from list LST.")
#define FUNC_NAME s_scm_list_ref
{
register long i;
SCM_DEFINE (scm_sloppy_memq, "sloppy-memq", 2, 0, 0,
(SCM x, SCM lst),
- "@deffnx primitive sloppy-memv\n"
- "@deffnx primitive sloppy-member\n"
- "These procedures behave like @code{memq}, @code{memv} and @code{member}\n"
- "(@pxref{Pairs and Lists,,,r4rs, The Revised^4 Report on Scheme}), but do\n"
- "not perform any type or error checking. Their use is recommended only\n"
- "in writing Guile internals, not for high-level Scheme programs.")
+ "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_CAR(lst)==x)
+ if (SCM_EQ_P (SCM_CAR (lst), x))
return lst;
}
return lst;
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_BOOL_F != scm_eqv_p (SCM_CAR(lst), x))
+ if (! SCM_FALSEP (scm_eqv_p (SCM_CAR (lst), x)))
return lst;
}
return lst;
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
{
for(; SCM_CONSP (lst); lst = SCM_CDR(lst))
{
- if (SCM_BOOL_F != scm_equal_p (SCM_CAR(lst), x))
+ if (! SCM_FALSEP (scm_equal_p (SCM_CAR (lst), x)))
return lst;
}
return lst;
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.")
#define FUNC_NAME s_scm_memq
{
SCM answer;
SCM_VALIDATE_LIST (2,lst);
answer = scm_sloppy_memq (x, lst);
- return (answer == SCM_EOL) ? SCM_BOOL_F : answer;
+ return (SCM_NULLP (answer)) ? SCM_BOOL_F : answer;
}
#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.")
#define FUNC_NAME s_scm_memv
{
SCM answer;
SCM_VALIDATE_LIST (2,lst);
answer = scm_sloppy_memv (x, lst);
- return (answer == SCM_EOL) ? SCM_BOOL_F : answer;
+ return (SCM_NULLP (answer)) ? SCM_BOOL_F : answer;
}
#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.")
#define FUNC_NAME s_scm_member
{
SCM answer;
SCM_VALIDATE_LIST (2,lst);
answer = scm_sloppy_member (x, lst);
- return (answer == SCM_EOL) ? SCM_BOOL_F : answer;
+ return (SCM_NULLP (answer)) ? SCM_BOOL_F : answer;
}
#undef FUNC_NAME
SCM_CONSP (walk);
walk = SCM_CDR (walk))
{
- if (SCM_CAR (walk) == item)
+ if (SCM_EQ_P (SCM_CAR (walk), item))
*prev = SCM_CDR (walk);
else
prev = SCM_CDRLOC (walk);
SCM_DEFINE (scm_delv_x, "delv!", 2, 0, 0,
(SCM item, SCM lst),
- "")
+ "Destructively remove all elements from LST that are `eqv?' to ITEM.")
#define FUNC_NAME s_scm_delv_x
{
SCM walk;
SCM_CONSP (walk);
walk = SCM_CDR (walk))
{
- if (SCM_BOOL_F != scm_eqv_p (SCM_CAR (walk), item))
+ if (! SCM_FALSEP (scm_eqv_p (SCM_CAR (walk), item)))
*prev = SCM_CDR (walk);
else
prev = SCM_CDRLOC (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.")
#define FUNC_NAME s_scm_delete_x
{
SCM walk;
SCM_CONSP (walk);
walk = SCM_CDR (walk))
{
- if (SCM_BOOL_F != scm_equal_p (SCM_CAR (walk), item))
+ if (! SCM_FALSEP (scm_equal_p (SCM_CAR (walk), item)))
*prev = SCM_CDR (walk);
else
prev = SCM_CDRLOC (walk);
SCM_DEFINE (scm_delq, "delq", 2, 0, 0,
(SCM item, SCM lst),
- "@deffnx primitive delv item lst\n"
- "@deffnx primitive delete item lst\n"
- "Return a newly-created copy of @var{lst} with @var{item} removed. These\n"
- "procedures mirror @code{memq}, @code{memv} and @code{member}:\n"
+ "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?}, @code{delv} uses @code{eqv?} and @code{delete} uses @code{equal?}")
+ "@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?}.")
#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?}.")
#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!'.")
#define FUNC_NAME s_scm_delq1_x
{
SCM walk;
SCM_CONSP (walk);
walk = SCM_CDR (walk))
{
- if (SCM_CAR (walk) == item)
+ if (SCM_EQ_P (SCM_CAR (walk), item))
{
*prev = SCM_CDR (walk);
break;
SCM_DEFINE (scm_delv1_x, "delv1!", 2, 0, 0,
- (SCM item, SCM lst),
- "")
+ (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!'.")
#define FUNC_NAME s_scm_delv1_x
{
SCM walk;
SCM_CONSP (walk);
walk = SCM_CDR (walk))
{
- if (SCM_BOOL_F != scm_eqv_p (SCM_CAR (walk), item))
+ if (! SCM_FALSEP (scm_eqv_p (SCM_CAR (walk), item)))
{
*prev = SCM_CDR (walk);
break;
SCM_DEFINE (scm_delete1_x, "delete1!", 2, 0, 0,
- (SCM item, SCM lst),
- "")
+ (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!'.")
#define FUNC_NAME s_scm_delete1_x
{
SCM walk;
SCM_CONSP (walk);
walk = SCM_CDR (walk))
{
- if (SCM_BOOL_F != scm_equal_p (SCM_CAR (walk), item))
+ if (! SCM_FALSEP (scm_equal_p (SCM_CAR (walk), item)))
{
*prev = SCM_CDR (walk);
break;
void
scm_init_list ()
{
-#include "list.x"
+#include "libguile/list.x"
}
+
+/*
+ Local Variables:
+ c-file-style: "gnu"
+ End:
+*/
HCoop / bpt / guile.git / blobdiff