Commit | Line | Data |
---|---|---|
7dc6e754 | 1 | /* Copyright (C) 1995,1996,1997 Free Software Foundation, Inc. |
0f2d19dd JB |
2 | * |
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) | |
6 | * any later version. | |
7 | * | |
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. | |
12 | * | |
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 | |
82892bed JB |
15 | * the Free Software Foundation, Inc., 59 Temple Place, Suite 330, |
16 | * Boston, MA 02111-1307 USA | |
0f2d19dd JB |
17 | * |
18 | * As a special exception, the Free Software Foundation gives permission | |
19 | * for additional uses of the text contained in its release of GUILE. | |
20 | * | |
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. | |
26 | * | |
27 | * This exception does not however invalidate any other reasons why | |
28 | * the executable file might be covered by the GNU General Public License. | |
29 | * | |
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. | |
37 | * | |
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. | |
82892bed | 40 | * If you do not wish that, delete this exception notice. */ |
0f2d19dd JB |
41 | \f |
42 | #include <stdio.h> | |
43 | #include "_scm.h" | |
20e6290e JB |
44 | #include "eq.h" |
45 | ||
46 | #include "list.h" | |
0f2d19dd JB |
47 | |
48 | #ifdef __STDC__ | |
49 | #include <stdarg.h> | |
50 | #define var_start(x, y) va_start(x, y) | |
51 | #else | |
52 | #include <varargs.h> | |
53 | #define var_start(x, y) va_start(x) | |
54 | #endif | |
55 | ||
56 | \f | |
df13742c | 57 | /* creating lists */ |
0f2d19dd | 58 | |
df13742c | 59 | /* SCM_P won't help us deal with varargs here. */ |
0f2d19dd JB |
60 | #ifdef __STDC__ |
61 | SCM | |
62 | scm_listify (SCM elt, ...) | |
63 | #else | |
64 | SCM | |
65 | scm_listify (elt, va_alist) | |
66 | SCM elt; | |
67 | va_dcl | |
0f2d19dd JB |
68 | #endif |
69 | { | |
70 | va_list foo; | |
71 | SCM answer; | |
72 | SCM *pos; | |
73 | ||
74 | var_start (foo, elt); | |
75 | answer = SCM_EOL; | |
76 | pos = &answer; | |
77 | while (elt != SCM_UNDEFINED) | |
78 | { | |
79 | *pos = scm_cons (elt, SCM_EOL); | |
25d8012c | 80 | pos = SCM_CDRLOC (*pos); |
0f2d19dd JB |
81 | elt = va_arg (foo, SCM); |
82 | } | |
83 | return answer; | |
84 | } | |
85 | ||
86 | ||
87 | SCM_PROC(s_list, "list", 0, 0, 1, scm_list); | |
0f2d19dd JB |
88 | SCM |
89 | scm_list(objs) | |
90 | SCM objs; | |
0f2d19dd JB |
91 | { |
92 | return objs; | |
93 | } | |
94 | ||
95 | ||
96 | ||
97 | \f | |
df13742c | 98 | /* general questions about lists --- null?, list?, length, etc. */ |
0f2d19dd JB |
99 | |
100 | SCM_PROC(s_null_p, "null?", 1, 0, 0, scm_null_p); | |
0f2d19dd JB |
101 | SCM |
102 | scm_null_p(x) | |
103 | SCM x; | |
0f2d19dd JB |
104 | { |
105 | return SCM_NULLP(x) ? SCM_BOOL_T : SCM_BOOL_F; | |
106 | } | |
107 | ||
108 | SCM_PROC(s_list_p, "list?", 1, 0, 0, scm_list_p); | |
0f2d19dd JB |
109 | SCM |
110 | scm_list_p(x) | |
111 | SCM x; | |
0f2d19dd JB |
112 | { |
113 | if (scm_ilength(x)<0) | |
114 | return SCM_BOOL_F; | |
115 | else | |
116 | return SCM_BOOL_T; | |
117 | } | |
118 | ||
119 | ||
df13742c | 120 | /* Return the length of SX, or -1 if it's not a proper list. |
448a3bc2 | 121 | This uses the "tortoise and hare" algorithm to detect "infinitely |
df13742c JB |
122 | long" lists (i.e. lists with cycles in their cdrs), and returns -1 |
123 | if it does find one. */ | |
0f2d19dd JB |
124 | long |
125 | scm_ilength(sx) | |
126 | SCM sx; | |
0f2d19dd JB |
127 | { |
128 | register long i = 0; | |
448a3bc2 | 129 | register SCM tortoise = sx; |
df13742c JB |
130 | register SCM hare = sx; |
131 | ||
0f2d19dd | 132 | do { |
df13742c JB |
133 | if SCM_IMP(hare) return SCM_NULLP(hare) ? i : -1; |
134 | if SCM_NCONSP(hare) return -1; | |
135 | hare = SCM_CDR(hare); | |
0f2d19dd | 136 | i++; |
df13742c JB |
137 | if SCM_IMP(hare) return SCM_NULLP(hare) ? i : -1; |
138 | if SCM_NCONSP(hare) return -1; | |
139 | hare = SCM_CDR(hare); | |
0f2d19dd | 140 | i++; |
448a3bc2 JB |
141 | /* For every two steps the hare takes, the tortoise takes one. */ |
142 | tortoise = SCM_CDR(tortoise); | |
0f2d19dd | 143 | } |
448a3bc2 | 144 | while (hare != tortoise); |
df13742c | 145 | |
448a3bc2 | 146 | /* If the tortoise ever catches the hare, then the list must contain |
df13742c | 147 | a cycle. */ |
0f2d19dd JB |
148 | return -1; |
149 | } | |
150 | ||
92396c0a | 151 | SCM_PROC(s_length, "length", 1, 0, 0, scm_length); |
0f2d19dd | 152 | SCM |
92396c0a | 153 | scm_length(x) |
0f2d19dd | 154 | SCM x; |
0f2d19dd JB |
155 | { |
156 | int i; | |
157 | i = scm_ilength(x); | |
92396c0a | 158 | SCM_ASSERT(i >= 0, x, SCM_ARG1, s_length); |
0f2d19dd JB |
159 | return SCM_MAKINUM (i); |
160 | } | |
161 | ||
162 | ||
163 | \f | |
df13742c | 164 | /* appending lists */ |
0f2d19dd | 165 | |
92396c0a | 166 | SCM_PROC (s_append, "append", 0, 0, 1, scm_append); |
0f2d19dd | 167 | SCM |
92396c0a | 168 | scm_append(args) |
0f2d19dd | 169 | SCM args; |
0f2d19dd JB |
170 | { |
171 | SCM res = SCM_EOL; | |
172 | SCM *lloc = &res, arg; | |
173 | if SCM_IMP(args) { | |
92396c0a | 174 | SCM_ASSERT(SCM_NULLP(args), args, SCM_ARGn, s_append); |
0f2d19dd JB |
175 | return res; |
176 | } | |
92396c0a | 177 | SCM_ASSERT(SCM_CONSP(args), args, SCM_ARGn, s_append); |
0f2d19dd JB |
178 | while (1) { |
179 | arg = SCM_CAR(args); | |
180 | args = SCM_CDR(args); | |
181 | if SCM_IMP(args) { | |
182 | *lloc = arg; | |
92396c0a | 183 | SCM_ASSERT(SCM_NULLP(args), args, SCM_ARGn, s_append); |
0f2d19dd JB |
184 | return res; |
185 | } | |
92396c0a | 186 | SCM_ASSERT(SCM_CONSP(args), args, SCM_ARGn, s_append); |
0f2d19dd | 187 | for(;SCM_NIMP(arg);arg = SCM_CDR(arg)) { |
92396c0a | 188 | SCM_ASSERT(SCM_CONSP(arg), arg, SCM_ARGn, s_append); |
0f2d19dd | 189 | *lloc = scm_cons(SCM_CAR(arg), SCM_EOL); |
25d8012c | 190 | lloc = SCM_CDRLOC(*lloc); |
0f2d19dd | 191 | } |
92396c0a | 192 | SCM_ASSERT(SCM_NULLP(arg), arg, SCM_ARGn, s_append); |
0f2d19dd JB |
193 | } |
194 | } | |
195 | ||
196 | ||
92396c0a | 197 | SCM_PROC (s_append_x, "append!", 0, 0, 1, scm_append_x); |
0f2d19dd | 198 | SCM |
92396c0a | 199 | scm_append_x(args) |
0f2d19dd | 200 | SCM args; |
0f2d19dd JB |
201 | { |
202 | SCM arg; | |
203 | tail: | |
204 | if SCM_NULLP(args) return SCM_EOL; | |
205 | arg = SCM_CAR(args); | |
0f2d19dd JB |
206 | args = SCM_CDR(args); |
207 | if SCM_NULLP(args) return arg; | |
208 | if SCM_NULLP(arg) goto tail; | |
92396c0a MD |
209 | SCM_ASSERT(SCM_NIMP(arg) && SCM_CONSP(arg), arg, SCM_ARG1, s_append_x); |
210 | SCM_SETCDR (scm_last_pair (arg), scm_append_x (args)); | |
0f2d19dd JB |
211 | return arg; |
212 | } | |
213 | ||
214 | ||
df13742c JB |
215 | SCM_PROC(s_last_pair, "last-pair", 1, 0, 0, scm_last_pair); |
216 | SCM | |
217 | scm_last_pair(sx) | |
218 | SCM sx; | |
219 | { | |
220 | register SCM res = sx; | |
221 | register SCM x; | |
0f2d19dd | 222 | |
df13742c JB |
223 | if (SCM_NULLP (sx)) |
224 | return SCM_EOL; | |
225 | ||
226 | SCM_ASSERT(SCM_NIMP(res) && SCM_CONSP(res), res, SCM_ARG1, s_last_pair); | |
227 | while (!0) { | |
228 | x = SCM_CDR(res); | |
229 | if (SCM_IMP(x) || SCM_NCONSP(x)) return res; | |
230 | res = x; | |
231 | x = SCM_CDR(res); | |
232 | if (SCM_IMP(x) || SCM_NCONSP(x)) return res; | |
233 | res = x; | |
234 | sx = SCM_CDR(sx); | |
235 | SCM_ASSERT(x != sx, sx, SCM_ARG1, s_last_pair); | |
236 | } | |
237 | } | |
238 | ||
239 | \f | |
240 | /* reversing lists */ | |
0f2d19dd | 241 | |
92396c0a | 242 | SCM_PROC (s_reverse, "reverse", 1, 0, 0, scm_reverse); |
0f2d19dd | 243 | SCM |
92396c0a | 244 | scm_reverse(lst) |
0f2d19dd | 245 | SCM lst; |
0f2d19dd JB |
246 | { |
247 | SCM res = SCM_EOL; | |
248 | SCM p = lst; | |
249 | for(;SCM_NIMP(p);p = SCM_CDR(p)) { | |
92396c0a | 250 | SCM_ASSERT(SCM_CONSP(p), lst, SCM_ARG1, s_reverse); |
0f2d19dd JB |
251 | res = scm_cons(SCM_CAR(p), res); |
252 | } | |
92396c0a | 253 | SCM_ASSERT(SCM_NULLP(p), lst, SCM_ARG1, s_reverse); |
0f2d19dd JB |
254 | return res; |
255 | } | |
256 | ||
92396c0a | 257 | SCM_PROC (s_reverse_x, "reverse!", 1, 1, 0, scm_reverse_x); |
0f2d19dd | 258 | SCM |
92396c0a | 259 | scm_reverse_x (lst, newtail) |
0f2d19dd JB |
260 | SCM lst; |
261 | SCM newtail; | |
0f2d19dd JB |
262 | { |
263 | SCM old_tail; | |
264 | if (newtail == SCM_UNDEFINED) | |
265 | newtail = SCM_EOL; | |
266 | ||
267 | loop: | |
268 | if (!(SCM_NIMP (lst) && SCM_CONSP (lst))) | |
269 | return lst; | |
270 | ||
271 | old_tail = SCM_CDR (lst); | |
272 | SCM_SETCDR (lst, newtail); | |
273 | if (SCM_NULLP (old_tail)) | |
274 | return lst; | |
275 | ||
276 | newtail = lst; | |
277 | lst = old_tail; | |
278 | goto loop; | |
279 | } | |
280 | ||
281 | ||
282 | \f | |
df13742c | 283 | /* indexing lists by element number */ |
0f2d19dd JB |
284 | |
285 | SCM_PROC(s_list_ref, "list-ref", 2, 0, 0, scm_list_ref); | |
0f2d19dd JB |
286 | SCM |
287 | scm_list_ref(lst, k) | |
288 | SCM lst; | |
289 | SCM k; | |
0f2d19dd JB |
290 | { |
291 | register long i; | |
292 | SCM_ASSERT(SCM_INUMP(k), k, SCM_ARG2, s_list_ref); | |
293 | i = SCM_INUM(k); | |
294 | SCM_ASSERT(i >= 0, k, SCM_ARG2, s_list_ref); | |
295 | while (i-- > 0) { | |
296 | SCM_ASRTGO(SCM_NIMP(lst) && SCM_CONSP(lst), erout); | |
297 | lst = SCM_CDR(lst); | |
298 | } | |
299 | erout: SCM_ASSERT(SCM_NIMP(lst) && SCM_CONSP(lst), | |
300 | SCM_NULLP(lst)?k:lst, SCM_NULLP(lst)?SCM_OUTOFRANGE:SCM_ARG1, s_list_ref); | |
301 | return SCM_CAR(lst); | |
302 | } | |
303 | ||
304 | SCM_PROC(s_list_set_x, "list-set!", 3, 0, 0, scm_list_set_x); | |
0f2d19dd JB |
305 | SCM |
306 | scm_list_set_x(lst, k, val) | |
307 | SCM lst; | |
308 | SCM k; | |
309 | SCM val; | |
0f2d19dd JB |
310 | { |
311 | register long i; | |
312 | SCM_ASSERT(SCM_INUMP(k), k, SCM_ARG2, s_list_set_x); | |
313 | i = SCM_INUM(k); | |
314 | SCM_ASSERT(i >= 0, k, SCM_ARG2, s_list_set_x); | |
315 | while (i-- > 0) { | |
316 | SCM_ASRTGO(SCM_NIMP(lst) && SCM_CONSP(lst), erout); | |
317 | lst = SCM_CDR(lst); | |
318 | } | |
319 | erout: SCM_ASSERT(SCM_NIMP(lst) && SCM_CONSP(lst), | |
320 | SCM_NULLP(lst)?k:lst, SCM_NULLP(lst)?SCM_OUTOFRANGE:SCM_ARG1, s_list_set_x); | |
25d8012c | 321 | SCM_SETCAR (lst, val); |
0f2d19dd JB |
322 | return val; |
323 | } | |
324 | ||
325 | ||
df13742c JB |
326 | SCM_PROC(s_list_cdr_ref, "list-cdr-ref", 2, 0, 0, scm_list_tail); |
327 | SCM_PROC(s_list_tail, "list-tail", 2, 0, 0, scm_list_tail); | |
328 | SCM | |
329 | scm_list_tail(lst, k) | |
330 | SCM lst; | |
331 | SCM k; | |
332 | { | |
333 | register long i; | |
334 | SCM_ASSERT(SCM_INUMP(k), k, SCM_ARG2, s_list_tail); | |
335 | i = SCM_INUM(k); | |
336 | while (i-- > 0) { | |
337 | SCM_ASSERT(SCM_NIMP(lst) && SCM_CONSP(lst), lst, SCM_ARG1, s_list_tail); | |
338 | lst = SCM_CDR(lst); | |
339 | } | |
340 | return lst; | |
341 | } | |
342 | ||
0f2d19dd JB |
343 | |
344 | SCM_PROC(s_list_cdr_set_x, "list-cdr-set!", 3, 0, 0, scm_list_cdr_set_x); | |
0f2d19dd JB |
345 | SCM |
346 | scm_list_cdr_set_x(lst, k, val) | |
347 | SCM lst; | |
348 | SCM k; | |
349 | SCM val; | |
0f2d19dd JB |
350 | { |
351 | register long i; | |
352 | SCM_ASSERT(SCM_INUMP(k), k, SCM_ARG2, s_list_cdr_set_x); | |
353 | i = SCM_INUM(k); | |
354 | SCM_ASSERT(i >= 0, k, SCM_ARG2, s_list_cdr_set_x); | |
355 | while (i-- > 0) { | |
356 | SCM_ASRTGO(SCM_NIMP(lst) && SCM_CONSP(lst), erout); | |
357 | lst = SCM_CDR(lst); | |
358 | } | |
359 | erout: SCM_ASSERT(SCM_NIMP(lst) && SCM_CONSP(lst), | |
360 | SCM_NULLP(lst)?k:lst, SCM_NULLP(lst)?SCM_OUTOFRANGE:SCM_ARG1, s_list_cdr_set_x); | |
361 | SCM_SETCDR (lst, val); | |
362 | return val; | |
363 | } | |
364 | ||
365 | ||
366 | \f | |
df13742c | 367 | /* copying lists, perhaps partially */ |
0f2d19dd JB |
368 | |
369 | SCM_PROC(s_list_head, "list-head", 2, 0, 0, scm_list_head); | |
0f2d19dd JB |
370 | SCM |
371 | scm_list_head(lst, k) | |
372 | SCM lst; | |
373 | SCM k; | |
0f2d19dd JB |
374 | { |
375 | SCM answer; | |
376 | SCM * pos; | |
377 | register long i; | |
378 | ||
379 | SCM_ASSERT(SCM_INUMP(k), k, SCM_ARG2, s_list_head); | |
380 | answer = SCM_EOL; | |
381 | pos = &answer; | |
382 | i = SCM_INUM(k); | |
383 | while (i-- > 0) | |
384 | { | |
385 | SCM_ASSERT(SCM_NIMP(lst) && SCM_CONSP(lst), lst, SCM_ARG1, s_list_head); | |
386 | *pos = scm_cons (SCM_CAR (lst), SCM_EOL); | |
25d8012c | 387 | pos = SCM_CDRLOC (*pos); |
0f2d19dd JB |
388 | lst = SCM_CDR(lst); |
389 | } | |
390 | return answer; | |
391 | } | |
392 | ||
393 | ||
df13742c JB |
394 | SCM_PROC (s_list_copy, "list-copy", 1, 0, 0, scm_list_copy); |
395 | SCM | |
396 | scm_list_copy (lst) | |
397 | SCM lst; | |
398 | { | |
399 | SCM newlst; | |
400 | SCM * fill_here; | |
401 | SCM from_here; | |
402 | ||
403 | newlst = SCM_EOL; | |
404 | fill_here = &newlst; | |
405 | from_here = lst; | |
406 | ||
407 | while (SCM_NIMP (from_here) && SCM_CONSP (from_here)) | |
408 | { | |
409 | SCM c; | |
410 | c = scm_cons (SCM_CAR (from_here), SCM_CDR (from_here)); | |
411 | *fill_here = c; | |
25d8012c | 412 | fill_here = SCM_CDRLOC (c); |
df13742c JB |
413 | from_here = SCM_CDR (from_here); |
414 | } | |
415 | return newlst; | |
416 | } | |
417 | ||
0f2d19dd | 418 | \f |
df13742c JB |
419 | /* membership tests (memq, memv, etc.) */ |
420 | ||
0f2d19dd | 421 | SCM_PROC (s_sloppy_memq, "sloppy-memq", 2, 0, 0, scm_sloppy_memq); |
0f2d19dd JB |
422 | SCM |
423 | scm_sloppy_memq(x, lst) | |
424 | SCM x; | |
425 | SCM lst; | |
0f2d19dd JB |
426 | { |
427 | for(; SCM_NIMP(lst) && SCM_CONSP (lst); lst = SCM_CDR(lst)) | |
428 | { | |
429 | if (SCM_CAR(lst)==x) | |
430 | return lst; | |
431 | } | |
432 | return lst; | |
433 | } | |
434 | ||
435 | ||
436 | SCM_PROC (s_sloppy_memv, "sloppy-memv", 2, 0, 0, scm_sloppy_memv); | |
0f2d19dd JB |
437 | SCM |
438 | scm_sloppy_memv(x, lst) | |
439 | SCM x; | |
440 | SCM lst; | |
0f2d19dd JB |
441 | { |
442 | for(; SCM_NIMP(lst) && SCM_CONSP (lst); lst = SCM_CDR(lst)) | |
443 | { | |
444 | if (SCM_BOOL_F != scm_eqv_p (SCM_CAR(lst), x)) | |
445 | return lst; | |
446 | } | |
447 | return lst; | |
448 | } | |
449 | ||
450 | ||
451 | SCM_PROC (s_sloppy_member, "sloppy-member", 2, 0, 0, scm_sloppy_member); | |
0f2d19dd JB |
452 | SCM |
453 | scm_sloppy_member (x, lst) | |
454 | SCM x; | |
455 | SCM lst; | |
0f2d19dd JB |
456 | { |
457 | for(; SCM_NIMP(lst) && SCM_CONSP (lst); lst = SCM_CDR(lst)) | |
458 | { | |
459 | if (SCM_BOOL_F != scm_equal_p (SCM_CAR(lst), x)) | |
460 | return lst; | |
461 | } | |
462 | return lst; | |
463 | } | |
464 | ||
465 | ||
466 | ||
467 | SCM_PROC(s_memq, "memq", 2, 0, 0, scm_memq); | |
0f2d19dd JB |
468 | SCM |
469 | scm_memq(x, lst) | |
470 | SCM x; | |
471 | SCM lst; | |
0f2d19dd JB |
472 | { |
473 | SCM answer; | |
82dc9f57 | 474 | SCM_ASSERT (scm_ilength (lst) >= 0, lst, SCM_ARG2, s_memq); |
0f2d19dd | 475 | answer = scm_sloppy_memq (x, lst); |
df13742c | 476 | return (answer == SCM_EOL) ? SCM_BOOL_F : answer; |
0f2d19dd JB |
477 | } |
478 | ||
479 | ||
480 | ||
481 | SCM_PROC(s_memv, "memv", 2, 0, 0, scm_memv); | |
0f2d19dd JB |
482 | SCM |
483 | scm_memv(x, lst) | |
484 | SCM x; | |
485 | SCM lst; | |
0f2d19dd JB |
486 | { |
487 | SCM answer; | |
82dc9f57 | 488 | SCM_ASSERT (scm_ilength (lst) >= 0, lst, SCM_ARG2, s_memv); |
0f2d19dd | 489 | answer = scm_sloppy_memv (x, lst); |
df13742c | 490 | return (answer == SCM_EOL) ? SCM_BOOL_F : answer; |
0f2d19dd JB |
491 | } |
492 | ||
493 | ||
494 | SCM_PROC(s_member, "member", 2, 0, 0, scm_member); | |
0f2d19dd JB |
495 | SCM |
496 | scm_member(x, lst) | |
497 | SCM x; | |
498 | SCM lst; | |
0f2d19dd JB |
499 | { |
500 | SCM answer; | |
82dc9f57 | 501 | SCM_ASSERT (scm_ilength (lst) >= 0, lst, SCM_ARG2, s_member); |
0f2d19dd | 502 | answer = scm_sloppy_member (x, lst); |
df13742c | 503 | return (answer == SCM_EOL) ? SCM_BOOL_F : answer; |
0f2d19dd JB |
504 | } |
505 | ||
506 | ||
507 | \f | |
df13742c | 508 | /* deleting elements from a list (delq, etc.) */ |
0f2d19dd JB |
509 | |
510 | SCM_PROC(s_delq_x, "delq!", 2, 0, 0, scm_delq_x); | |
0f2d19dd JB |
511 | SCM |
512 | scm_delq_x (item, lst) | |
513 | SCM item; | |
514 | SCM lst; | |
0f2d19dd | 515 | { |
164271a1 JB |
516 | SCM walk; |
517 | SCM *prev; | |
0f2d19dd | 518 | |
164271a1 JB |
519 | for (prev = &lst, walk = lst; |
520 | SCM_NIMP (walk) && SCM_CONSP (walk); | |
521 | walk = SCM_CDR (walk)) | |
0f2d19dd | 522 | { |
164271a1 JB |
523 | if (SCM_CAR (walk) == item) |
524 | *prev = SCM_CDR (walk); | |
525 | else | |
526 | prev = SCM_CDRLOC (walk); | |
0f2d19dd | 527 | } |
164271a1 JB |
528 | |
529 | return lst; | |
0f2d19dd JB |
530 | } |
531 | ||
532 | ||
533 | SCM_PROC(s_delv_x, "delv!", 2, 0, 0, scm_delv_x); | |
0f2d19dd JB |
534 | SCM |
535 | scm_delv_x (item, lst) | |
536 | SCM item; | |
537 | SCM lst; | |
0f2d19dd | 538 | { |
164271a1 JB |
539 | SCM walk; |
540 | SCM *prev; | |
0f2d19dd | 541 | |
164271a1 JB |
542 | for (prev = &lst, walk = lst; |
543 | SCM_NIMP (walk) && SCM_CONSP (walk); | |
544 | walk = SCM_CDR (walk)) | |
0f2d19dd | 545 | { |
164271a1 JB |
546 | if (SCM_BOOL_F != scm_eqv_p (SCM_CAR (walk), item)) |
547 | *prev = SCM_CDR (walk); | |
548 | else | |
549 | prev = SCM_CDRLOC (walk); | |
0f2d19dd | 550 | } |
164271a1 JB |
551 | |
552 | return lst; | |
0f2d19dd JB |
553 | } |
554 | ||
555 | ||
556 | ||
557 | SCM_PROC(s_delete_x, "delete!", 2, 0, 0, scm_delete_x); | |
0f2d19dd JB |
558 | SCM |
559 | scm_delete_x (item, lst) | |
560 | SCM item; | |
561 | SCM lst; | |
0f2d19dd | 562 | { |
164271a1 JB |
563 | SCM walk; |
564 | SCM *prev; | |
0f2d19dd | 565 | |
164271a1 JB |
566 | for (prev = &lst, walk = lst; |
567 | SCM_NIMP (walk) && SCM_CONSP (walk); | |
568 | walk = SCM_CDR (walk)) | |
0f2d19dd | 569 | { |
164271a1 JB |
570 | if (SCM_BOOL_F != scm_equal_p (SCM_CAR (walk), item)) |
571 | *prev = SCM_CDR (walk); | |
572 | else | |
573 | prev = SCM_CDRLOC (walk); | |
0f2d19dd | 574 | } |
164271a1 JB |
575 | |
576 | return lst; | |
0f2d19dd JB |
577 | } |
578 | ||
579 | ||
580 | \f | |
581 | ||
0f2d19dd JB |
582 | |
583 | SCM_PROC (s_delq, "delq", 2, 0, 0, scm_delq); | |
0f2d19dd JB |
584 | SCM |
585 | scm_delq (item, lst) | |
586 | SCM item; | |
587 | SCM lst; | |
0f2d19dd JB |
588 | { |
589 | SCM copy; | |
590 | ||
591 | copy = scm_list_copy (lst); | |
592 | return scm_delq_x (item, copy); | |
593 | } | |
594 | ||
595 | SCM_PROC (s_delv, "delv", 2, 0, 0, scm_delv); | |
0f2d19dd JB |
596 | SCM |
597 | scm_delv (item, lst) | |
598 | SCM item; | |
599 | SCM lst; | |
0f2d19dd JB |
600 | { |
601 | SCM copy; | |
602 | ||
603 | copy = scm_list_copy (lst); | |
604 | return scm_delv_x (item, copy); | |
605 | } | |
606 | ||
607 | SCM_PROC (s_delete, "delete", 2, 0, 0, scm_delete); | |
0f2d19dd JB |
608 | SCM |
609 | scm_delete (item, lst) | |
610 | SCM item; | |
611 | SCM lst; | |
0f2d19dd JB |
612 | { |
613 | SCM copy; | |
614 | ||
615 | copy = scm_list_copy (lst); | |
616 | return scm_delete_x (item, copy); | |
617 | } | |
618 | ||
619 | ||
82dc9f57 MD |
620 | SCM_PROC(s_delq1_x, "delq1!", 2, 0, 0, scm_delq1_x); |
621 | SCM | |
622 | scm_delq1_x (item, lst) | |
623 | SCM item; | |
624 | SCM lst; | |
625 | { | |
626 | SCM walk; | |
627 | SCM *prev; | |
628 | ||
629 | for (prev = &lst, walk = lst; | |
630 | SCM_NIMP (walk) && SCM_CONSP (walk); | |
631 | walk = SCM_CDR (walk)) | |
632 | { | |
633 | if (SCM_CAR (walk) == item) | |
634 | { | |
635 | *prev = SCM_CDR (walk); | |
636 | break; | |
637 | } | |
638 | else | |
639 | prev = SCM_CDRLOC (walk); | |
640 | } | |
641 | ||
642 | return lst; | |
643 | } | |
644 | ||
645 | ||
646 | SCM_PROC(s_delv1_x, "delv1!", 2, 0, 0, scm_delv1_x); | |
647 | SCM | |
648 | scm_delv1_x (item, lst) | |
649 | SCM item; | |
650 | SCM lst; | |
651 | { | |
652 | SCM walk; | |
653 | SCM *prev; | |
654 | ||
655 | for (prev = &lst, walk = lst; | |
656 | SCM_NIMP (walk) && SCM_CONSP (walk); | |
657 | walk = SCM_CDR (walk)) | |
658 | { | |
659 | if (SCM_BOOL_F != scm_eqv_p (SCM_CAR (walk), item)) | |
660 | { | |
661 | *prev = SCM_CDR (walk); | |
662 | break; | |
663 | } | |
664 | else | |
665 | prev = SCM_CDRLOC (walk); | |
666 | } | |
667 | ||
668 | return lst; | |
669 | } | |
670 | ||
671 | ||
672 | SCM_PROC(s_delete1_x, "delete1!", 2, 0, 0, scm_delete1_x); | |
673 | SCM | |
674 | scm_delete1_x (item, lst) | |
675 | SCM item; | |
676 | SCM lst; | |
677 | { | |
678 | SCM walk; | |
679 | SCM *prev; | |
680 | ||
681 | for (prev = &lst, walk = lst; | |
682 | SCM_NIMP (walk) && SCM_CONSP (walk); | |
683 | walk = SCM_CDR (walk)) | |
684 | { | |
685 | if (SCM_BOOL_F != scm_equal_p (SCM_CAR (walk), item)) | |
686 | { | |
687 | *prev = SCM_CDR (walk); | |
688 | break; | |
689 | } | |
690 | else | |
691 | prev = SCM_CDRLOC (walk); | |
692 | } | |
693 | ||
694 | return lst; | |
695 | } | |
696 | ||
697 | ||
0f2d19dd | 698 | \f |
0f2d19dd JB |
699 | void |
700 | scm_init_list () | |
0f2d19dd JB |
701 | { |
702 | #include "list.x" | |
703 | } |