-/* Copyright (C) 1995,1996,1997,2000,2001 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1997,2000,2001, 2003 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
\f
#include "libguile/_scm.h"
#include "libguile/eq.h"
+#include "libguile/lang.h"
#include "libguile/validate.h"
#include "libguile/list.h"
+#include "libguile/eval.h"
#ifdef __STDC__
#include <stdarg.h>
\f
/* creating lists */
-#define SCM_I_CONS(cell,x,y) \
+#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); \
+ cell = scm_cell ((scm_t_bits)x, (scm_t_bits)y); \
} while (0)
SCM
"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));
+ return SCM_BOOL (SCM_NULL_OR_NIL_P (x));
}
#undef FUNC_NAME
SCM hare = sx;
do {
- if (SCM_NULLP(hare)) return i;
+ if (SCM_NULL_OR_NIL_P(hare)) return i;
if (SCM_NCONSP(hare)) return -1;
hare = SCM_CDR(hare);
i++;
- if (SCM_NULLP(hare)) return i;
+ if (SCM_NULL_OR_NIL_P(hare)) return i;
if (SCM_NCONSP(hare)) return -1;
hare = SCM_CDR(hare);
i++;
#define FUNC_NAME s_scm_length
{
long i;
- SCM_VALIDATE_LIST_COPYLEN (1,lst,i);
+ SCM_VALIDATE_LIST_COPYLEN (1, lst, i);
return SCM_MAKINUM (i);
}
#undef FUNC_NAME
lloc = SCM_CDRLOC (*lloc);
arg = SCM_CDR (arg);
}
- SCM_VALIDATE_NULL (SCM_ARGn, arg);
+ SCM_VALIDATE_NULL_OR_NIL (SCM_ARGn, arg);
arg = SCM_CAR (args);
args = SCM_CDR (args);
};
lists = SCM_CDR (lists);
if (SCM_NULLP (lists)) {
return arg;
- } else if (!SCM_NULLP (arg)) {
+ } else if (!SCM_NULL_OR_NIL_P (arg)) {
SCM_VALIDATE_CONS (SCM_ARG1, arg);
SCM_SETCDR (scm_last_pair (arg), scm_append_x (lists));
return arg;
SCM tortoise = lst;
SCM hare = lst;
- if (SCM_NULLP (lst))
- return SCM_EOL;
+ if (SCM_NULL_OR_NIL_P (lst))
+ return lst;
SCM_VALIDATE_CONS (SCM_ARG1, lst);
do {
SCM hare = lst;
do {
- if (SCM_NULLP(hare)) return result;
+ if (SCM_NULL_OR_NIL_P(hare)) return result;
SCM_ASSERT(SCM_CONSP(hare), lst, 1, FUNC_NAME);
result = scm_cons (SCM_CAR (hare), result);
hare = SCM_CDR (hare);
- if (SCM_NULLP(hare)) return result;
+ if (SCM_NULL_OR_NIL_P(hare)) return result;
SCM_ASSERT(SCM_CONSP(hare), lst, 1, FUNC_NAME);
result = scm_cons (SCM_CAR (hare), result);
hare = SCM_CDR (hare);
else
SCM_VALIDATE_LIST (2, new_tail);
- while (SCM_NNULLP (lst))
+ while (!SCM_NULL_OR_NIL_P (lst))
{
SCM old_tail = SCM_CDR (lst);
SCM_SETCDR (lst, new_tail);
{
SCM lst = list;
unsigned long int i;
- SCM_VALIDATE_INUM_MIN_COPY (2,k,0,i);
+ SCM_VALIDATE_INUM_MIN_COPY (2, k,0, i);
while (SCM_CONSP (lst)) {
if (i == 0)
return SCM_CAR (lst);
lst = SCM_CDR (lst);
}
};
- if (SCM_NULLP (lst))
+ if (SCM_NULL_OR_NIL_P (lst))
SCM_OUT_OF_RANGE (2, k);
else
SCM_WRONG_TYPE_ARG (1, list);
{
SCM lst = list;
unsigned long int i;
- SCM_VALIDATE_INUM_MIN_COPY (2,k,0,i);
+ SCM_VALIDATE_INUM_MIN_COPY (2, k,0, i);
while (SCM_CONSP (lst)) {
if (i == 0) {
SCM_SETCAR (lst, val);
lst = SCM_CDR (lst);
}
};
- if (SCM_NULLP (lst))
+ if (SCM_NULL_OR_NIL_P (lst))
SCM_OUT_OF_RANGE (2, k);
else
SCM_WRONG_TYPE_ARG (1, list);
#define FUNC_NAME s_scm_list_tail
{
register long i;
- SCM_VALIDATE_INUM_MIN_COPY (2,k,0,i);
+ SCM_VALIDATE_INUM_MIN_COPY (2, k,0, i);
while (i-- > 0) {
- SCM_VALIDATE_CONS (1,lst);
+ SCM_VALIDATE_CONS (1, lst);
lst = SCM_CDR(lst);
}
return lst;
{
SCM lst = list;
unsigned long int i;
- SCM_VALIDATE_INUM_MIN_COPY (2,k,0,i);
+ SCM_VALIDATE_INUM_MIN_COPY (2, k,0, i);
while (SCM_CONSP (lst)) {
if (i == 0) {
SCM_SETCDR (lst, val);
lst = SCM_CDR (lst);
}
};
- if (SCM_NULLP (lst))
+ if (SCM_NULL_OR_NIL_P (lst))
SCM_OUT_OF_RANGE (2, k);
else
SCM_WRONG_TYPE_ARG (1, list);
SCM * pos;
register long i;
- SCM_VALIDATE_INUM_MIN_COPY (2,k,0,i);
+ SCM_VALIDATE_INUM_MIN_COPY (2, k,0, i);
answer = SCM_EOL;
pos = &answer;
while (i-- > 0)
{
- SCM_VALIDATE_CONS (1,lst);
+ SCM_VALIDATE_CONS (1, lst);
*pos = scm_cons (SCM_CAR (lst), SCM_EOL);
pos = SCM_CDRLOC (*pos);
lst = SCM_CDR(lst);
SCM
scm_c_memq (SCM obj, SCM list)
{
- for (; !SCM_NULLP (list); list = SCM_CDR (list))
+ for (; !SCM_NULL_OR_NIL_P (list); list = SCM_CDR (list))
{
if (SCM_EQ_P (SCM_CAR (list), obj))
return list;
#define FUNC_NAME s_scm_memv
{
SCM_VALIDATE_LIST (2, lst);
- for (; !SCM_NULLP (lst); lst = SCM_CDR (lst))
+ for (; !SCM_NULL_OR_NIL_P (lst); lst = SCM_CDR (lst))
{
if (! SCM_FALSEP (scm_eqv_p (SCM_CAR (lst), x)))
return lst;
#define FUNC_NAME s_scm_member
{
SCM_VALIDATE_LIST (2, lst);
- for (; !SCM_NULLP (lst); lst = SCM_CDR (lst))
+ for (; !SCM_NULL_OR_NIL_P (lst); lst = SCM_CDR (lst))
{
if (! SCM_FALSEP (scm_equal_p (SCM_CAR (lst), x)))
return lst;
}
#undef FUNC_NAME
+SCM_DEFINE (scm_filter, "filter", 2, 0, 0,
+ (SCM pred, SCM list),
+ "Return all the elements of 2nd arg @var{list} that satisfy predicate @var{pred}.\n"
+ "The list is not disordered -- elements that appear in the result list occur\n"
+ "in the same order as they occur in the argument list. The returned list may\n"
+ "share a common tail with the argument list. The dynamic order in which the\n"
+ "various applications of pred are made is not specified.\n\n"
+ "@lisp\n"
+ "(filter even? '(0 7 8 8 43 -4)) => (0 8 8 -4)\n"
+ "@end lisp")
+#define FUNC_NAME s_scm_filter
+{
+ scm_t_trampoline_1 call = scm_trampoline_1 (pred);
+ SCM walk;
+ SCM *prev;
+ SCM res = SCM_EOL;
+ SCM_ASSERT (call, pred, 1, FUNC_NAME);
+ SCM_VALIDATE_LIST (2, list);
+
+ for (prev = &res, walk = list;
+ SCM_CONSP (walk);
+ walk = SCM_CDR (walk))
+ {
+ if (!SCM_FALSEP (call (pred, SCM_CAR (walk))))
+ {
+ *prev = scm_cons (SCM_CAR (walk), SCM_EOL);
+ prev = SCM_CDRLOC (*prev);
+ }
+ }
+
+ return res;
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_filter_x, "filter!", 2, 0, 0,
+ (SCM pred, SCM list),
+ "Linear-update variant of @code{filter}.")
+#define FUNC_NAME s_scm_filter_x
+{
+ scm_t_trampoline_1 call = scm_trampoline_1 (pred);
+ SCM walk;
+ SCM *prev;
+ SCM_ASSERT (call, pred, 1, FUNC_NAME);
+ SCM_VALIDATE_LIST (2, list);
+
+ for (prev = &list, walk = list;
+ SCM_CONSP (walk);
+ walk = SCM_CDR (walk))
+ {
+ if (!SCM_FALSEP (call (pred, SCM_CAR (walk))))
+ prev = SCM_CDRLOC (walk);
+ else
+ *prev = SCM_CDR (walk);
+ }
+
+ return list;
+}
+#undef FUNC_NAME
\f
void
scm_init_list ()
{
-#ifndef SCM_MAGIC_SNARFER
#include "libguile/list.x"
-#endif
}
/*
HCoop / bpt / guile.git / blobdiff