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. */ |
1bbd0b84 GB |
41 | |
42 | /* Software engineering face-lift by Greg J. Badros, 11-Dec-1999, | |
43 | gjb@cs.washington.edu, http://www.cs.washington.edu/homes/gjb */ | |
44 | ||
0f2d19dd JB |
45 | \f |
46 | #include <stdio.h> | |
47 | #include "_scm.h" | |
20e6290e JB |
48 | #include "eq.h" |
49 | ||
1bbd0b84 | 50 | #include "scm_validate.h" |
20e6290e | 51 | #include "list.h" |
0f2d19dd JB |
52 | |
53 | #ifdef __STDC__ | |
54 | #include <stdarg.h> | |
55 | #define var_start(x, y) va_start(x, y) | |
56 | #else | |
57 | #include <varargs.h> | |
58 | #define var_start(x, y) va_start(x) | |
59 | #endif | |
60 | ||
61 | \f | |
df13742c | 62 | /* creating lists */ |
0f2d19dd | 63 | |
df13742c | 64 | /* SCM_P won't help us deal with varargs here. */ |
0f2d19dd JB |
65 | SCM |
66 | scm_listify (SCM elt, ...) | |
0f2d19dd JB |
67 | { |
68 | va_list foo; | |
69 | SCM answer; | |
70 | SCM *pos; | |
71 | ||
72 | var_start (foo, elt); | |
73 | answer = SCM_EOL; | |
74 | pos = &answer; | |
75 | while (elt != SCM_UNDEFINED) | |
76 | { | |
77 | *pos = scm_cons (elt, SCM_EOL); | |
25d8012c | 78 | pos = SCM_CDRLOC (*pos); |
0f2d19dd JB |
79 | elt = va_arg (foo, SCM); |
80 | } | |
81 | return answer; | |
82 | } | |
83 | ||
84 | ||
1bbd0b84 GB |
85 | GUILE_PROC(scm_list, "list", 0, 0, 1, |
86 | (SCM objs), | |
87 | "") | |
88 | #define FUNC_NAME s_scm_list | |
0f2d19dd JB |
89 | { |
90 | return objs; | |
91 | } | |
1bbd0b84 | 92 | #undef FUNC_NAME |
0f2d19dd JB |
93 | |
94 | ||
1bbd0b84 GB |
95 | GUILE_PROC (scm_list_star, "list*", 1, 0, 1, |
96 | (SCM arg, SCM rest), | |
97 | "") | |
98 | #define FUNC_NAME s_scm_list_star | |
a610b8d9 MD |
99 | { |
100 | if (SCM_NIMP (rest)) | |
101 | { | |
102 | SCM prev = arg = scm_cons (arg, rest); | |
103 | while (SCM_NIMP (SCM_CDR (rest))) | |
104 | { | |
105 | prev = rest; | |
106 | rest = SCM_CDR (rest); | |
107 | } | |
108 | SCM_SETCDR (prev, SCM_CAR (rest)); | |
109 | } | |
110 | return arg; | |
111 | } | |
1bbd0b84 | 112 | #undef FUNC_NAME |
a610b8d9 | 113 | |
0f2d19dd JB |
114 | |
115 | \f | |
df13742c | 116 | /* general questions about lists --- null?, list?, length, etc. */ |
0f2d19dd | 117 | |
1bbd0b84 GB |
118 | GUILE_PROC(scm_null_p, "null?", 1, 0, 0, |
119 | (SCM x), | |
120 | "") | |
121 | #define FUNC_NAME s_scm_null_p | |
0f2d19dd | 122 | { |
1bbd0b84 | 123 | return SCM_BOOL(SCM_NULLP(x)); |
0f2d19dd | 124 | } |
1bbd0b84 | 125 | #undef FUNC_NAME |
0f2d19dd | 126 | |
1bbd0b84 GB |
127 | GUILE_PROC(scm_list_p, "list?", 1, 0, 0, |
128 | (SCM x), | |
129 | "") | |
130 | #define FUNC_NAME s_scm_list_p | |
0f2d19dd | 131 | { |
1bbd0b84 | 132 | return SCM_BOOL(scm_ilength(x)>=0); |
0f2d19dd | 133 | } |
1bbd0b84 | 134 | #undef FUNC_NAME |
0f2d19dd JB |
135 | |
136 | ||
df13742c | 137 | /* Return the length of SX, or -1 if it's not a proper list. |
448a3bc2 | 138 | This uses the "tortoise and hare" algorithm to detect "infinitely |
df13742c JB |
139 | long" lists (i.e. lists with cycles in their cdrs), and returns -1 |
140 | if it does find one. */ | |
0f2d19dd | 141 | long |
1bbd0b84 | 142 | scm_ilength(SCM sx) |
0f2d19dd JB |
143 | { |
144 | register long i = 0; | |
448a3bc2 | 145 | register SCM tortoise = sx; |
df13742c JB |
146 | register SCM hare = sx; |
147 | ||
0f2d19dd | 148 | do { |
ff467021 JB |
149 | if (SCM_IMP(hare)) return SCM_NULLP(hare) ? i : -1; |
150 | if (SCM_NCONSP(hare)) return -1; | |
df13742c | 151 | hare = SCM_CDR(hare); |
0f2d19dd | 152 | i++; |
ff467021 JB |
153 | if (SCM_IMP(hare)) return SCM_NULLP(hare) ? i : -1; |
154 | if (SCM_NCONSP(hare)) return -1; | |
df13742c | 155 | hare = SCM_CDR(hare); |
0f2d19dd | 156 | i++; |
448a3bc2 JB |
157 | /* For every two steps the hare takes, the tortoise takes one. */ |
158 | tortoise = SCM_CDR(tortoise); | |
0f2d19dd | 159 | } |
448a3bc2 | 160 | while (hare != tortoise); |
df13742c | 161 | |
448a3bc2 | 162 | /* If the tortoise ever catches the hare, then the list must contain |
df13742c | 163 | a cycle. */ |
0f2d19dd JB |
164 | return -1; |
165 | } | |
166 | ||
1bbd0b84 GB |
167 | GUILE_PROC(scm_length, "length", 1, 0, 0, |
168 | (SCM lst), | |
169 | "") | |
170 | #define FUNC_NAME s_scm_length | |
0f2d19dd JB |
171 | { |
172 | int i; | |
1bbd0b84 | 173 | SCM_VALIDATE_LIST_COPYLEN(1,lst,i); |
0f2d19dd JB |
174 | return SCM_MAKINUM (i); |
175 | } | |
1bbd0b84 | 176 | #undef FUNC_NAME |
0f2d19dd JB |
177 | |
178 | ||
179 | \f | |
df13742c | 180 | /* appending lists */ |
0f2d19dd | 181 | |
1bbd0b84 GB |
182 | GUILE_PROC (scm_append, "append", 0, 0, 1, |
183 | (SCM args), | |
4079f87e GB |
184 | "A destructive version of @code{append} (@pxref{Pairs and Lists,,,r4rs, |
185 | The Revised^4 Report on Scheme}). The cdr field of each list's final | |
186 | pair is changed to point to the head of the next list, so no consing is | |
187 | performed. Return a pointer to the mutated list.") | |
1bbd0b84 | 188 | #define FUNC_NAME s_scm_append |
0f2d19dd JB |
189 | { |
190 | SCM res = SCM_EOL; | |
191 | SCM *lloc = &res, arg; | |
ff467021 | 192 | if (SCM_IMP(args)) { |
1bbd0b84 | 193 | SCM_VALIDATE_NULL(SCM_ARGn, args); |
0f2d19dd JB |
194 | return res; |
195 | } | |
1bbd0b84 | 196 | SCM_VALIDATE_CONS(SCM_ARGn, args); |
0f2d19dd JB |
197 | while (1) { |
198 | arg = SCM_CAR(args); | |
199 | args = SCM_CDR(args); | |
ff467021 | 200 | if (SCM_IMP(args)) { |
0f2d19dd | 201 | *lloc = arg; |
1bbd0b84 | 202 | SCM_VALIDATE_NULL(SCM_ARGn, args); |
0f2d19dd JB |
203 | return res; |
204 | } | |
1bbd0b84 | 205 | SCM_VALIDATE_CONS(SCM_ARGn, args); |
0f2d19dd | 206 | for(;SCM_NIMP(arg);arg = SCM_CDR(arg)) { |
1bbd0b84 | 207 | SCM_VALIDATE_CONS(SCM_ARGn, arg); |
0f2d19dd | 208 | *lloc = scm_cons(SCM_CAR(arg), SCM_EOL); |
25d8012c | 209 | lloc = SCM_CDRLOC(*lloc); |
0f2d19dd | 210 | } |
1bbd0b84 | 211 | SCM_VALIDATE_NULL(SCM_ARGn, arg); |
0f2d19dd JB |
212 | } |
213 | } | |
1bbd0b84 | 214 | #undef FUNC_NAME |
0f2d19dd JB |
215 | |
216 | ||
1bbd0b84 GB |
217 | GUILE_PROC (scm_append_x, "append!", 0, 0, 1, |
218 | (SCM args), | |
219 | "") | |
220 | #define FUNC_NAME s_scm_append_x | |
0f2d19dd JB |
221 | { |
222 | SCM arg; | |
223 | tail: | |
ff467021 | 224 | if (SCM_NULLP(args)) return SCM_EOL; |
0f2d19dd | 225 | arg = SCM_CAR(args); |
0f2d19dd | 226 | args = SCM_CDR(args); |
ff467021 JB |
227 | if (SCM_NULLP(args)) return arg; |
228 | if (SCM_NULLP(arg)) goto tail; | |
30939477 | 229 | SCM_VALIDATE_CONS(SCM_ARG1,arg); |
92396c0a | 230 | SCM_SETCDR (scm_last_pair (arg), scm_append_x (args)); |
0f2d19dd JB |
231 | return arg; |
232 | } | |
1bbd0b84 | 233 | #undef FUNC_NAME |
0f2d19dd JB |
234 | |
235 | ||
1bbd0b84 GB |
236 | GUILE_PROC(scm_last_pair, "last-pair", 1, 0, 0, |
237 | (SCM sx), | |
4079f87e GB |
238 | "Return a pointer to the last pair in @var{lst}, signalling an error if |
239 | @var{lst} is circular.") | |
1bbd0b84 | 240 | #define FUNC_NAME s_scm_last_pair |
df13742c JB |
241 | { |
242 | register SCM res = sx; | |
243 | register SCM x; | |
0f2d19dd | 244 | |
df13742c JB |
245 | if (SCM_NULLP (sx)) |
246 | return SCM_EOL; | |
247 | ||
30939477 | 248 | SCM_VALIDATE_CONS(SCM_ARG1,res); |
df13742c JB |
249 | while (!0) { |
250 | x = SCM_CDR(res); | |
251 | if (SCM_IMP(x) || SCM_NCONSP(x)) return res; | |
252 | res = x; | |
253 | x = SCM_CDR(res); | |
254 | if (SCM_IMP(x) || SCM_NCONSP(x)) return res; | |
255 | res = x; | |
256 | sx = SCM_CDR(sx); | |
1bbd0b84 | 257 | SCM_ASSERT(x != sx, sx, SCM_ARG1, FUNC_NAME); |
df13742c JB |
258 | } |
259 | } | |
1bbd0b84 | 260 | #undef FUNC_NAME |
df13742c JB |
261 | |
262 | \f | |
263 | /* reversing lists */ | |
0f2d19dd | 264 | |
1bbd0b84 GB |
265 | GUILE_PROC (scm_reverse, "reverse", 1, 0, 0, |
266 | (SCM ls), | |
4079f87e GB |
267 | "A destructive version of @code{reverse} (@pxref{Pairs and Lists,,,r4rs, |
268 | The Revised^4 Report on Scheme}). The cdr of each cell in @var{lst} is | |
269 | modified to point to the previous list element. Return a pointer to the | |
270 | head of the reversed list. | |
271 | ||
272 | Caveat: because the list is modified in place, the tail of the original | |
273 | list now becomes its head, and the head of the original list now becomes | |
274 | the tail. Therefore, the @var{lst} symbol to which the head of the | |
275 | original list was bound now points to the tail. To ensure that the head | |
276 | of the modified list is not lost, it is wise to save the return value of | |
277 | @code{reverse!}") | |
1bbd0b84 | 278 | #define FUNC_NAME s_scm_reverse |
0f2d19dd | 279 | { |
3946f0de MD |
280 | SCM res = SCM_EOL; |
281 | SCM p = ls, t = ls; | |
282 | while (SCM_NIMP (p)) | |
283 | { | |
1bbd0b84 | 284 | SCM_VALIDATE_CONS(1,ls); |
3946f0de MD |
285 | res = scm_cons (SCM_CAR (p), res); |
286 | p = SCM_CDR (p); | |
287 | if (SCM_IMP (p)) | |
288 | break; | |
1bbd0b84 | 289 | SCM_VALIDATE_CONS(1,ls); |
3946f0de MD |
290 | res = scm_cons (SCM_CAR (p), res); |
291 | p = SCM_CDR (p); | |
292 | t = SCM_CDR (t); | |
293 | if (t == p) | |
1bbd0b84 | 294 | scm_misc_error (FUNC_NAME, "Circular structure: %S", SCM_LIST1 (ls)); |
3946f0de | 295 | } |
1bbd0b84 GB |
296 | ls = p; |
297 | SCM_VALIDATE_NULL(1,ls); | |
3946f0de | 298 | return res; |
0f2d19dd | 299 | } |
1bbd0b84 | 300 | #undef FUNC_NAME |
0f2d19dd | 301 | |
1bbd0b84 GB |
302 | GUILE_PROC (scm_reverse_x, "reverse!", 1, 1, 0, |
303 | (SCM ls, SCM new_tail), | |
304 | "") | |
305 | #define FUNC_NAME s_scm_reverse_x | |
0f2d19dd JB |
306 | { |
307 | SCM old_tail; | |
1bbd0b84 | 308 | SCM_ASSERT (scm_ilength (ls) >= 0, ls, SCM_ARG1, FUNC_NAME); |
3946f0de MD |
309 | if (SCM_UNBNDP (new_tail)) |
310 | new_tail = SCM_EOL; | |
311 | else | |
1bbd0b84 | 312 | SCM_ASSERT (scm_ilength (new_tail) >= 0, new_tail, SCM_ARG2, FUNC_NAME); |
0f2d19dd | 313 | |
3946f0de MD |
314 | while (SCM_NIMP (ls)) |
315 | { | |
316 | old_tail = SCM_CDR (ls); | |
317 | SCM_SETCDR (ls, new_tail); | |
318 | new_tail = ls; | |
319 | ls = old_tail; | |
320 | } | |
321 | return new_tail; | |
0f2d19dd | 322 | } |
1bbd0b84 | 323 | #undef FUNC_NAME |
0f2d19dd JB |
324 | |
325 | ||
326 | \f | |
df13742c | 327 | /* indexing lists by element number */ |
0f2d19dd | 328 | |
1bbd0b84 GB |
329 | GUILE_PROC(scm_list_ref, "list-ref", 2, 0, 0, |
330 | (SCM lst, SCM k), | |
331 | "") | |
332 | #define FUNC_NAME s_scm_list_ref | |
333 | { | |
334 | register long i; | |
47c6b75e | 335 | SCM_VALIDATE_INUM_MIN_COPY(2,k,0,i); |
1bbd0b84 | 336 | while (i-- > 0) { |
0c95b57d | 337 | SCM_ASRTGO(SCM_CONSP(lst), erout); |
1bbd0b84 GB |
338 | lst = SCM_CDR(lst); |
339 | } | |
340 | erout: | |
0c95b57d | 341 | SCM_ASSERT(SCM_CONSP(lst), |
1bbd0b84 GB |
342 | SCM_NULLP(lst)?k:lst, SCM_NULLP(lst)?SCM_OUTOFRANGE:SCM_ARG1, FUNC_NAME); |
343 | return SCM_CAR(lst); | |
0f2d19dd | 344 | } |
1bbd0b84 | 345 | #undef FUNC_NAME |
0f2d19dd | 346 | |
1bbd0b84 GB |
347 | GUILE_PROC(scm_list_set_x, "list-set!", 3, 0, 0, |
348 | (SCM lst, SCM k, SCM val), | |
4079f87e | 349 | "Set the @var{k}th element of @var{lst} to @var{val}.") |
1bbd0b84 GB |
350 | #define FUNC_NAME s_scm_list_set_x |
351 | { | |
352 | register long i; | |
47c6b75e | 353 | SCM_VALIDATE_INUM_MIN_COPY(2,k,0,i); |
1bbd0b84 | 354 | while (i-- > 0) { |
0c95b57d | 355 | SCM_ASRTGO(SCM_CONSP(lst), erout); |
1bbd0b84 GB |
356 | lst = SCM_CDR(lst); |
357 | } | |
358 | erout: | |
0c95b57d | 359 | SCM_ASSERT(SCM_CONSP(lst), |
1bbd0b84 GB |
360 | SCM_NULLP(lst)?k:lst, SCM_NULLP(lst)?SCM_OUTOFRANGE:SCM_ARG1, FUNC_NAME); |
361 | SCM_SETCAR (lst, val); | |
362 | return val; | |
0f2d19dd | 363 | } |
1bbd0b84 | 364 | #undef FUNC_NAME |
0f2d19dd JB |
365 | |
366 | ||
1bbd0b84 GB |
367 | SCM_REGISTER_PROC(s_list_cdr_ref, "list-cdr-ref", 2, 0, 0, scm_list_tail); |
368 | ||
369 | GUILE_PROC(scm_list_tail, "list-tail", 2, 0, 0, | |
370 | (SCM lst, SCM k), | |
4079f87e GB |
371 | "Return the \"tail\" of @var{lst} beginning with its @var{k}th element. |
372 | The first element of the list is considered to be element 0. | |
373 | ||
374 | @code{list-cdr-ref} and @code{list-tail} are identical. It may help to | |
375 | think of @code{list-cdr-ref} as accessing the @var{k}th cdr of the list, | |
376 | or returning the results of cdring @var{k} times down @var{lst}.") | |
1bbd0b84 | 377 | #define FUNC_NAME s_scm_list_tail |
df13742c JB |
378 | { |
379 | register long i; | |
47c6b75e | 380 | SCM_VALIDATE_INUM_MIN_COPY(2,k,0,i); |
df13742c | 381 | while (i-- > 0) { |
30939477 | 382 | SCM_VALIDATE_CONS(1,lst); |
df13742c JB |
383 | lst = SCM_CDR(lst); |
384 | } | |
385 | return lst; | |
386 | } | |
1bbd0b84 | 387 | #undef FUNC_NAME |
df13742c | 388 | |
0f2d19dd | 389 | |
1bbd0b84 GB |
390 | GUILE_PROC(scm_list_cdr_set_x, "list-cdr-set!", 3, 0, 0, |
391 | (SCM lst, SCM k, SCM val), | |
4079f87e | 392 | "Set the @var{k}th cdr of @var{lst} to @var{val}.") |
1bbd0b84 GB |
393 | #define FUNC_NAME s_scm_list_cdr_set_x |
394 | { | |
395 | register long i; | |
47c6b75e | 396 | SCM_VALIDATE_INUM_MIN_COPY(2,k,0,i); |
1bbd0b84 | 397 | while (i-- > 0) { |
0c95b57d | 398 | SCM_ASRTGO(SCM_CONSP(lst), erout); |
1bbd0b84 GB |
399 | lst = SCM_CDR(lst); |
400 | } | |
401 | erout: | |
0c95b57d | 402 | SCM_ASSERT(SCM_CONSP(lst), |
1bbd0b84 GB |
403 | SCM_NULLP(lst)?k:lst, SCM_NULLP(lst)?SCM_OUTOFRANGE:SCM_ARG1, FUNC_NAME); |
404 | SCM_SETCDR (lst, val); | |
405 | return val; | |
0f2d19dd | 406 | } |
1bbd0b84 | 407 | #undef FUNC_NAME |
0f2d19dd JB |
408 | |
409 | ||
410 | \f | |
df13742c | 411 | /* copying lists, perhaps partially */ |
0f2d19dd | 412 | |
1bbd0b84 GB |
413 | GUILE_PROC(scm_list_head, "list-head", 2, 0, 0, |
414 | (SCM lst, SCM k), | |
4079f87e GB |
415 | "Copy the first @var{k} elements from @var{lst} into a new list, and |
416 | return it.") | |
1bbd0b84 | 417 | #define FUNC_NAME s_scm_list_head |
0f2d19dd JB |
418 | { |
419 | SCM answer; | |
420 | SCM * pos; | |
421 | register long i; | |
422 | ||
47c6b75e | 423 | SCM_VALIDATE_INUM_MIN_COPY(2,k,0,i); |
0f2d19dd JB |
424 | answer = SCM_EOL; |
425 | pos = &answer; | |
0f2d19dd JB |
426 | while (i-- > 0) |
427 | { | |
30939477 | 428 | SCM_VALIDATE_CONS(1,lst); |
0f2d19dd | 429 | *pos = scm_cons (SCM_CAR (lst), SCM_EOL); |
25d8012c | 430 | pos = SCM_CDRLOC (*pos); |
0f2d19dd JB |
431 | lst = SCM_CDR(lst); |
432 | } | |
433 | return answer; | |
434 | } | |
1bbd0b84 | 435 | #undef FUNC_NAME |
0f2d19dd JB |
436 | |
437 | ||
1bbd0b84 GB |
438 | GUILE_PROC (scm_list_copy, "list-copy", 1, 0, 0, |
439 | (SCM lst), | |
4079f87e | 440 | "Return a (newly-created) copy of @var{lst}.") |
1bbd0b84 | 441 | #define FUNC_NAME s_scm_list_copy |
df13742c JB |
442 | { |
443 | SCM newlst; | |
444 | SCM * fill_here; | |
445 | SCM from_here; | |
446 | ||
447 | newlst = SCM_EOL; | |
448 | fill_here = &newlst; | |
449 | from_here = lst; | |
450 | ||
0c95b57d | 451 | while (SCM_CONSP (from_here)) |
df13742c JB |
452 | { |
453 | SCM c; | |
454 | c = scm_cons (SCM_CAR (from_here), SCM_CDR (from_here)); | |
455 | *fill_here = c; | |
25d8012c | 456 | fill_here = SCM_CDRLOC (c); |
df13742c JB |
457 | from_here = SCM_CDR (from_here); |
458 | } | |
459 | return newlst; | |
460 | } | |
1bbd0b84 | 461 | #undef FUNC_NAME |
df13742c | 462 | |
0f2d19dd | 463 | \f |
df13742c JB |
464 | /* membership tests (memq, memv, etc.) */ |
465 | ||
1bbd0b84 GB |
466 | GUILE_PROC (scm_sloppy_memq, "sloppy-memq", 2, 0, 0, |
467 | (SCM x, SCM lst), | |
4079f87e GB |
468 | "@deffnx primitive sloppy-memv |
469 | @deffnx primitive sloppy-member | |
470 | These procedures behave like @code{memq}, @code{memv} and @code{member} | |
471 | (@pxref{Pairs and Lists,,,r4rs, The Revised^4 Report on Scheme}), but do | |
472 | not perform any type or error checking. Their use is recommended only | |
473 | in writing Guile internals, not for high-level Scheme programs.") | |
1bbd0b84 | 474 | #define FUNC_NAME s_scm_sloppy_memq |
0f2d19dd | 475 | { |
0c95b57d | 476 | for(; SCM_CONSP (lst); lst = SCM_CDR(lst)) |
0f2d19dd JB |
477 | { |
478 | if (SCM_CAR(lst)==x) | |
479 | return lst; | |
480 | } | |
481 | return lst; | |
482 | } | |
1bbd0b84 | 483 | #undef FUNC_NAME |
0f2d19dd JB |
484 | |
485 | ||
1bbd0b84 GB |
486 | GUILE_PROC (scm_sloppy_memv, "sloppy-memv", 2, 0, 0, |
487 | (SCM x, SCM lst), | |
488 | "") | |
489 | #define FUNC_NAME s_scm_sloppy_memv | |
0f2d19dd | 490 | { |
0c95b57d | 491 | for(; SCM_CONSP (lst); lst = SCM_CDR(lst)) |
0f2d19dd JB |
492 | { |
493 | if (SCM_BOOL_F != scm_eqv_p (SCM_CAR(lst), x)) | |
494 | return lst; | |
495 | } | |
496 | return lst; | |
497 | } | |
1bbd0b84 | 498 | #undef FUNC_NAME |
0f2d19dd JB |
499 | |
500 | ||
1bbd0b84 GB |
501 | GUILE_PROC (scm_sloppy_member, "sloppy-member", 2, 0, 0, |
502 | (SCM x, SCM lst), | |
503 | "") | |
504 | #define FUNC_NAME s_scm_sloppy_member | |
0f2d19dd | 505 | { |
0c95b57d | 506 | for(; SCM_CONSP (lst); lst = SCM_CDR(lst)) |
0f2d19dd JB |
507 | { |
508 | if (SCM_BOOL_F != scm_equal_p (SCM_CAR(lst), x)) | |
509 | return lst; | |
510 | } | |
511 | return lst; | |
512 | } | |
1bbd0b84 | 513 | #undef FUNC_NAME |
0f2d19dd JB |
514 | |
515 | ||
516 | ||
1bbd0b84 GB |
517 | GUILE_PROC(scm_memq, "memq", 2, 0, 0, |
518 | (SCM x, SCM lst), | |
519 | "") | |
520 | #define FUNC_NAME s_scm_memq | |
0f2d19dd JB |
521 | { |
522 | SCM answer; | |
1bbd0b84 | 523 | SCM_VALIDATE_LIST(2,lst); |
0f2d19dd | 524 | answer = scm_sloppy_memq (x, lst); |
df13742c | 525 | return (answer == SCM_EOL) ? SCM_BOOL_F : answer; |
0f2d19dd | 526 | } |
1bbd0b84 | 527 | #undef FUNC_NAME |
0f2d19dd JB |
528 | |
529 | ||
530 | ||
1bbd0b84 GB |
531 | GUILE_PROC(scm_memv, "memv", 2, 0, 0, |
532 | (SCM x, SCM lst), | |
533 | "") | |
534 | #define FUNC_NAME s_scm_memv | |
0f2d19dd JB |
535 | { |
536 | SCM answer; | |
1bbd0b84 | 537 | SCM_VALIDATE_LIST(2,lst); |
0f2d19dd | 538 | answer = scm_sloppy_memv (x, lst); |
df13742c | 539 | return (answer == SCM_EOL) ? SCM_BOOL_F : answer; |
0f2d19dd | 540 | } |
1bbd0b84 | 541 | #undef FUNC_NAME |
0f2d19dd JB |
542 | |
543 | ||
1bbd0b84 GB |
544 | GUILE_PROC(scm_member, "member", 2, 0, 0, |
545 | (SCM x, SCM lst), | |
546 | "") | |
547 | #define FUNC_NAME s_scm_member | |
0f2d19dd JB |
548 | { |
549 | SCM answer; | |
1bbd0b84 | 550 | SCM_VALIDATE_LIST(2,lst); |
0f2d19dd | 551 | answer = scm_sloppy_member (x, lst); |
df13742c | 552 | return (answer == SCM_EOL) ? SCM_BOOL_F : answer; |
0f2d19dd | 553 | } |
1bbd0b84 | 554 | #undef FUNC_NAME |
0f2d19dd JB |
555 | |
556 | ||
557 | \f | |
df13742c | 558 | /* deleting elements from a list (delq, etc.) */ |
0f2d19dd | 559 | |
1bbd0b84 GB |
560 | GUILE_PROC(scm_delq_x, "delq!", 2, 0, 0, |
561 | (SCM item, SCM lst), | |
4079f87e GB |
562 | "@deffnx primitive delv! item lst |
563 | @deffnx primitive delete! item lst | |
564 | These procedures are destructive versions of @code{delq}, @code{delv} | |
565 | and @code{delete}: they modify the pointers in the existing @var{lst} | |
566 | rather than creating a new list. Caveat evaluator: Like other | |
567 | destructive list functions, these functions cannot modify the binding of | |
568 | @var{lst}, and so cannot be used to delete the first element of | |
569 | @var{lst} destructively.") | |
1bbd0b84 | 570 | #define FUNC_NAME s_scm_delq_x |
0f2d19dd | 571 | { |
164271a1 JB |
572 | SCM walk; |
573 | SCM *prev; | |
0f2d19dd | 574 | |
164271a1 | 575 | for (prev = &lst, walk = lst; |
0c95b57d | 576 | SCM_CONSP (walk); |
164271a1 | 577 | walk = SCM_CDR (walk)) |
0f2d19dd | 578 | { |
164271a1 JB |
579 | if (SCM_CAR (walk) == item) |
580 | *prev = SCM_CDR (walk); | |
581 | else | |
582 | prev = SCM_CDRLOC (walk); | |
0f2d19dd | 583 | } |
164271a1 JB |
584 | |
585 | return lst; | |
0f2d19dd | 586 | } |
1bbd0b84 | 587 | #undef FUNC_NAME |
0f2d19dd JB |
588 | |
589 | ||
1bbd0b84 GB |
590 | GUILE_PROC(scm_delv_x, "delv!", 2, 0, 0, |
591 | (SCM item, SCM lst), | |
592 | "") | |
593 | #define FUNC_NAME s_scm_delv_x | |
0f2d19dd | 594 | { |
164271a1 JB |
595 | SCM walk; |
596 | SCM *prev; | |
0f2d19dd | 597 | |
164271a1 | 598 | for (prev = &lst, walk = lst; |
0c95b57d | 599 | SCM_CONSP (walk); |
164271a1 | 600 | walk = SCM_CDR (walk)) |
0f2d19dd | 601 | { |
164271a1 JB |
602 | if (SCM_BOOL_F != scm_eqv_p (SCM_CAR (walk), item)) |
603 | *prev = SCM_CDR (walk); | |
604 | else | |
605 | prev = SCM_CDRLOC (walk); | |
0f2d19dd | 606 | } |
164271a1 JB |
607 | |
608 | return lst; | |
0f2d19dd | 609 | } |
1bbd0b84 | 610 | #undef FUNC_NAME |
0f2d19dd JB |
611 | |
612 | ||
613 | ||
1bbd0b84 GB |
614 | GUILE_PROC(scm_delete_x, "delete!", 2, 0, 0, |
615 | (SCM item, SCM lst), | |
616 | "") | |
617 | #define FUNC_NAME s_scm_delete_x | |
0f2d19dd | 618 | { |
164271a1 JB |
619 | SCM walk; |
620 | SCM *prev; | |
0f2d19dd | 621 | |
164271a1 | 622 | for (prev = &lst, walk = lst; |
0c95b57d | 623 | SCM_CONSP (walk); |
164271a1 | 624 | walk = SCM_CDR (walk)) |
0f2d19dd | 625 | { |
164271a1 JB |
626 | if (SCM_BOOL_F != scm_equal_p (SCM_CAR (walk), item)) |
627 | *prev = SCM_CDR (walk); | |
628 | else | |
629 | prev = SCM_CDRLOC (walk); | |
0f2d19dd | 630 | } |
164271a1 JB |
631 | |
632 | return lst; | |
0f2d19dd | 633 | } |
1bbd0b84 | 634 | #undef FUNC_NAME |
0f2d19dd JB |
635 | |
636 | ||
637 | \f | |
638 | ||
0f2d19dd | 639 | |
1bbd0b84 GB |
640 | GUILE_PROC (scm_delq, "delq", 2, 0, 0, |
641 | (SCM item, SCM lst), | |
4079f87e GB |
642 | "@deffnx primitive delv item lst |
643 | @deffnx primitive delete item lst | |
644 | Return a newly-created copy of @var{lst} with @var{item} removed. These | |
645 | procedures mirror @code{memq}, @code{memv} and @code{member}: | |
646 | @code{delq} compares elements of @var{lst} against @var{item} with | |
647 | @code{eq?}, @code{delv} uses @code{eqv?} and @code{delete} uses @code{equal?}") | |
1bbd0b84 | 648 | #define FUNC_NAME s_scm_delq |
0f2d19dd | 649 | { |
1bbd0b84 | 650 | SCM copy = scm_list_copy (lst); |
0f2d19dd JB |
651 | return scm_delq_x (item, copy); |
652 | } | |
1bbd0b84 | 653 | #undef FUNC_NAME |
0f2d19dd | 654 | |
1bbd0b84 GB |
655 | GUILE_PROC (scm_delv, "delv", 2, 0, 0, |
656 | (SCM item, SCM lst), | |
657 | "") | |
658 | #define FUNC_NAME s_scm_delv | |
0f2d19dd | 659 | { |
1bbd0b84 | 660 | SCM copy = scm_list_copy (lst); |
0f2d19dd JB |
661 | return scm_delv_x (item, copy); |
662 | } | |
1bbd0b84 | 663 | #undef FUNC_NAME |
0f2d19dd | 664 | |
1bbd0b84 GB |
665 | GUILE_PROC (scm_delete, "delete", 2, 0, 0, |
666 | (SCM item, SCM lst), | |
667 | "") | |
668 | #define FUNC_NAME s_scm_delete | |
0f2d19dd | 669 | { |
1bbd0b84 | 670 | SCM copy = scm_list_copy (lst); |
0f2d19dd JB |
671 | return scm_delete_x (item, copy); |
672 | } | |
1bbd0b84 | 673 | #undef FUNC_NAME |
0f2d19dd JB |
674 | |
675 | ||
1bbd0b84 GB |
676 | GUILE_PROC(scm_delq1_x, "delq1!", 2, 0, 0, |
677 | (SCM item, SCM lst), | |
678 | "") | |
679 | #define FUNC_NAME s_scm_delq1_x | |
82dc9f57 MD |
680 | { |
681 | SCM walk; | |
682 | SCM *prev; | |
683 | ||
684 | for (prev = &lst, walk = lst; | |
0c95b57d | 685 | SCM_CONSP (walk); |
82dc9f57 MD |
686 | walk = SCM_CDR (walk)) |
687 | { | |
688 | if (SCM_CAR (walk) == item) | |
689 | { | |
690 | *prev = SCM_CDR (walk); | |
691 | break; | |
692 | } | |
693 | else | |
694 | prev = SCM_CDRLOC (walk); | |
695 | } | |
696 | ||
697 | return lst; | |
698 | } | |
1bbd0b84 | 699 | #undef FUNC_NAME |
82dc9f57 MD |
700 | |
701 | ||
1bbd0b84 GB |
702 | GUILE_PROC(scm_delv1_x, "delv1!", 2, 0, 0, |
703 | (SCM item, SCM lst), | |
704 | "") | |
705 | #define FUNC_NAME s_scm_delv1_x | |
82dc9f57 MD |
706 | { |
707 | SCM walk; | |
708 | SCM *prev; | |
709 | ||
710 | for (prev = &lst, walk = lst; | |
0c95b57d | 711 | SCM_CONSP (walk); |
82dc9f57 MD |
712 | walk = SCM_CDR (walk)) |
713 | { | |
714 | if (SCM_BOOL_F != scm_eqv_p (SCM_CAR (walk), item)) | |
715 | { | |
716 | *prev = SCM_CDR (walk); | |
717 | break; | |
718 | } | |
719 | else | |
720 | prev = SCM_CDRLOC (walk); | |
721 | } | |
722 | ||
723 | return lst; | |
724 | } | |
1bbd0b84 | 725 | #undef FUNC_NAME |
82dc9f57 MD |
726 | |
727 | ||
1bbd0b84 GB |
728 | GUILE_PROC(scm_delete1_x, "delete1!", 2, 0, 0, |
729 | (SCM item, SCM lst), | |
730 | "") | |
731 | #define FUNC_NAME s_scm_delete1_x | |
82dc9f57 MD |
732 | { |
733 | SCM walk; | |
734 | SCM *prev; | |
735 | ||
736 | for (prev = &lst, walk = lst; | |
0c95b57d | 737 | SCM_CONSP (walk); |
82dc9f57 MD |
738 | walk = SCM_CDR (walk)) |
739 | { | |
740 | if (SCM_BOOL_F != scm_equal_p (SCM_CAR (walk), item)) | |
741 | { | |
742 | *prev = SCM_CDR (walk); | |
743 | break; | |
744 | } | |
745 | else | |
746 | prev = SCM_CDRLOC (walk); | |
747 | } | |
748 | ||
749 | return lst; | |
750 | } | |
1bbd0b84 | 751 | #undef FUNC_NAME |
82dc9f57 MD |
752 | |
753 | ||
0f2d19dd | 754 | \f |
0f2d19dd JB |
755 | void |
756 | scm_init_list () | |
0f2d19dd JB |
757 | { |
758 | #include "list.x" | |
759 | } |