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