-/* Copyright (C) 1995,1996 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1997 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
*
* You should have received a copy of the GNU General Public License
* along with this software; see the file COPYING. If not, write to
- * the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+ * the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
+ * Boston, MA 02111-1307 USA
*
* As a special exception, the Free Software Foundation gives permission
* for additional uses of the text contained in its release of GUILE.
*
* If you write modifications of your own for GUILE, it is your choice
* whether to permit this exception to apply to your modifications.
- * If you do not wish that, delete this exception notice.
- */
+ * If you do not wish that, delete this exception notice. */
\f
#include <stdio.h>
#include "_scm.h"
#endif
\f
+/* creating lists */
-
+/* SCM_P won't help us deal with varargs here. */
#ifdef __STDC__
SCM
scm_listify (SCM elt, ...)
scm_listify (elt, va_alist)
SCM elt;
va_dcl
-
#endif
{
va_list foo;
while (elt != SCM_UNDEFINED)
{
*pos = scm_cons (elt, SCM_EOL);
- pos = &SCM_CDR (*pos);
+ pos = SCM_CDRLOC (*pos);
elt = va_arg (foo, SCM);
}
return answer;
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;
}
+SCM_PROC (s_list_star, "list*", 1, 0, 1, scm_list_star);
+
+SCM
+scm_list_star (SCM arg, SCM rest)
+{
+ if (SCM_NIMP (rest))
+ {
+ SCM prev = arg = scm_cons (arg, rest);
+ while (SCM_NIMP (SCM_CDR (rest)))
+ {
+ prev = rest;
+ rest = SCM_CDR (rest);
+ }
+ SCM_SETCDR (prev, SCM_CAR (rest));
+ }
+ return arg;
+}
+
+
\f
+/* 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;
}
-#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 "tortoise 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 tortoise = 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 tortoise takes one. */
+ tortoise = SCM_CDR(tortoise);
}
- while (x != sx);
+ while (hare != tortoise);
+
+ /* If the tortoise 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_PROC(s_length, "length", 1, 0, 0, scm_length);
SCM
-scm_list_length(SCM x)
-#else
-SCM
-scm_list_length(x)
+scm_length(x)
SCM x;
-#endif
{
int i;
i = scm_ilength(x);
- SCM_ASSERT(i >= 0, x, SCM_ARG1, s_list_length);
+ SCM_ASSERT(i >= 0, x, SCM_ARG1, s_length);
return SCM_MAKINUM (i);
}
\f
+/* 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_PROC (s_append, "append", 0, 0, 1, scm_append);
SCM
-scm_list_append(args)
+scm_append(args)
SCM args;
-#endif
{
SCM res = SCM_EOL;
SCM *lloc = &res, arg;
- if SCM_IMP(args) {
- SCM_ASSERT(SCM_NULLP(args), args, SCM_ARGn, s_list_append);
+ if (SCM_IMP(args)) {
+ SCM_ASSERT(SCM_NULLP(args), args, SCM_ARGn, s_append);
return res;
}
- SCM_ASSERT(SCM_CONSP(args), args, SCM_ARGn, s_list_append);
+ SCM_ASSERT(SCM_CONSP(args), args, SCM_ARGn, s_append);
while (1) {
arg = SCM_CAR(args);
args = SCM_CDR(args);
- if SCM_IMP(args) {
+ if (SCM_IMP(args)) {
*lloc = arg;
- SCM_ASSERT(SCM_NULLP(args), args, SCM_ARGn, s_list_append);
+ SCM_ASSERT(SCM_NULLP(args), args, SCM_ARGn, s_append);
return res;
}
- SCM_ASSERT(SCM_CONSP(args), args, SCM_ARGn, s_list_append);
+ SCM_ASSERT(SCM_CONSP(args), args, SCM_ARGn, s_append);
for(;SCM_NIMP(arg);arg = SCM_CDR(arg)) {
- SCM_ASSERT(SCM_CONSP(arg), arg, SCM_ARGn, s_list_append);
+ SCM_ASSERT(SCM_CONSP(arg), arg, SCM_ARGn, s_append);
*lloc = scm_cons(SCM_CAR(arg), SCM_EOL);
- lloc = &SCM_CDR(*lloc);
+ lloc = SCM_CDRLOC(*lloc);
}
- SCM_ASSERT(SCM_NULLP(arg), arg, SCM_ARGn, s_list_append);
+ SCM_ASSERT(SCM_NULLP(arg), arg, SCM_ARGn, s_append);
}
}
-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_PROC (s_append_x, "append!", 0, 0, 1, scm_append_x);
SCM
-scm_list_append_x(args)
+scm_append_x(args)
SCM args;
-#endif
{
SCM arg;
tail:
- if SCM_NULLP(args) return SCM_EOL;
+ if (SCM_NULLP(args)) return SCM_EOL;
arg = SCM_CAR(args);
- SCM_ASSERT(SCM_NULLP(arg) || (SCM_NIMP(arg) && SCM_CONSP(arg)), arg, SCM_ARG1, s_list_append_x);
args = SCM_CDR(args);
- if SCM_NULLP(args) return arg;
- if SCM_NULLP(arg) goto tail;
- SCM_CDR(scm_last_pair(arg)) = scm_list_append_x(args);
+ if (SCM_NULLP(args)) return arg;
+ if (SCM_NULLP(arg)) goto tail;
+ SCM_ASSERT(SCM_NIMP(arg) && SCM_CONSP(arg), arg, SCM_ARG1, s_append_x);
+ SCM_SETCDR (scm_last_pair (arg), scm_append_x (args));
return arg;
}
+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);
+ }
+}
+
\f
+/* reversing lists */
+SCM_PROC (s_reverse, "reverse", 1, 0, 0, scm_reverse);
-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_reverse (SCM ls)
{
- SCM res = SCM_EOL;
- SCM p = lst;
- for(;SCM_NIMP(p);p = SCM_CDR(p)) {
- SCM_ASSERT(SCM_CONSP(p), lst, SCM_ARG1, s_list_reverse);
- res = scm_cons(SCM_CAR(p), res);
- }
- SCM_ASSERT(SCM_NULLP(p), lst, SCM_ARG1, s_list_reverse);
- return res;
+ SCM res = SCM_EOL;
+ SCM p = ls, t = ls;
+ while (SCM_NIMP (p))
+ {
+ SCM_ASSERT (SCM_CONSP (p), ls, SCM_ARG1, s_reverse);
+ res = scm_cons (SCM_CAR (p), res);
+ p = SCM_CDR (p);
+ if (SCM_IMP (p))
+ break;
+ SCM_ASSERT (SCM_CONSP (p), ls, SCM_ARG1, s_reverse);
+ res = scm_cons (SCM_CAR (p), res);
+ p = SCM_CDR (p);
+ t = SCM_CDR (t);
+ if (t == p)
+ scm_misc_error (s_reverse, "Circular structure: %S", SCM_LIST1 (ls));
+ }
+ SCM_ASSERT (SCM_NULLP (p), ls, SCM_ARG1, s_reverse);
+ return res;
}
-SCM_PROC (s_list_reverse_x, "list-reverse!", 1, 1, 0, scm_list_reverse_x);
-#ifdef __STDC__
+SCM_PROC (s_reverse_x, "reverse!", 1, 1, 0, scm_reverse_x);
SCM
-scm_list_reverse_x (SCM lst, SCM newtail)
-#else
-SCM
-scm_list_reverse_x (lst, newtail)
- SCM lst;
- SCM newtail;
-#endif
+scm_reverse_x (ls, new_tail)
+ SCM ls;
+ SCM new_tail;
{
SCM old_tail;
- if (newtail == SCM_UNDEFINED)
- newtail = SCM_EOL;
-
- loop:
- if (!(SCM_NIMP (lst) && SCM_CONSP (lst)))
- return lst;
-
- old_tail = SCM_CDR (lst);
- SCM_SETCDR (lst, newtail);
- if (SCM_NULLP (old_tail))
- return lst;
+ SCM_ASSERT (scm_ilength (ls) >= 0, ls, SCM_ARG1, s_reverse_x);
+ if (SCM_UNBNDP (new_tail))
+ new_tail = SCM_EOL;
+ else
+ SCM_ASSERT (scm_ilength (new_tail) >= 0, new_tail, SCM_ARG2, s_reverse_x);
- newtail = lst;
- lst = old_tail;
- goto loop;
+ while (SCM_NIMP (ls))
+ {
+ old_tail = SCM_CDR (ls);
+ SCM_SETCDR (ls, new_tail);
+ new_tail = ls;
+ ls = old_tail;
+ }
+ return new_tail;
}
\f
-
+/* 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);
}
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);
}
erout: SCM_ASSERT(SCM_NIMP(lst) && SCM_CONSP(lst),
SCM_NULLP(lst)?k:lst, SCM_NULLP(lst)?SCM_OUTOFRANGE:SCM_ARG1, s_list_set_x);
- SCM_CAR (lst) = val;
+ SCM_SETCAR (lst, val);
return val;
}
+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);
\f
-
-
-
-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;
{
SCM_ASSERT(SCM_NIMP(lst) && SCM_CONSP(lst), lst, SCM_ARG1, s_list_head);
*pos = scm_cons (SCM_CAR (lst), SCM_EOL);
- pos = &SCM_CDR (*pos);
+ pos = SCM_CDRLOC (*pos);
lst = SCM_CDR(lst);
}
return answer;
}
-\f
-
-#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_PROC (s_list_copy, "list-copy", 1, 0, 0, scm_list_copy);
+SCM
+scm_list_copy (lst)
+ SCM lst;
{
- SCM_ASSERT ((scm_ilength (obj) >= 0), obj, where, why);
+ 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_CDRLOC (c);
+ from_here = SCM_CDR (from_here);
+ }
+ return newlst;
}
+\f
+/* membership tests (memq, memv, etc.) */
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))
{
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))
{
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))
{
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;
+ SCM_ASSERT (scm_ilength (lst) >= 0, lst, SCM_ARG2, s_memq);
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;
+ SCM_ASSERT (scm_ilength (lst) >= 0, lst, SCM_ARG2, s_memv);
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;
+ SCM_ASSERT (scm_ilength (lst) >= 0, lst, SCM_ARG2, s_member);
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;
}
\f
+/* 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;
-
- if (SCM_IMP (lst) || SCM_NCONSP (lst))
- return lst;
-
- if (SCM_CAR (lst) == item)
- return SCM_CDR (lst);
+ SCM walk;
+ SCM *prev;
- start = lst;
-
- while (SCM_NIMP (SCM_CDR (lst)) && SCM_CONSP (SCM_CDR (lst)))
+ for (prev = &lst, walk = lst;
+ SCM_NIMP (walk) && SCM_CONSP (walk);
+ walk = SCM_CDR (walk))
{
- if (SCM_CAR (SCM_CDR (lst)) == item)
- {
- SCM_SETCDR (lst, SCM_CDR (SCM_CDR (lst)));
- return start;
- }
- lst = SCM_CDR (lst);
+ if (SCM_CAR (walk) == item)
+ *prev = SCM_CDR (walk);
+ else
+ prev = SCM_CDRLOC (walk);
}
- return start;
+
+ return 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;
-
- if (SCM_IMP (lst) || SCM_NCONSP (lst))
- return lst;
-
- if (SCM_BOOL_F != scm_eqv_p (SCM_CAR (lst), item))
- return SCM_CDR (lst);
-
- start = lst;
+ SCM walk;
+ SCM *prev;
- while (SCM_NIMP (SCM_CDR (lst)) && SCM_CONSP (SCM_CDR (lst)))
+ for (prev = &lst, walk = lst;
+ SCM_NIMP (walk) && SCM_CONSP (walk);
+ walk = SCM_CDR (walk))
{
- if (SCM_BOOL_F != scm_eqv_p (SCM_CAR (SCM_CDR (lst)), item))
- {
- SCM_SETCDR (lst, SCM_CDR (SCM_CDR (lst)));
- return start;
- }
- lst = SCM_CDR (lst);
+ if (SCM_BOOL_F != scm_eqv_p (SCM_CAR (walk), item))
+ *prev = SCM_CDR (walk);
+ else
+ prev = SCM_CDRLOC (walk);
}
- return start;
+
+ return 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;
-
- if (SCM_IMP (lst) || SCM_NCONSP (lst))
- return lst;
-
- if (SCM_BOOL_F != scm_equal_p (SCM_CAR (lst), item))
- return SCM_CDR (lst);
-
- start = lst;
+ SCM walk;
+ SCM *prev;
- while (SCM_NIMP (SCM_CDR (lst)) && SCM_CONSP (SCM_CDR (lst)))
+ for (prev = &lst, walk = lst;
+ SCM_NIMP (walk) && SCM_CONSP (walk);
+ walk = SCM_CDR (walk))
{
- if (SCM_BOOL_F != scm_equal_p (SCM_CAR (SCM_CDR (lst)), item))
- {
- SCM_SETCDR (lst, SCM_CDR (SCM_CDR (lst)));
- return start;
- }
- lst = SCM_CDR (lst);
+ if (SCM_BOOL_F != scm_equal_p (SCM_CAR (walk), item))
+ *prev = SCM_CDR (walk);
+ else
+ prev = SCM_CDRLOC (walk);
}
- return start;
-}
+ return lst;
+}
-\f
-
-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;
-}
\f
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;
}
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;
}
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;
}
-\f
+SCM_PROC(s_delq1_x, "delq1!", 2, 0, 0, scm_delq1_x);
+SCM
+scm_delq1_x (item, lst)
+ SCM item;
+ SCM lst;
+{
+ SCM walk;
+ SCM *prev;
-#ifdef __STDC__
-void
-scm_init_list (void)
-#else
+ for (prev = &lst, walk = lst;
+ SCM_NIMP (walk) && SCM_CONSP (walk);
+ walk = SCM_CDR (walk))
+ {
+ if (SCM_CAR (walk) == item)
+ {
+ *prev = SCM_CDR (walk);
+ break;
+ }
+ else
+ prev = SCM_CDRLOC (walk);
+ }
+
+ return lst;
+}
+
+
+SCM_PROC(s_delv1_x, "delv1!", 2, 0, 0, scm_delv1_x);
+SCM
+scm_delv1_x (item, lst)
+ SCM item;
+ SCM lst;
+{
+ SCM walk;
+ SCM *prev;
+
+ for (prev = &lst, walk = lst;
+ SCM_NIMP (walk) && SCM_CONSP (walk);
+ walk = SCM_CDR (walk))
+ {
+ if (SCM_BOOL_F != scm_eqv_p (SCM_CAR (walk), item))
+ {
+ *prev = SCM_CDR (walk);
+ break;
+ }
+ else
+ prev = SCM_CDRLOC (walk);
+ }
+
+ return lst;
+}
+
+
+SCM_PROC(s_delete1_x, "delete1!", 2, 0, 0, scm_delete1_x);
+SCM
+scm_delete1_x (item, lst)
+ SCM item;
+ SCM lst;
+{
+ SCM walk;
+ SCM *prev;
+
+ for (prev = &lst, walk = lst;
+ SCM_NIMP (walk) && SCM_CONSP (walk);
+ walk = SCM_CDR (walk))
+ {
+ if (SCM_BOOL_F != scm_equal_p (SCM_CAR (walk), item))
+ {
+ *prev = SCM_CDR (walk);
+ break;
+ }
+ else
+ prev = SCM_CDRLOC (walk);
+ }
+
+ return lst;
+}
+
+
+\f
void
scm_init_list ()
-#endif
{
#include "list.x"
}
-
HCoop / bpt / guile.git / blobdiff