a1a79a43a9b0609f421332671ba7f08733bbd08f
1 /* Copyright (C) 1995,1996,1997,2000,2001,2003,2004
2 * Free Software Foundation, Inc.
4 * This library is free software; you can redistribute it and/or
5 * modify it under the terms of the GNU Lesser General Public
6 * License as published by the Free Software Foundation; either
7 * version 2.1 of the License, or (at your option) any later version.
9 * This library is distributed in the hope that it will be useful,
10 * but WITHOUT ANY WARRANTY; without even the implied warranty of
11 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
12 * Lesser General Public License for more details.
14 * You should have received a copy of the GNU Lesser General Public
15 * License along with this library; if not, write to the Free Software
16 * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
21 #include "libguile/_scm.h"
22 #include "libguile/eq.h"
23 #include "libguile/lang.h"
25 #include "libguile/validate.h"
26 #include "libguile/list.h"
27 #include "libguile/eval.h"
34 #define SCM_I_CONS(cell, x, y) \
36 cell = scm_cell ((scm_t_bits)x, (scm_t_bits)y); \
43 SCM_I_CONS (c1
, e1
, SCM_EOL
);
48 scm_list_2 (SCM e1
, SCM e2
)
51 SCM_I_CONS (c2
, e2
, SCM_EOL
);
52 SCM_I_CONS (c1
, e1
, c2
);
57 scm_list_3 (SCM e1
, SCM e2
, SCM e3
)
60 SCM_I_CONS (c3
, e3
, SCM_EOL
);
61 SCM_I_CONS (c2
, e2
, c3
);
62 SCM_I_CONS (c1
, e1
, c2
);
67 scm_list_4 (SCM e1
, SCM e2
, SCM e3
, SCM e4
)
69 return scm_cons2 (e1
, e2
, scm_list_2 (e3
, e4
));
73 scm_list_5 (SCM e1
, SCM e2
, SCM e3
, SCM e4
, SCM e5
)
75 return scm_cons2 (e1
, e2
, scm_list_3 (e3
, e4
, e5
));
79 scm_list_n (SCM elt
, ...)
86 while (! SCM_UNBNDP (elt
))
88 #if (SCM_DEBUG_CELL_ACCESSES == 1)
90 SCM_VALIDATE_CELL(elt
, 0);
92 *pos
= scm_cons (elt
, SCM_EOL
);
93 pos
= SCM_CDRLOC (*pos
);
94 elt
= va_arg (foo
, SCM
);
101 SCM_DEFINE (scm_make_list
, "make-list", 1, 1, 0,
103 "Create a list containing of @var{n} elements, where each\n"
104 "element is initialized to @var{init}. @var{init} defaults to\n"
105 "the empty list @code{()} if not given.")
106 #define FUNC_NAME s_scm_make_list
108 unsigned nn
= scm_to_uint (n
);
112 if (SCM_UNBNDP (init
))
115 for (i
= 0; i
< nn
; i
++)
116 ret
= scm_cons (init
, ret
);
122 SCM_DEFINE (scm_cons_star
, "cons*", 1, 0, 1,
124 "Like @code{list}, but the last arg provides the tail of the\n"
125 "constructed list, returning @code{(cons @var{arg1} (cons\n"
126 "@var{arg2} (cons @dots{} @var{argn})))}. Requires at least one\n"
127 "argument. If given one argument, that argument is returned as\n"
128 "result. This function is called @code{list*} in some other\n"
129 "Schemes and in Common LISP.")
130 #define FUNC_NAME s_scm_cons_star
135 SCM_VALIDATE_REST_ARGUMENT (rest
);
137 for ( ; scm_is_pair (rest
); rest
= SCM_CDR (rest
))
139 *p
= scm_cons (arg
, SCM_EOL
);
141 arg
= SCM_CAR (rest
);
151 /* general questions about lists --- null?, list?, length, etc. */
153 SCM_DEFINE (scm_null_p
, "null?", 1, 0, 0,
155 "Return @code{#t} iff @var{x} is the empty list, else @code{#f}.")
156 #define FUNC_NAME s_scm_null_p
158 return scm_from_bool (SCM_NULL_OR_NIL_P (x
));
163 SCM_DEFINE (scm_list_p
, "list?", 1, 0, 0,
165 "Return @code{#t} iff @var{x} is a proper list, else @code{#f}.")
166 #define FUNC_NAME s_scm_list_p
168 return scm_from_bool (scm_ilength (x
) >= 0);
173 /* Return the length of SX, or -1 if it's not a proper list.
174 This uses the "tortoise and hare" algorithm to detect "infinitely
175 long" lists (i.e. lists with cycles in their cdrs), and returns -1
176 if it does find one. */
185 if (SCM_NULL_OR_NIL_P(hare
)) return i
;
186 if (!scm_is_pair (hare
)) return -1;
187 hare
= SCM_CDR(hare
);
189 if (SCM_NULL_OR_NIL_P(hare
)) return i
;
190 if (!scm_is_pair (hare
)) return -1;
191 hare
= SCM_CDR(hare
);
193 /* For every two steps the hare takes, the tortoise takes one. */
194 tortoise
= SCM_CDR(tortoise
);
196 while (!scm_is_eq (hare
, tortoise
));
198 /* If the tortoise ever catches the hare, then the list must contain
204 SCM_DEFINE (scm_length
, "length", 1, 0, 0,
206 "Return the number of elements in list @var{lst}.")
207 #define FUNC_NAME s_scm_length
210 SCM_VALIDATE_LIST_COPYLEN (1, lst
, i
);
211 return scm_from_long (i
);
217 /* appending lists */
219 SCM_DEFINE (scm_append
, "append", 0, 0, 1,
221 "Return a list consisting of the elements the lists passed as\n"
224 "(append '(x) '(y)) @result{} (x y)\n"
225 "(append '(a) '(b c d)) @result{} (a b c d)\n"
226 "(append '(a (b)) '((c))) @result{} (a (b) (c))\n"
228 "The resulting list is always newly allocated, except that it\n"
229 "shares structure with the last list argument. The last\n"
230 "argument may actually be any object; an improper list results\n"
231 "if the last argument is not a proper list.\n"
233 "(append '(a b) '(c . d)) @result{} (a b c . d)\n"
234 "(append '() 'a) @result{} a\n"
236 #define FUNC_NAME s_scm_append
238 SCM_VALIDATE_REST_ARGUMENT (args
);
239 if (scm_is_null (args
)) {
244 SCM arg
= SCM_CAR (args
);
246 args
= SCM_CDR (args
);
247 while (!scm_is_null (args
)) {
248 while (scm_is_pair (arg
)) {
249 *lloc
= scm_cons (SCM_CAR (arg
), SCM_EOL
);
250 lloc
= SCM_CDRLOC (*lloc
);
253 SCM_VALIDATE_NULL_OR_NIL (argnum
, arg
);
254 arg
= SCM_CAR (args
);
255 args
= SCM_CDR (args
);
265 SCM_DEFINE (scm_append_x
, "append!", 0, 0, 1,
267 "A destructive version of @code{append} (@pxref{Pairs and\n"
268 "Lists,,,r5rs, The Revised^5 Report on Scheme}). The cdr field\n"
269 "of each list's final pair is changed to point to the head of\n"
270 "the next list, so no consing is performed. Return\n"
272 #define FUNC_NAME s_scm_append_x
275 SCM_VALIDATE_REST_ARGUMENT (lists
);
277 if (scm_is_null (lists
))
283 SCM arg
= SCM_CAR (lists
);
286 lists
= SCM_CDR (lists
);
287 if (scm_is_null (lists
))
290 if (!SCM_NULL_OR_NIL_P (arg
))
292 SCM_VALIDATE_CONS (SCM_ARG1
, arg
);
293 loc
= SCM_CDRLOC (scm_last_pair (arg
));
300 SCM_DEFINE (scm_last_pair
, "last-pair", 1, 0, 0,
302 "Return the last pair in @var{lst}, signalling an error if\n"
303 "@var{lst} is circular.")
304 #define FUNC_NAME s_scm_last_pair
309 if (SCM_NULL_OR_NIL_P (lst
))
312 SCM_VALIDATE_CONS (SCM_ARG1
, lst
);
314 SCM ahead
= SCM_CDR(hare
);
315 if (!scm_is_pair (ahead
)) return hare
;
317 ahead
= SCM_CDR(hare
);
318 if (!scm_is_pair (ahead
)) return hare
;
320 tortoise
= SCM_CDR(tortoise
);
322 while (!scm_is_eq (hare
, tortoise
));
323 SCM_MISC_ERROR ("Circular structure in position 1: ~S", scm_list_1 (lst
));
328 /* reversing lists */
330 SCM_DEFINE (scm_reverse
, "reverse", 1, 0, 0,
332 "Return a new list that contains the elements of @var{lst} but\n"
334 #define FUNC_NAME s_scm_reverse
336 SCM result
= SCM_EOL
;
341 if (SCM_NULL_OR_NIL_P(hare
)) return result
;
342 SCM_ASSERT(scm_is_pair(hare
), lst
, 1, FUNC_NAME
);
343 result
= scm_cons (SCM_CAR (hare
), result
);
344 hare
= SCM_CDR (hare
);
345 if (SCM_NULL_OR_NIL_P(hare
)) return result
;
346 SCM_ASSERT(scm_is_pair(hare
), lst
, 1, FUNC_NAME
);
347 result
= scm_cons (SCM_CAR (hare
), result
);
348 hare
= SCM_CDR (hare
);
349 tortoise
= SCM_CDR (tortoise
);
351 while (!scm_is_eq (hare
, tortoise
));
352 SCM_MISC_ERROR ("Circular structure in position 1: ~S", scm_list_1 (lst
));
356 SCM_DEFINE (scm_reverse_x
, "reverse!", 1, 1, 0,
357 (SCM lst
, SCM new_tail
),
358 "A destructive version of @code{reverse} (@pxref{Pairs and Lists,,,r5rs,\n"
359 "The Revised^5 Report on Scheme}). The cdr of each cell in @var{lst} is\n"
360 "modified to point to the previous list element. Return the\n"
362 "Caveat: because the list is modified in place, the tail of the original\n"
363 "list now becomes its head, and the head of the original list now becomes\n"
364 "the tail. Therefore, the @var{lst} symbol to which the head of the\n"
365 "original list was bound now points to the tail. To ensure that the head\n"
366 "of the modified list is not lost, it is wise to save the return value of\n"
368 #define FUNC_NAME s_scm_reverse_x
370 SCM_VALIDATE_LIST (1, lst
);
371 if (SCM_UNBNDP (new_tail
))
374 SCM_VALIDATE_LIST (2, new_tail
);
376 while (!SCM_NULL_OR_NIL_P (lst
))
378 SCM old_tail
= SCM_CDR (lst
);
379 SCM_SETCDR (lst
, new_tail
);
389 /* indexing lists by element number */
391 SCM_DEFINE (scm_list_ref
, "list-ref", 2, 0, 0,
393 "Return the @var{k}th element from @var{list}.")
394 #define FUNC_NAME s_scm_list_ref
398 i
= scm_to_ulong (k
);
399 while (scm_is_pair (lst
)) {
401 return SCM_CAR (lst
);
407 if (SCM_NULL_OR_NIL_P (lst
))
408 SCM_OUT_OF_RANGE (2, k
);
410 SCM_WRONG_TYPE_ARG (1, list
);
415 SCM_DEFINE (scm_list_set_x
, "list-set!", 3, 0, 0,
416 (SCM list
, SCM k
, SCM val
),
417 "Set the @var{k}th element of @var{list} to @var{val}.")
418 #define FUNC_NAME s_scm_list_set_x
421 unsigned long int i
= scm_to_ulong (k
);
422 while (scm_is_pair (lst
)) {
424 SCM_SETCAR (lst
, val
);
431 if (SCM_NULL_OR_NIL_P (lst
))
432 SCM_OUT_OF_RANGE (2, k
);
434 SCM_WRONG_TYPE_ARG (1, list
);
439 SCM_REGISTER_PROC(s_list_cdr_ref
, "list-cdr-ref", 2, 0, 0, scm_list_tail
);
441 SCM_DEFINE (scm_list_tail
, "list-tail", 2, 0, 0,
443 "@deffnx {Scheme Procedure} list-cdr-ref lst k\n"
444 "Return the \"tail\" of @var{lst} beginning with its @var{k}th element.\n"
445 "The first element of the list is considered to be element 0.\n\n"
446 "@code{list-tail} and @code{list-cdr-ref} are identical. It may help to\n"
447 "think of @code{list-cdr-ref} as accessing the @var{k}th cdr of the list,\n"
448 "or returning the results of cdring @var{k} times down @var{lst}.")
449 #define FUNC_NAME s_scm_list_tail
451 size_t i
= scm_to_size_t (k
);
453 SCM_VALIDATE_CONS (1, lst
);
461 SCM_DEFINE (scm_list_cdr_set_x
, "list-cdr-set!", 3, 0, 0,
462 (SCM list
, SCM k
, SCM val
),
463 "Set the @var{k}th cdr of @var{list} to @var{val}.")
464 #define FUNC_NAME s_scm_list_cdr_set_x
467 size_t i
= scm_to_size_t (k
);
468 while (scm_is_pair (lst
)) {
470 SCM_SETCDR (lst
, val
);
477 if (SCM_NULL_OR_NIL_P (lst
))
478 SCM_OUT_OF_RANGE (2, k
);
480 SCM_WRONG_TYPE_ARG (1, list
);
486 /* copying lists, perhaps partially */
488 SCM_DEFINE (scm_list_head
, "list-head", 2, 0, 0,
490 "Copy the first @var{k} elements from @var{lst} into a new list, and\n"
492 #define FUNC_NAME s_scm_list_head
496 size_t i
= scm_to_size_t (k
);
502 SCM_VALIDATE_CONS (1, lst
);
503 *pos
= scm_cons (SCM_CAR (lst
), SCM_EOL
);
504 pos
= SCM_CDRLOC (*pos
);
512 /* Copy a list which is known to be finite. The last pair may or may not have
513 * a '() in its cdr. That is, improper lists are accepted. */
515 scm_i_finite_list_copy (SCM list
)
517 if (!scm_is_pair (list
))
524 const SCM result
= tail
= scm_list_1 (SCM_CAR (list
));
525 list
= SCM_CDR (list
);
526 while (scm_is_pair (list
))
528 const SCM new_tail
= scm_list_1 (SCM_CAR (list
));
529 SCM_SETCDR (tail
, new_tail
);
531 list
= SCM_CDR (list
);
533 SCM_SETCDR (tail
, list
);
540 SCM_DEFINE (scm_list_copy
, "list-copy", 1, 0, 0,
542 "Return a (newly-created) copy of @var{lst}.")
543 #define FUNC_NAME s_scm_list_copy
549 SCM_VALIDATE_LIST (1, lst
);
555 while (scm_is_pair (from_here
))
558 c
= scm_cons (SCM_CAR (from_here
), SCM_CDR (from_here
));
560 fill_here
= SCM_CDRLOC (c
);
561 from_here
= SCM_CDR (from_here
);
568 SCM_PROC (s_list
, "list", 0, 0, 1, scm_list_copy
);
569 SCM_SNARF_DOCS (primitive
, scm_list_copy
, "list", (SCM objs
), 0, 0, 1,
570 "Return a list containing @var{objs}, the arguments to\n"
573 /* This used to be the code for "list", but it's wrong when used via apply
574 (it should copy the list). It seems pretty unlikely anyone would have
575 been using this from C code, since it's a no-op, but keep it for strict
576 binary compatibility. */
585 /* membership tests (memq, memv, etc.) */
587 /* The function scm_c_memq returns the first sublist of list whose car is
588 * 'eq?' obj, where the sublists of list are the non-empty lists returned by
589 * (list-tail list k) for k less than the length of list. If obj does not
590 * occur in list, then #f (not the empty list) is returned.
591 * List must be a proper list, otherwise scm_c_memq may crash or loop
595 scm_c_memq (SCM obj
, SCM list
)
597 for (; !SCM_NULL_OR_NIL_P (list
); list
= SCM_CDR (list
))
599 if (scm_is_eq (SCM_CAR (list
), obj
))
606 SCM_DEFINE (scm_memq
, "memq", 2, 0, 0,
608 "Return the first sublist of @var{lst} whose car is @code{eq?}\n"
609 "to @var{x} where the sublists of @var{lst} are the non-empty\n"
610 "lists returned by @code{(list-tail @var{lst} @var{k})} for\n"
611 "@var{k} less than the length of @var{lst}. If @var{x} does not\n"
612 "occur in @var{lst}, then @code{#f} (not the empty list) is\n"
614 #define FUNC_NAME s_scm_memq
616 SCM_VALIDATE_LIST (2, lst
);
617 return scm_c_memq (x
, lst
);
622 SCM_DEFINE (scm_memv
, "memv", 2, 0, 0,
624 "Return the first sublist of @var{lst} whose car is @code{eqv?}\n"
625 "to @var{x} where the sublists of @var{lst} are the non-empty\n"
626 "lists returned by @code{(list-tail @var{lst} @var{k})} for\n"
627 "@var{k} less than the length of @var{lst}. If @var{x} does not\n"
628 "occur in @var{lst}, then @code{#f} (not the empty list) is\n"
630 #define FUNC_NAME s_scm_memv
632 SCM_VALIDATE_LIST (2, lst
);
633 for (; !SCM_NULL_OR_NIL_P (lst
); lst
= SCM_CDR (lst
))
635 if (! scm_is_false (scm_eqv_p (SCM_CAR (lst
), x
)))
643 SCM_DEFINE (scm_member
, "member", 2, 0, 0,
645 "Return the first sublist of @var{lst} whose car is\n"
646 "@code{equal?} to @var{x} where the sublists of @var{lst} are\n"
647 "the non-empty lists returned by @code{(list-tail @var{lst}\n"
648 "@var{k})} for @var{k} less than the length of @var{lst}. If\n"
649 "@var{x} does not occur in @var{lst}, then @code{#f} (not the\n"
650 "empty list) is returned.")
651 #define FUNC_NAME s_scm_member
653 SCM_VALIDATE_LIST (2, lst
);
654 for (; !SCM_NULL_OR_NIL_P (lst
); lst
= SCM_CDR (lst
))
656 if (! scm_is_false (scm_equal_p (SCM_CAR (lst
), x
)))
664 /* deleting elements from a list (delq, etc.) */
666 SCM_DEFINE (scm_delq_x
, "delq!", 2, 0, 0,
668 "@deffnx {Scheme Procedure} delv! item lst\n"
669 "@deffnx {Scheme Procedure} delete! item lst\n"
670 "These procedures are destructive versions of @code{delq}, @code{delv}\n"
671 "and @code{delete}: they modify the existing @var{lst}\n"
672 "rather than creating a new list. Caveat evaluator: Like other\n"
673 "destructive list functions, these functions cannot modify the binding of\n"
674 "@var{lst}, and so cannot be used to delete the first element of\n"
675 "@var{lst} destructively.")
676 #define FUNC_NAME s_scm_delq_x
681 for (prev
= &lst
, walk
= lst
;
683 walk
= SCM_CDR (walk
))
685 if (scm_is_eq (SCM_CAR (walk
), item
))
686 *prev
= SCM_CDR (walk
);
688 prev
= SCM_CDRLOC (walk
);
696 SCM_DEFINE (scm_delv_x
, "delv!", 2, 0, 0,
698 "Destructively remove all elements from @var{lst} that are\n"
699 "@code{eqv?} to @var{item}.")
700 #define FUNC_NAME s_scm_delv_x
705 for (prev
= &lst
, walk
= lst
;
707 walk
= SCM_CDR (walk
))
709 if (! scm_is_false (scm_eqv_p (SCM_CAR (walk
), item
)))
710 *prev
= SCM_CDR (walk
);
712 prev
= SCM_CDRLOC (walk
);
721 SCM_DEFINE (scm_delete_x
, "delete!", 2, 0, 0,
723 "Destructively remove all elements from @var{lst} that are\n"
724 "@code{equal?} to @var{item}.")
725 #define FUNC_NAME s_scm_delete_x
730 for (prev
= &lst
, walk
= lst
;
732 walk
= SCM_CDR (walk
))
734 if (! scm_is_false (scm_equal_p (SCM_CAR (walk
), item
)))
735 *prev
= SCM_CDR (walk
);
737 prev
= SCM_CDRLOC (walk
);
748 SCM_DEFINE (scm_delq
, "delq", 2, 0, 0,
750 "Return a newly-created copy of @var{lst} with elements\n"
751 "@code{eq?} to @var{item} removed. This procedure mirrors\n"
752 "@code{memq}: @code{delq} compares elements of @var{lst} against\n"
753 "@var{item} with @code{eq?}.")
754 #define FUNC_NAME s_scm_delq
756 SCM copy
= scm_list_copy (lst
);
757 return scm_delq_x (item
, copy
);
761 SCM_DEFINE (scm_delv
, "delv", 2, 0, 0,
763 "Return a newly-created copy of @var{lst} with elements\n"
764 "@code{eqv?} to @var{item} removed. This procedure mirrors\n"
765 "@code{memv}: @code{delv} compares elements of @var{lst} against\n"
766 "@var{item} with @code{eqv?}.")
767 #define FUNC_NAME s_scm_delv
769 SCM copy
= scm_list_copy (lst
);
770 return scm_delv_x (item
, copy
);
774 SCM_DEFINE (scm_delete
, "delete", 2, 0, 0,
776 "Return a newly-created copy of @var{lst} with elements\n"
777 "@code{equal?} to @var{item} removed. This procedure mirrors\n"
778 "@code{member}: @code{delete} compares elements of @var{lst}\n"
779 "against @var{item} with @code{equal?}.")
780 #define FUNC_NAME s_scm_delete
782 SCM copy
= scm_list_copy (lst
);
783 return scm_delete_x (item
, copy
);
788 SCM_DEFINE (scm_delq1_x
, "delq1!", 2, 0, 0,
790 "Like @code{delq!}, but only deletes the first occurrence of\n"
791 "@var{item} from @var{lst}. Tests for equality using\n"
792 "@code{eq?}. See also @code{delv1!} and @code{delete1!}.")
793 #define FUNC_NAME s_scm_delq1_x
798 for (prev
= &lst
, walk
= lst
;
800 walk
= SCM_CDR (walk
))
802 if (scm_is_eq (SCM_CAR (walk
), item
))
804 *prev
= SCM_CDR (walk
);
808 prev
= SCM_CDRLOC (walk
);
816 SCM_DEFINE (scm_delv1_x
, "delv1!", 2, 0, 0,
818 "Like @code{delv!}, but only deletes the first occurrence of\n"
819 "@var{item} from @var{lst}. Tests for equality using\n"
820 "@code{eqv?}. See also @code{delq1!} and @code{delete1!}.")
821 #define FUNC_NAME s_scm_delv1_x
826 for (prev
= &lst
, walk
= lst
;
828 walk
= SCM_CDR (walk
))
830 if (! scm_is_false (scm_eqv_p (SCM_CAR (walk
), item
)))
832 *prev
= SCM_CDR (walk
);
836 prev
= SCM_CDRLOC (walk
);
844 SCM_DEFINE (scm_delete1_x
, "delete1!", 2, 0, 0,
846 "Like @code{delete!}, but only deletes the first occurrence of\n"
847 "@var{item} from @var{lst}. Tests for equality using\n"
848 "@code{equal?}. See also @code{delq1!} and @code{delv1!}.")
849 #define FUNC_NAME s_scm_delete1_x
854 for (prev
= &lst
, walk
= lst
;
856 walk
= SCM_CDR (walk
))
858 if (! scm_is_false (scm_equal_p (SCM_CAR (walk
), item
)))
860 *prev
= SCM_CDR (walk
);
864 prev
= SCM_CDRLOC (walk
);
871 SCM_DEFINE (scm_filter
, "filter", 2, 0, 0,
872 (SCM pred
, SCM list
),
873 "Return all the elements of 2nd arg @var{list} that satisfy predicate @var{pred}.\n"
874 "The list is not disordered -- elements that appear in the result list occur\n"
875 "in the same order as they occur in the argument list. The returned list may\n"
876 "share a common tail with the argument list. The dynamic order in which the\n"
877 "various applications of pred are made is not specified.\n\n"
879 "(filter even? '(0 7 8 8 43 -4)) => (0 8 8 -4)\n"
881 #define FUNC_NAME s_scm_filter
883 scm_t_trampoline_1 call
= scm_trampoline_1 (pred
);
887 SCM_ASSERT (call
, pred
, 1, FUNC_NAME
);
888 SCM_VALIDATE_LIST (2, list
);
890 for (prev
= &res
, walk
= list
;
892 walk
= SCM_CDR (walk
))
894 if (scm_is_true (call (pred
, SCM_CAR (walk
))))
896 *prev
= scm_cons (SCM_CAR (walk
), SCM_EOL
);
897 prev
= SCM_CDRLOC (*prev
);
905 SCM_DEFINE (scm_filter_x
, "filter!", 2, 0, 0,
906 (SCM pred
, SCM list
),
907 "Linear-update variant of @code{filter}.")
908 #define FUNC_NAME s_scm_filter_x
910 scm_t_trampoline_1 call
= scm_trampoline_1 (pred
);
913 SCM_ASSERT (call
, pred
, 1, FUNC_NAME
);
914 SCM_VALIDATE_LIST (2, list
);
916 for (prev
= &list
, walk
= list
;
918 walk
= SCM_CDR (walk
))
920 if (scm_is_true (call (pred
, SCM_CAR (walk
))))
921 prev
= SCM_CDRLOC (walk
);
923 *prev
= SCM_CDR (walk
);
934 #include "libguile/list.x"