1 /* Copyright (C) 1995,1996,1997,2000,2001 Free Software Foundation, Inc.
3 * This program is free software; you can redistribute it and/or modify
4 * it under the terms of the GNU General Public License as published by
5 * the Free Software Foundation; either version 2, or (at your option)
8 * This program is distributed in the hope that it will be useful,
9 * but WITHOUT ANY WARRANTY; without even the implied warranty of
10 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
11 * GNU General Public License for more details.
13 * You should have received a copy of the GNU General Public License
14 * along with this software; see the file COPYING. If not, write to
15 * the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
16 * Boston, MA 02111-1307 USA
18 * As a special exception, the Free Software Foundation gives permission
19 * for additional uses of the text contained in its release of GUILE.
21 * The exception is that, if you link the GUILE library with other files
22 * to produce an executable, this does not by itself cause the
23 * resulting executable to be covered by the GNU General Public License.
24 * Your use of that executable is in no way restricted on account of
25 * linking the GUILE library code into it.
27 * This exception does not however invalidate any other reasons why
28 * the executable file might be covered by the GNU General Public License.
30 * This exception applies only to the code released by the
31 * Free Software Foundation under the name GUILE. If you copy
32 * code from other Free Software Foundation releases into a copy of
33 * GUILE, as the General Public License permits, the exception does
34 * not apply to the code that you add in this way. To avoid misleading
35 * anyone as to the status of such modified files, you must delete
36 * this exception notice from them.
38 * If you write modifications of your own for GUILE, it is your choice
39 * whether to permit this exception to apply to your modifications.
40 * If you do not wish that, delete this exception notice. */
42 /* Software engineering face-lift by Greg J. Badros, 11-Dec-1999,
43 gjb@cs.washington.edu, http://www.cs.washington.edu/homes/gjb */
46 #include "libguile/_scm.h"
47 #include "libguile/eq.h"
49 #include "libguile/validate.h"
50 #include "libguile/list.h"
54 #define var_start(x, y) va_start(x, y)
57 #define var_start(x, y) va_start(x)
63 #define SCM_I_CONS(cell,x,y) \
66 SCM_SET_CELL_OBJECT_1 (cell, y); \
67 SCM_SET_CELL_OBJECT_0 (cell, x); \
74 SCM_I_CONS (c1
, e1
, SCM_EOL
);
79 scm_list_2 (SCM e1
, SCM e2
)
82 SCM_I_CONS (c2
, e2
, SCM_EOL
);
83 SCM_I_CONS (c1
, e1
, c2
);
88 scm_list_3 (SCM e1
, SCM e2
, SCM e3
)
91 SCM_I_CONS (c3
, e3
, SCM_EOL
);
92 SCM_I_CONS (c2
, e2
, c3
);
93 SCM_I_CONS (c1
, e1
, c2
);
98 scm_list_4 (SCM e1
, SCM e2
, SCM e3
, SCM e4
)
100 return scm_cons2 (e1
, e2
, scm_list_2 (e3
, e4
));
104 scm_list_5 (SCM e1
, SCM e2
, SCM e3
, SCM e4
, SCM e5
)
106 return scm_cons2 (e1
, e2
, scm_list_3 (e3
, e4
, e5
));
110 scm_list_n (SCM elt
, ...)
113 SCM answer
= SCM_EOL
;
116 var_start (foo
, elt
);
117 while (! SCM_UNBNDP (elt
))
119 *pos
= scm_cons (elt
, SCM_EOL
);
120 pos
= SCM_CDRLOC (*pos
);
121 elt
= va_arg (foo
, SCM
);
127 SCM_DEFINE (scm_list
, "list", 0, 0, 1,
129 "Return a list containing @var{objs}, the arguments to\n"
131 #define FUNC_NAME s_scm_list
138 #if (SCM_DEBUG_DEPRECATED == 0)
140 SCM_REGISTER_PROC (s_list_star
, "list*", 1, 0, 1, scm_cons_star
);
142 #endif /* SCM_DEBUG_DEPRECATED == 0 */
144 SCM_DEFINE (scm_cons_star
, "cons*", 1, 0, 1,
146 "Like @code{list}, but the last arg provides the tail of the\n"
147 "constructed list, returning @code{(cons @var{arg1} (cons\n"
148 "@var{arg2} (cons @dots{} @var{argn})))}. Requires at least one\n"
149 "argument. If given one argument, that argument is returned as\n"
150 "result. This function is called @code{list*} in some other\n"
151 "Schemes and in Common LISP.")
152 #define FUNC_NAME s_scm_cons_star
154 SCM_VALIDATE_REST_ARGUMENT (rest
);
155 if (!SCM_NULLP (rest
))
157 SCM prev
= arg
= scm_cons (arg
, rest
);
158 while (SCM_NNULLP (SCM_CDR (rest
)))
161 rest
= SCM_CDR (rest
);
163 SCM_SETCDR (prev
, SCM_CAR (rest
));
171 /* general questions about lists --- null?, list?, length, etc. */
173 SCM_DEFINE (scm_null_p
, "null?", 1, 0, 0,
175 "Return @code{#t} iff @var{x} is the empty list, else @code{#f}.")
176 #define FUNC_NAME s_scm_null_p
178 return SCM_BOOL (SCM_NULLP (x
));
183 SCM_DEFINE (scm_list_p
, "list?", 1, 0, 0,
185 "Return @code{#t} iff @var{x} is a proper list, else @code{#f}.")
186 #define FUNC_NAME s_scm_list_p
188 return SCM_BOOL (scm_ilength (x
) >= 0);
193 /* Return the length of SX, or -1 if it's not a proper list.
194 This uses the "tortoise and hare" algorithm to detect "infinitely
195 long" lists (i.e. lists with cycles in their cdrs), and returns -1
196 if it does find one. */
205 if (SCM_NULLP(hare
)) return i
;
206 if (SCM_NCONSP(hare
)) return -1;
207 hare
= SCM_CDR(hare
);
209 if (SCM_NULLP(hare
)) return i
;
210 if (SCM_NCONSP(hare
)) return -1;
211 hare
= SCM_CDR(hare
);
213 /* For every two steps the hare takes, the tortoise takes one. */
214 tortoise
= SCM_CDR(tortoise
);
216 while (! SCM_EQ_P (hare
, tortoise
));
218 /* If the tortoise ever catches the hare, then the list must contain
224 SCM_DEFINE (scm_length
, "length", 1, 0, 0,
226 "Return the number of elements in list @var{lst}.")
227 #define FUNC_NAME s_scm_length
230 SCM_VALIDATE_LIST_COPYLEN (1,lst
,i
);
231 return SCM_MAKINUM (i
);
237 /* appending lists */
239 SCM_DEFINE (scm_append
, "append", 0, 0, 1,
241 "Return a list consisting of the elements the lists passed as\n"
244 "(append '(x) '(y)) @result{} (x y)\n"
245 "(append '(a) '(b c d)) @result{} (a b c d)\n"
246 "(append '(a (b)) '((c))) @result{} (a (b) (c))\n"
248 "The resulting list is always newly allocated, except that it\n"
249 "shares structure with the last list argument. The last\n"
250 "argument may actually be any object; an improper list results\n"
251 "if the last argument is not a proper list.\n"
253 "(append '(a b) '(c . d)) @result{} (a b c . d)\n"
254 "(append '() 'a) @result{} a\n"
256 #define FUNC_NAME s_scm_append
258 SCM_VALIDATE_REST_ARGUMENT (args
);
259 if (SCM_NULLP (args
)) {
264 SCM arg
= SCM_CAR (args
);
265 args
= SCM_CDR (args
);
266 while (!SCM_NULLP (args
)) {
267 while (SCM_CONSP (arg
)) {
268 *lloc
= scm_cons (SCM_CAR (arg
), SCM_EOL
);
269 lloc
= SCM_CDRLOC (*lloc
);
272 SCM_VALIDATE_NULL (SCM_ARGn
, arg
);
273 arg
= SCM_CAR (args
);
274 args
= SCM_CDR (args
);
283 SCM_DEFINE (scm_append_x
, "append!", 0, 0, 1,
285 "A destructive version of @code{append} (@pxref{Pairs and\n"
286 "Lists,,,r5rs, The Revised^5 Report on Scheme}). The cdr field\n"
287 "of each list's final pair is changed to point to the head of\n"
288 "the next list, so no consing is performed. Return a pointer to\n"
290 #define FUNC_NAME s_scm_append_x
292 SCM_VALIDATE_REST_ARGUMENT (lists
);
294 if (SCM_NULLP (lists
)) {
297 SCM arg
= SCM_CAR (lists
);
298 lists
= SCM_CDR (lists
);
299 if (SCM_NULLP (lists
)) {
301 } else if (!SCM_NULLP (arg
)) {
302 SCM_VALIDATE_CONS (SCM_ARG1
, arg
);
303 SCM_SETCDR (scm_last_pair (arg
), scm_append_x (lists
));
312 SCM_DEFINE (scm_last_pair
, "last-pair", 1, 0, 0,
314 "Return a pointer to the last pair in @var{lst}, signalling an error if\n"
315 "@var{lst} is circular.")
316 #define FUNC_NAME s_scm_last_pair
324 SCM_VALIDATE_CONS (SCM_ARG1
, lst
);
326 SCM ahead
= SCM_CDR(hare
);
327 if (SCM_NCONSP(ahead
)) return hare
;
329 ahead
= SCM_CDR(hare
);
330 if (SCM_NCONSP(ahead
)) return hare
;
332 tortoise
= SCM_CDR(tortoise
);
334 while (! SCM_EQ_P (hare
, tortoise
));
335 SCM_MISC_ERROR ("Circular structure in position 1: ~S", scm_list_1 (lst
));
340 /* reversing lists */
342 SCM_DEFINE (scm_reverse
, "reverse", 1, 0, 0,
344 "Return a new list that contains the elements of @var{lst} but\n"
346 #define FUNC_NAME s_scm_reverse
348 SCM result
= SCM_EOL
;
353 if (SCM_NULLP(hare
)) return result
;
354 SCM_ASSERT(SCM_CONSP(hare
), lst
, 1, FUNC_NAME
);
355 result
= scm_cons (SCM_CAR (hare
), result
);
356 hare
= SCM_CDR (hare
);
357 if (SCM_NULLP(hare
)) return result
;
358 SCM_ASSERT(SCM_CONSP(hare
), lst
, 1, FUNC_NAME
);
359 result
= scm_cons (SCM_CAR (hare
), result
);
360 hare
= SCM_CDR (hare
);
361 tortoise
= SCM_CDR (tortoise
);
363 while (! SCM_EQ_P (hare
, tortoise
));
364 SCM_MISC_ERROR ("Circular structure in position 1: ~S", scm_list_1 (lst
));
368 SCM_DEFINE (scm_reverse_x
, "reverse!", 1, 1, 0,
369 (SCM lst
, SCM new_tail
),
370 "A destructive version of @code{reverse} (@pxref{Pairs and Lists,,,r5rs,\n"
371 "The Revised^5 Report on Scheme}). The cdr of each cell in @var{lst} is\n"
372 "modified to point to the previous list element. Return a pointer to the\n"
373 "head of the reversed list.\n\n"
374 "Caveat: because the list is modified in place, the tail of the original\n"
375 "list now becomes its head, and the head of the original list now becomes\n"
376 "the tail. Therefore, the @var{lst} symbol to which the head of the\n"
377 "original list was bound now points to the tail. To ensure that the head\n"
378 "of the modified list is not lost, it is wise to save the return value of\n"
380 #define FUNC_NAME s_scm_reverse_x
382 SCM_VALIDATE_LIST (1, lst
);
383 if (SCM_UNBNDP (new_tail
))
386 SCM_VALIDATE_LIST (2, new_tail
);
388 while (SCM_NNULLP (lst
))
390 SCM old_tail
= SCM_CDR (lst
);
391 SCM_SETCDR (lst
, new_tail
);
401 /* indexing lists by element number */
403 SCM_DEFINE (scm_list_ref
, "list-ref", 2, 0, 0,
405 "Return the @var{k}th element from @var{list}.")
406 #define FUNC_NAME s_scm_list_ref
410 SCM_VALIDATE_INUM_MIN_COPY (2,k
,0,i
);
411 while (SCM_CONSP (lst
)) {
413 return SCM_CAR (lst
);
420 SCM_OUT_OF_RANGE (2, k
);
422 SCM_WRONG_TYPE_ARG (1, list
);
427 SCM_DEFINE (scm_list_set_x
, "list-set!", 3, 0, 0,
428 (SCM list
, SCM k
, SCM val
),
429 "Set the @var{k}th element of @var{list} to @var{val}.")
430 #define FUNC_NAME s_scm_list_set_x
434 SCM_VALIDATE_INUM_MIN_COPY (2,k
,0,i
);
435 while (SCM_CONSP (lst
)) {
437 SCM_SETCAR (lst
, val
);
445 SCM_OUT_OF_RANGE (2, k
);
447 SCM_WRONG_TYPE_ARG (1, list
);
452 SCM_REGISTER_PROC(s_list_cdr_ref
, "list-cdr-ref", 2, 0, 0, scm_list_tail
);
454 SCM_DEFINE (scm_list_tail
, "list-tail", 2, 0, 0,
456 "@deffnx primitive list-cdr-ref lst k\n"
457 "Return the \"tail\" of @var{lst} beginning with its @var{k}th element.\n"
458 "The first element of the list is considered to be element 0.\n\n"
459 "@code{list-tail} and @code{list-cdr-ref} are identical. It may help to\n"
460 "think of @code{list-cdr-ref} as accessing the @var{k}th cdr of the list,\n"
461 "or returning the results of cdring @var{k} times down @var{lst}.")
462 #define FUNC_NAME s_scm_list_tail
465 SCM_VALIDATE_INUM_MIN_COPY (2,k
,0,i
);
467 SCM_VALIDATE_CONS (1,lst
);
475 SCM_DEFINE (scm_list_cdr_set_x
, "list-cdr-set!", 3, 0, 0,
476 (SCM list
, SCM k
, SCM val
),
477 "Set the @var{k}th cdr of @var{list} to @var{val}.")
478 #define FUNC_NAME s_scm_list_cdr_set_x
482 SCM_VALIDATE_INUM_MIN_COPY (2,k
,0,i
);
483 while (SCM_CONSP (lst
)) {
485 SCM_SETCDR (lst
, val
);
493 SCM_OUT_OF_RANGE (2, k
);
495 SCM_WRONG_TYPE_ARG (1, list
);
501 /* copying lists, perhaps partially */
503 SCM_DEFINE (scm_list_head
, "list-head", 2, 0, 0,
505 "Copy the first @var{k} elements from @var{lst} into a new list, and\n"
507 #define FUNC_NAME s_scm_list_head
513 SCM_VALIDATE_INUM_MIN_COPY (2,k
,0,i
);
518 SCM_VALIDATE_CONS (1,lst
);
519 *pos
= scm_cons (SCM_CAR (lst
), SCM_EOL
);
520 pos
= SCM_CDRLOC (*pos
);
528 SCM_DEFINE (scm_list_copy
, "list-copy", 1, 0, 0,
530 "Return a (newly-created) copy of @var{lst}.")
531 #define FUNC_NAME s_scm_list_copy
537 SCM_VALIDATE_LIST (1, lst
);
543 while (SCM_CONSP (from_here
))
546 c
= scm_cons (SCM_CAR (from_here
), SCM_CDR (from_here
));
548 fill_here
= SCM_CDRLOC (c
);
549 from_here
= SCM_CDR (from_here
);
556 /* membership tests (memq, memv, etc.) */
558 #if SCM_DEBUG_DEPRECATED == 0
560 SCM_DEFINE (scm_sloppy_memq
, "sloppy-memq", 2, 0, 0,
562 "This procedure behaves like @code{memq}, but does no type or error checking.\n"
563 "Its use is recommended only in writing Guile internals,\n"
564 "not for high-level Scheme programs.")
565 #define FUNC_NAME s_scm_sloppy_memq
567 for(; SCM_CONSP (lst
); lst
= SCM_CDR(lst
))
569 if (SCM_EQ_P (SCM_CAR (lst
), x
))
577 SCM_DEFINE (scm_sloppy_memv
, "sloppy-memv", 2, 0, 0,
579 "This procedure behaves like @code{memv}, but does no type or error checking.\n"
580 "Its use is recommended only in writing Guile internals,\n"
581 "not for high-level Scheme programs.")
582 #define FUNC_NAME s_scm_sloppy_memv
584 for(; SCM_CONSP (lst
); lst
= SCM_CDR(lst
))
586 if (! SCM_FALSEP (scm_eqv_p (SCM_CAR (lst
), x
)))
594 SCM_DEFINE (scm_sloppy_member
, "sloppy-member", 2, 0, 0,
596 "This procedure behaves like @code{member}, but does no type or error checking.\n"
597 "Its use is recommended only in writing Guile internals,\n"
598 "not for high-level Scheme programs.")
599 #define FUNC_NAME s_scm_sloppy_member
601 for(; SCM_CONSP (lst
); lst
= SCM_CDR(lst
))
603 if (! SCM_FALSEP (scm_equal_p (SCM_CAR (lst
), x
)))
610 #endif /* DEPRECATED */
612 /* The function scm_c_memq returns the first sublist of list whose car is
613 * 'eq?' obj, where the sublists of list are the non-empty lists returned by
614 * (list-tail list k) for k less than the length of list. If obj does not
615 * occur in list, then #f (not the empty list) is returned.
616 * List must be a proper list, otherwise scm_c_memq may crash or loop
620 scm_c_memq (SCM obj
, SCM list
)
622 for (; !SCM_NULLP (list
); list
= SCM_CDR (list
))
624 if (SCM_EQ_P (SCM_CAR (list
), obj
))
631 SCM_DEFINE (scm_memq
, "memq", 2, 0, 0,
633 "Return the first sublist of @var{lst} whose car is @code{eq?}\n"
634 "to @var{x} where the sublists of @var{lst} are the non-empty\n"
635 "lists returned by @code{(list-tail @var{lst} @var{k})} for\n"
636 "@var{k} less than the length of @var{lst}. If @var{x} does not\n"
637 "occur in @var{lst}, then @code{#f} (not the empty list) is\n"
639 #define FUNC_NAME s_scm_memq
641 SCM_VALIDATE_LIST (2, lst
);
642 return scm_c_memq (x
, lst
);
648 SCM_DEFINE (scm_memv
, "memv", 2, 0, 0,
650 "Return the first sublist of @var{lst} whose car is @code{eqv?}\n"
651 "to @var{x} where the sublists of @var{lst} are the non-empty\n"
652 "lists returned by @code{(list-tail @var{lst} @var{k})} for\n"
653 "@var{k} less than the length of @var{lst}. If @var{x} does not\n"
654 "occur in @var{lst}, then @code{#f} (not the empty list) is\n"
656 #define FUNC_NAME s_scm_memv
658 SCM_VALIDATE_LIST (2, lst
);
659 for (; !SCM_NULLP (lst
); lst
= SCM_CDR (lst
))
661 if (! SCM_FALSEP (scm_eqv_p (SCM_CAR (lst
), x
)))
669 SCM_DEFINE (scm_member
, "member", 2, 0, 0,
671 "Return the first sublist of @var{lst} whose car is\n"
672 "@code{equal?} to @var{x} where the sublists of @var{lst} are\n"
673 "the non-empty lists returned by @code{(list-tail @var{lst}\n"
674 "@var{k})} for @var{k} less than the length of @var{lst}. If\n"
675 "@var{x} does not occur in @var{lst}, then @code{#f} (not the\n"
676 "empty list) is returned.")
677 #define FUNC_NAME s_scm_member
679 SCM_VALIDATE_LIST (2, lst
);
680 for (; !SCM_NULLP (lst
); lst
= SCM_CDR (lst
))
682 if (! SCM_FALSEP (scm_equal_p (SCM_CAR (lst
), x
)))
691 /* deleting elements from a list (delq, etc.) */
693 SCM_DEFINE (scm_delq_x
, "delq!", 2, 0, 0,
695 "@deffnx primitive delv! item lst\n"
696 "@deffnx primitive delete! item lst\n"
697 "These procedures are destructive versions of @code{delq}, @code{delv}\n"
698 "and @code{delete}: they modify the pointers in the existing @var{lst}\n"
699 "rather than creating a new list. Caveat evaluator: Like other\n"
700 "destructive list functions, these functions cannot modify the binding of\n"
701 "@var{lst}, and so cannot be used to delete the first element of\n"
702 "@var{lst} destructively.")
703 #define FUNC_NAME s_scm_delq_x
708 for (prev
= &lst
, walk
= lst
;
710 walk
= SCM_CDR (walk
))
712 if (SCM_EQ_P (SCM_CAR (walk
), item
))
713 *prev
= SCM_CDR (walk
);
715 prev
= SCM_CDRLOC (walk
);
723 SCM_DEFINE (scm_delv_x
, "delv!", 2, 0, 0,
725 "Destructively remove all elements from @var{lst} that are\n"
726 "@code{eqv?} to @var{item}.")
727 #define FUNC_NAME s_scm_delv_x
732 for (prev
= &lst
, walk
= lst
;
734 walk
= SCM_CDR (walk
))
736 if (! SCM_FALSEP (scm_eqv_p (SCM_CAR (walk
), item
)))
737 *prev
= SCM_CDR (walk
);
739 prev
= SCM_CDRLOC (walk
);
748 SCM_DEFINE (scm_delete_x
, "delete!", 2, 0, 0,
750 "Destructively remove all elements from @var{lst} that are\n"
751 "@code{equal?} to @var{item}.")
752 #define FUNC_NAME s_scm_delete_x
757 for (prev
= &lst
, walk
= lst
;
759 walk
= SCM_CDR (walk
))
761 if (! SCM_FALSEP (scm_equal_p (SCM_CAR (walk
), item
)))
762 *prev
= SCM_CDR (walk
);
764 prev
= SCM_CDRLOC (walk
);
775 SCM_DEFINE (scm_delq
, "delq", 2, 0, 0,
777 "Return a newly-created copy of @var{lst} with elements\n"
778 "@code{eq?} to @var{item} removed. This procedure mirrors\n"
779 "@code{memq}: @code{delq} compares elements of @var{lst} against\n"
780 "@var{item} with @code{eq?}.")
781 #define FUNC_NAME s_scm_delq
783 SCM copy
= scm_list_copy (lst
);
784 return scm_delq_x (item
, copy
);
788 SCM_DEFINE (scm_delv
, "delv", 2, 0, 0,
790 "Return a newly-created copy of @var{lst} with elements\n"
791 "@code{eqv?} to @var{item} removed. This procedure mirrors\n"
792 "@code{memv}: @code{delv} compares elements of @var{lst} against\n"
793 "@var{item} with @code{eqv?}.")
794 #define FUNC_NAME s_scm_delv
796 SCM copy
= scm_list_copy (lst
);
797 return scm_delv_x (item
, copy
);
801 SCM_DEFINE (scm_delete
, "delete", 2, 0, 0,
803 "Return a newly-created copy of @var{lst} with elements\n"
804 "@code{equal?} to @var{item} removed. This procedure mirrors\n"
805 "@code{member}: @code{delete} compares elements of @var{lst}\n"
806 "against @var{item} with @code{equal?}.")
807 #define FUNC_NAME s_scm_delete
809 SCM copy
= scm_list_copy (lst
);
810 return scm_delete_x (item
, copy
);
815 SCM_DEFINE (scm_delq1_x
, "delq1!", 2, 0, 0,
817 "Like @code{delq!}, but only deletes the first occurrence of\n"
818 "@var{item} from @var{lst}. Tests for equality using\n"
819 "@code{eq?}. See also @code{delv1!} and @code{delete1!}.")
820 #define FUNC_NAME s_scm_delq1_x
825 for (prev
= &lst
, walk
= lst
;
827 walk
= SCM_CDR (walk
))
829 if (SCM_EQ_P (SCM_CAR (walk
), item
))
831 *prev
= SCM_CDR (walk
);
835 prev
= SCM_CDRLOC (walk
);
843 SCM_DEFINE (scm_delv1_x
, "delv1!", 2, 0, 0,
845 "Like @code{delv!}, but only deletes the first occurrence of\n"
846 "@var{item} from @var{lst}. Tests for equality using\n"
847 "@code{eqv?}. See also @code{delq1!} and @code{delete1!}.")
848 #define FUNC_NAME s_scm_delv1_x
853 for (prev
= &lst
, walk
= lst
;
855 walk
= SCM_CDR (walk
))
857 if (! SCM_FALSEP (scm_eqv_p (SCM_CAR (walk
), item
)))
859 *prev
= SCM_CDR (walk
);
863 prev
= SCM_CDRLOC (walk
);
871 SCM_DEFINE (scm_delete1_x
, "delete1!", 2, 0, 0,
873 "Like @code{delete!}, but only deletes the first occurrence of\n"
874 "@var{item} from @var{lst}. Tests for equality using\n"
875 "@code{equal?}. See also @code{delq1!} and @code{delv1!}.")
876 #define FUNC_NAME s_scm_delete1_x
881 for (prev
= &lst
, walk
= lst
;
883 walk
= SCM_CDR (walk
))
885 if (! SCM_FALSEP (scm_equal_p (SCM_CAR (walk
), item
)))
887 *prev
= SCM_CDR (walk
);
891 prev
= SCM_CDRLOC (walk
);
903 #ifndef SCM_MAGIC_SNARFER
904 #include "libguile/list.x"