mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-10 14:00:21 +02:00
Code Activity

* list.c, list.h: Use SCM_P instead of CPP hair. Doc fixes.

Browse source 
* list.c (scm_member, scm_memv, scm_memq): Return #f if a matching
element is not found, as per R4RS.
This commit is contained in:
Jim Blandy 1996-10-03 05:17:17 +00:00
parent e7247600b3
commit df13742c0a
2 changed files with 130 additions and 315 deletions
Download patch file Download diff file Expand all files Collapse all files

337
libguile/list.c
View file

@ -54,8 +54,9 @@
#endif
/* creating lists */
/* SCM_P won't help us deal with varargs here. */
#ifdef __STDC__
SCM
scm_listify (SCM elt, ...)
@ -64,7 +65,6 @@ SCM
scm_listify (elt, va_alist)
SCM elt;
va_dcl
#endif
{
va_list foo;
@ -85,14 +85,9 @@ scm_listify (elt, va_alist)
SCM_PROC(s_list, "list", 0, 0, 1, scm_list);
#ifdef __STDC__
SCM
scm_list(SCM objs)
#else
SCM
scm_list(objs)
SCM objs;
#endif
{
return objs;
}
@ -100,29 +95,20 @@ scm_list(objs)
/* general questions about lists --- null?, list?, length, etc. */
SCM_PROC(s_null_p, "null?", 1, 0, 0, scm_null_p);
#ifdef __STDC__
SCM
scm_null_p(SCM x)
#else
SCM
scm_null_p(x)
SCM x;
#endif
{
return SCM_NULLP(x) ? SCM_BOOL_T : SCM_BOOL_F;
}
SCM_PROC(s_list_p, "list?", 1, 0, 0, scm_list_p);
#ifdef __STDC__
SCM
scm_list_p(SCM x)
#else
SCM
scm_list_p(x)
SCM x;
#endif
{
if (scm_ilength(x)<0)
return SCM_BOOL_F;
@ -131,41 +117,41 @@ scm_list_p(x)
}
#ifdef __STDC__
long
scm_ilength(SCM sx)
#else
/* Return the length of SX, or -1 if it's not a proper list.
This uses the "tortise and hare" algorithm to detect "infinitely
long" lists (i.e. lists with cycles in their cdrs), and returns -1
if it does find one. */
long
scm_ilength(sx)
SCM sx;
#endif
{
register long i = 0;
register SCM x = sx;
register SCM tortise = sx;
register SCM hare = sx;
do {
if SCM_IMP(x) return SCM_NULLP(x) ? i : -1;
if SCM_NCONSP(x) return -1;
x = SCM_CDR(x);
if SCM_IMP(hare) return SCM_NULLP(hare) ? i : -1;
if SCM_NCONSP(hare) return -1;
hare = SCM_CDR(hare);
i++;
if SCM_IMP(x) return SCM_NULLP(x) ? i : -1;
if SCM_NCONSP(x) return -1;
x = SCM_CDR(x);
if SCM_IMP(hare) return SCM_NULLP(hare) ? i : -1;
if SCM_NCONSP(hare) return -1;
hare = SCM_CDR(hare);
i++;
sx = SCM_CDR(sx);
/* For every two steps the hare takes, the tortise takes one. */
tortise = SCM_CDR(tortise);
}
while (x != sx);
while (hare != tortise);
/* If the tortise ever catches the hare, then the list must contain
a cycle. */
return -1;
}
SCM_PROC(s_list_length, "list-length", 1, 0, 0, scm_list_length);
#ifdef __STDC__
SCM
scm_list_length(SCM x)
#else
SCM
scm_list_length(x)
SCM x;
#endif
{
int i;
i = scm_ilength(x);
@ -175,16 +161,12 @@ scm_list_length(x)
/* appending lists */
SCM_PROC (s_list_append, "list-append", 0, 0, 1, scm_list_append);
#ifdef __STDC__
SCM
scm_list_append(SCM args)
#else
SCM
scm_list_append(args)
SCM args;
#endif
{
SCM res = SCM_EOL;
SCM *lloc = &res, arg;
@ -213,14 +195,9 @@ scm_list_append(args)
SCM_PROC (s_list_append_x, "list-append!", 0, 0, 1, scm_list_append_x);
#ifdef __STDC__
SCM
scm_list_append_x(SCM args)
#else
SCM
scm_list_append_x(args)
SCM args;
#endif
{
SCM arg;
tail:
@ -235,18 +212,37 @@ scm_list_append_x(args)
}
SCM_PROC(s_last_pair, "last-pair", 1, 0, 0, scm_last_pair);
SCM
scm_last_pair(sx)
SCM sx;
{
register SCM res = sx;
register SCM x;
if (SCM_NULLP (sx))
return SCM_EOL;
SCM_ASSERT(SCM_NIMP(res) && SCM_CONSP(res), res, SCM_ARG1, s_last_pair);
while (!0) {
x = SCM_CDR(res);
if (SCM_IMP(x) || SCM_NCONSP(x)) return res;
res = x;
x = SCM_CDR(res);
if (SCM_IMP(x) || SCM_NCONSP(x)) return res;
res = x;
sx = SCM_CDR(sx);
SCM_ASSERT(x != sx, sx, SCM_ARG1, s_last_pair);
}
}
/* reversing lists */
SCM_PROC (s_list_reverse, "list-reverse", 1, 0, 0, scm_list_reverse);
#ifdef __STDC__
SCM
scm_list_reverse(SCM lst)
#else
SCM
scm_list_reverse(lst)
SCM lst;
#endif
{
SCM res = SCM_EOL;
SCM p = lst;
@ -259,15 +255,10 @@ scm_list_reverse(lst)
}
SCM_PROC (s_list_reverse_x, "list-reverse!", 1, 1, 0, scm_list_reverse_x);
#ifdef __STDC__
SCM
scm_list_reverse_x (SCM lst, SCM newtail)
#else
SCM
scm_list_reverse_x (lst, newtail)
SCM lst;
SCM newtail;
#endif
{
SCM old_tail;
if (newtail == SCM_UNDEFINED)
@ -289,18 +280,13 @@ scm_list_reverse_x (lst, newtail)
/* indexing lists by element number */
SCM_PROC(s_list_ref, "list-ref", 2, 0, 0, scm_list_ref);
#ifdef __STDC__
SCM
scm_list_ref(SCM lst, SCM k)
#else
SCM
scm_list_ref(lst, k)
SCM lst;
SCM k;
#endif
{
register long i;
SCM_ASSERT(SCM_INUMP(k), k, SCM_ARG2, s_list_ref);
@ -316,16 +302,11 @@ erout: SCM_ASSERT(SCM_NIMP(lst) && SCM_CONSP(lst),
}
SCM_PROC(s_list_set_x, "list-set!", 3, 0, 0, scm_list_set_x);
#ifdef __STDC__
SCM
scm_list_set_x(SCM lst, SCM k, SCM val)
#else
SCM
scm_list_set_x(lst, k, val)
SCM lst;
SCM k;
SCM val;
#endif
{
register long i;
SCM_ASSERT(SCM_INUMP(k), k, SCM_ARG2, s_list_set_x);
@ -342,18 +323,30 @@ erout: SCM_ASSERT(SCM_NIMP(lst) && SCM_CONSP(lst),
}
SCM_PROC(s_list_cdr_ref, "list-cdr-ref", 2, 0, 0, scm_list_tail);
SCM_PROC(s_list_tail, "list-tail", 2, 0, 0, scm_list_tail);
SCM
scm_list_tail(lst, k)
SCM lst;
SCM k;
{
register long i;
SCM_ASSERT(SCM_INUMP(k), k, SCM_ARG2, s_list_tail);
i = SCM_INUM(k);
while (i-- > 0) {
SCM_ASSERT(SCM_NIMP(lst) && SCM_CONSP(lst), lst, SCM_ARG1, s_list_tail);
lst = SCM_CDR(lst);
}
return lst;
}
SCM_PROC(s_list_cdr_set_x, "list-cdr-set!", 3, 0, 0, scm_list_cdr_set_x);
#ifdef __STDC__
SCM
scm_list_cdr_set_x(SCM lst, SCM k, SCM val)
#else
SCM
scm_list_cdr_set_x(lst, k, val)
SCM lst;
SCM k;
SCM val;
#endif
{
register long i;
SCM_ASSERT(SCM_INUMP(k), k, SCM_ARG2, s_list_cdr_set_x);
@ -371,71 +364,13 @@ erout: SCM_ASSERT(SCM_NIMP(lst) && SCM_CONSP(lst),
SCM_PROC(s_last_pair, "last-pair", 1, 0, 0, scm_last_pair);
#ifdef __STDC__
SCM
scm_last_pair(SCM sx)
#else
SCM
scm_last_pair(sx)
SCM sx;
#endif
{
register SCM res = sx;
register SCM x;
if (SCM_NULLP (sx))
return SCM_EOL;
SCM_ASSERT(SCM_NIMP(res) && SCM_CONSP(res), res, SCM_ARG1, s_last_pair);
while (!0) {
x = SCM_CDR(res);
if (SCM_IMP(x) || SCM_NCONSP(x)) return res;
res = x;
x = SCM_CDR(res);
if (SCM_IMP(x) || SCM_NCONSP(x)) return res;
res = x;
sx = SCM_CDR(sx);
SCM_ASSERT(x != sx, sx, SCM_ARG1, s_last_pair);
}
}
SCM_PROC(s_list_cdr_ref, "list-cdr-ref", 2, 0, 0, scm_list_tail);
SCM_PROC(s_list_tail, "list-tail", 2, 0, 0, scm_list_tail);
#ifdef __STDC__
SCM
scm_list_tail(SCM lst, SCM k)
#else
SCM
scm_list_tail(lst, k)
SCM lst;
SCM k;
#endif
{
register long i;
SCM_ASSERT(SCM_INUMP(k), k, SCM_ARG2, s_list_tail);
i = SCM_INUM(k);
while (i-- > 0) {
SCM_ASSERT(SCM_NIMP(lst) && SCM_CONSP(lst), lst, SCM_ARG1, s_list_tail);
lst = SCM_CDR(lst);
}
return lst;
}
/* copying lists, perhaps partially */
SCM_PROC(s_list_head, "list-head", 2, 0, 0, scm_list_head);
#ifdef __STDC__
SCM
scm_list_head(SCM lst, SCM k)
#else
SCM
scm_list_head(lst, k)
SCM lst;
SCM k;
#endif
{
SCM answer;
SCM * pos;
@ -456,33 +391,50 @@ scm_list_head(lst, k)
}
SCM_PROC (s_list_copy, "list-copy", 1, 0, 0, scm_list_copy);
SCM
scm_list_copy (lst)
SCM lst;
{
SCM newlst;
SCM * fill_here;
SCM from_here;
newlst = SCM_EOL;
fill_here = &newlst;
from_here = lst;
while (SCM_NIMP (from_here) && SCM_CONSP (from_here))
{
SCM c;
c = scm_cons (SCM_CAR (from_here), SCM_CDR (from_here));
*fill_here = c;
fill_here = &SCM_CDR (c);
from_here = SCM_CDR (from_here);
}
return newlst;
}
/* membership tests (memq, memv, etc.) */
static void sloppy_mem_check SCM_P ((SCM obj, char * where, char * why));
#ifdef __STDC__
static void
sloppy_mem_check (SCM obj, char * where, char * why)
#else
static void
sloppy_mem_check (obj, where, why)
SCM obj;
char * where;
char * why;
#endif
{
SCM_ASSERT ((scm_ilength (obj) >= 0), obj, where, why);
}
SCM_PROC (s_sloppy_memq, "sloppy-memq", 2, 0, 0, scm_sloppy_memq);
#ifdef __STDC__
SCM
scm_sloppy_memq(SCM x, SCM lst)
#else
SCM
scm_sloppy_memq(x, lst)
SCM x;
SCM lst;
#endif
{
for(; SCM_NIMP(lst) && SCM_CONSP (lst); lst = SCM_CDR(lst))
{
@ -494,15 +446,10 @@ scm_sloppy_memq(x, lst)
SCM_PROC (s_sloppy_memv, "sloppy-memv", 2, 0, 0, scm_sloppy_memv);
#ifdef __STDC__
SCM
scm_sloppy_memv(SCM x, SCM lst)
#else
SCM
scm_sloppy_memv(x, lst)
SCM x;
SCM lst;
#endif
{
for(; SCM_NIMP(lst) && SCM_CONSP (lst); lst = SCM_CDR(lst))
{
@ -514,15 +461,10 @@ scm_sloppy_memv(x, lst)
SCM_PROC (s_sloppy_member, "sloppy-member", 2, 0, 0, scm_sloppy_member);
#ifdef __STDC__
SCM
scm_sloppy_member (SCM x, SCM lst)
#else
SCM
scm_sloppy_member (x, lst)
SCM x;
SCM lst;
#endif
{
for(; SCM_NIMP(lst) && SCM_CONSP (lst); lst = SCM_CDR(lst))
{
@ -535,72 +477,53 @@ scm_sloppy_member (x, lst)
SCM_PROC(s_memq, "memq", 2, 0, 0, scm_memq);
#ifdef __STDC__
SCM
scm_memq(SCM x, SCM lst)
#else
SCM
scm_memq(x, lst)
SCM x;
SCM lst;
#endif
{
SCM answer;
answer = scm_sloppy_memq (x, lst);
sloppy_mem_check (answer, (char *)SCM_ARG2, s_memq);
return answer;
return (answer == SCM_EOL) ? SCM_BOOL_F : answer;
}
SCM_PROC(s_memv, "memv", 2, 0, 0, scm_memv);
#ifdef __STDC__
SCM
scm_memv(SCM x, SCM lst)
#else
SCM
scm_memv(x, lst)
SCM x;
SCM lst;
#endif
{
SCM answer;
answer = scm_sloppy_memv (x, lst);
sloppy_mem_check (answer, (char *)SCM_ARG2, s_memv);
return answer;
return (answer == SCM_EOL) ? SCM_BOOL_F : answer;
}
SCM_PROC(s_member, "member", 2, 0, 0, scm_member);
#ifdef __STDC__
SCM
scm_member(SCM x, SCM lst)
#else
SCM
scm_member(x, lst)
SCM x;
SCM lst;
#endif
{
SCM answer;
answer = scm_sloppy_member (x, lst);
sloppy_mem_check (answer, (char *)SCM_ARG2, s_member);
return answer;
return (answer == SCM_EOL) ? SCM_BOOL_F : answer;
}
/* deleting elements from a list (delq, etc.) */
SCM_PROC(s_delq_x, "delq!", 2, 0, 0, scm_delq_x);
#ifdef __STDC__
SCM
scm_delq_x (SCM item, SCM lst)
#else
SCM
scm_delq_x (item, lst)
SCM item;
SCM lst;
#endif
{
SCM start;
@ -626,15 +549,10 @@ scm_delq_x (item, lst)
SCM_PROC(s_delv_x, "delv!", 2, 0, 0, scm_delv_x);
#ifdef __STDC__
SCM
scm_delv_x (SCM item, SCM lst)
#else
SCM
scm_delv_x (item, lst)
SCM item;
SCM lst;
#endif
{
SCM start;
@ -661,15 +579,10 @@ scm_delv_x (item, lst)
SCM_PROC(s_delete_x, "delete!", 2, 0, 0, scm_delete_x);
#ifdef __STDC__
SCM
scm_delete_x (SCM item, SCM lst)
#else
SCM
scm_delete_x (item, lst)
SCM item;
SCM lst;
#endif
{
SCM start;
@ -696,47 +609,12 @@ scm_delete_x (item, lst)
SCM_PROC (s_list_copy, "list-copy", 1, 0, 0, scm_list_copy);
#ifdef __STDC__
SCM
scm_list_copy (SCM lst)
#else
SCM
scm_list_copy (lst)
SCM lst;
#endif
{
SCM newlst;
SCM * fill_here;
SCM from_here;
newlst = SCM_EOL;
fill_here = &newlst;
from_here = lst;
while (SCM_NIMP (from_here) && SCM_CONSP (from_here))
{
SCM c;
c = scm_cons (SCM_CAR (from_here), SCM_CDR (from_here));
*fill_here = c;
fill_here = &SCM_CDR (c);
from_here = SCM_CDR (from_here);
}
return newlst;
}
SCM_PROC (s_delq, "delq", 2, 0, 0, scm_delq);
#ifdef __STDC__
SCM
scm_delq (SCM item, SCM lst)
#else
SCM
scm_delq (item, lst)
SCM item;
SCM lst;
#endif
{
SCM copy;
@ -745,15 +623,10 @@ scm_delq (item, lst)
}
SCM_PROC (s_delv, "delv", 2, 0, 0, scm_delv);
#ifdef __STDC__
SCM
scm_delv (SCM item, SCM lst)
#else
SCM
scm_delv (item, lst)
SCM item;
SCM lst;
#endif
{
SCM copy;
@ -762,15 +635,10 @@ scm_delv (item, lst)
}
SCM_PROC (s_delete, "delete", 2, 0, 0, scm_delete);
#ifdef __STDC__
SCM
scm_delete (SCM item, SCM lst)
#else
SCM
scm_delete (item, lst)
SCM item;
SCM lst;
#endif
{
SCM copy;
@ -780,15 +648,8 @@ scm_delete (item, lst)
#ifdef __STDC__
void
scm_init_list (void)
#else
void
scm_init_list ()
#endif
{
#include "list.x"
}

108
libguile/list.h
View file

@ -47,82 +47,36 @@
#include "libguile/__scm.h"
#ifdef __STDC__
extern SCM scm_list_head (SCM lst, SCM k);
extern SCM scm_listify (SCM elt, ...);
extern SCM scm_list(SCM objs);
extern SCM scm_null_p(SCM x);
extern SCM scm_list_p(SCM x);
extern long scm_ilength(SCM sx);
extern SCM scm_list_length(SCM x);
extern SCM scm_list_append(SCM args);
extern SCM scm_list_append_x(SCM args);
extern SCM scm_list_reverse(SCM lst);
extern SCM scm_list_reverse_x (SCM lst, SCM newtail);
extern SCM scm_list_ref(SCM lst, SCM k);
extern SCM scm_list_set_x(SCM lst, SCM k, SCM val);
extern SCM scm_list_cdr_ref(SCM lst, SCM k);
extern SCM scm_list_cdr_set_x(SCM lst, SCM k, SCM val);
extern SCM scm_last_pair(SCM sx);
extern SCM scm_list_tail(SCM lst, SCM k);
extern SCM scm_sloppy_memq(SCM x, SCM lst);
extern SCM scm_sloppy_memv(SCM x, SCM lst);
extern SCM scm_sloppy_member (SCM x, SCM lst);
extern SCM scm_memq(SCM x, SCM lst);
extern SCM scm_memv(SCM x, SCM lst);
extern SCM scm_member(SCM x, SCM lst);
extern SCM scm_delq_x (SCM item, SCM lst);
extern SCM scm_delv_x (SCM item, SCM lst);
extern SCM scm_delete_x (SCM item, SCM lst);
extern SCM scm_list_copy (SCM lst);
extern SCM scm_delq (SCM item, SCM lst);
extern SCM scm_delv (SCM item, SCM lst);
extern SCM scm_delete (SCM item, SCM lst);
extern void scm_init_list (void);
#else /* STDC */
extern SCM scm_list_head ();
extern SCM scm_listify ();
extern SCM scm_list();
extern SCM scm_null_p();
extern SCM scm_list_p();
extern long scm_ilength();
extern SCM scm_list_length();
extern SCM scm_list_append();
extern SCM scm_list_append_x();
extern SCM scm_list_reverse();
extern SCM scm_list_reverse_x ();
extern SCM scm_list_ref();
extern SCM scm_list_set_x();
extern SCM scm_list_cdr_ref();
extern SCM scm_list_cdr_set_x();
extern SCM scm_last_pair();
extern SCM scm_list_tail();
extern SCM scm_sloppy_memq();
extern SCM scm_sloppy_memv();
extern SCM scm_sloppy_member ();
extern SCM scm_memq();
extern SCM scm_memv();
extern SCM scm_member();
extern SCM scm_delq_x ();
extern SCM scm_delv_x ();
extern SCM scm_delete_x ();
extern SCM scm_list_copy ();
extern SCM scm_delq ();
extern SCM scm_delv ();
extern SCM scm_delete ();
extern void scm_init_list ();
#endif /* STDC */
extern SCM scm_list_head SCM_P ((SCM lst, SCM k));
extern SCM scm_listify SCM_P ((SCM elt, ...));
extern SCM scm_list SCM_P ((SCM objs));
extern SCM scm_null_p SCM_P ((SCM x));
extern SCM scm_list_p SCM_P ((SCM x));
extern long scm_ilength SCM_P ((SCM sx));
extern SCM scm_list_length SCM_P ((SCM x));
extern SCM scm_list_append SCM_P ((SCM args));
extern SCM scm_list_append_x SCM_P ((SCM args));
extern SCM scm_list_reverse SCM_P ((SCM lst));
extern SCM scm_list_reverse_x SCM_P ((SCM lst, SCM newtail));
extern SCM scm_list_ref SCM_P ((SCM lst, SCM k));
extern SCM scm_list_set_x SCM_P ((SCM lst, SCM k, SCM val));
extern SCM scm_list_cdr_ref SCM_P ((SCM lst, SCM k));
extern SCM scm_list_cdr_set_x SCM_P ((SCM lst, SCM k, SCM val));
extern SCM scm_last_pair SCM_P ((SCM sx));
extern SCM scm_list_tail SCM_P ((SCM lst, SCM k));
extern SCM scm_sloppy_memq SCM_P ((SCM x, SCM lst));
extern SCM scm_sloppy_memv SCM_P ((SCM x, SCM lst));
extern SCM scm_sloppy_member SCM_P ((SCM x, SCM lst));
extern SCM scm_memq SCM_P ((SCM x, SCM lst));
extern SCM scm_memv SCM_P ((SCM x, SCM lst));
extern SCM scm_member SCM_P ((SCM x, SCM lst));
extern SCM scm_delq_x SCM_P ((SCM item, SCM lst));
extern SCM scm_delv_x SCM_P ((SCM item, SCM lst));
extern SCM scm_delete_x SCM_P ((SCM item, SCM lst));
extern SCM scm_list_copy SCM_P ((SCM lst));
extern SCM scm_delq SCM_P ((SCM item, SCM lst));
extern SCM scm_delv SCM_P ((SCM item, SCM lst));
extern SCM scm_delete SCM_P ((SCM item, SCM lst));
extern void scm_init_list SCM_P ((void));
#endif /* LISTH */