1 /* -*- tab-width:4; -*- */
2 /*
3 * List related functions
4 */
5 #include "s.h"
6 #include "vm2.h"
7 #include "stack.h"
8
wrong_arg_type(char * func,SOBJ obj)9 static void wrong_arg_type(char *func, SOBJ obj)
10 {
11 char erbuf[128];
12 sprintf(erbuf, "%s: wrong arg type", func);
13 SCM_ERR(erbuf, obj);
14 }
15
16 /*S* (pair? OBJ) => BOOLEAN */
17 /*D* Returns #t if obj is a pair, and otherwise returns #f. */
scm_pairp(SOBJ x)18 SOBJ scm_pairp(SOBJ x)
19 {
20 return (SCM_PAIRP(x) ? scm_true : scm_false);
21 }
22
23 /*S* (cons OBJ1 OBJ2) => PAIR */
24 /*D* Returns a newly allocated pair whose car is OBJ1 and whose cdr is
25 OBJ2. The pair is guaranteed to be different (in the sense of eqv?)
26 from every existing object. */
27
scm_cons(SOBJ car,SOBJ cdr)28 SOBJ scm_cons(SOBJ car, SOBJ cdr)
29 {
30 SOBJ new = scm_newcell(SOBJ_T_PAIR);
31 SCM_CAR(new) = car;
32 SCM_CDR(new) = cdr;
33 return (new);
34 }
35
36 /*E* (cons2 OBJ1 OBJ2 OBJ3) => PAIR */
37 /*D* Return a new pair construct whose car is OBJ1 and cdr is a cons
38 of OBJ2 and OBJ3. Example: (cons2 1 2 3) => (1 2 . 3) */
scm_cons2(SOBJ car,SOBJ cdr,SOBJ cddr)39 SOBJ scm_cons2(SOBJ car, SOBJ cdr, SOBJ cddr)
40 {
41 SOBJ new = scm_newcell(SOBJ_T_PAIR);
42 SCM_CAR(new) = car;
43 SCM_CDR(new) = scm_newcell(SOBJ_T_PAIR);
44 SCM_CADR(new) = cdr;
45 SCM_CDDR(new) = cddr;
46 return (new);
47 }
48
49 /*S* (car PAIR) => OBJ*/
50 /*D* Returns the contents of the car field of pair. Note that it is an
51 error to take the car of the empty list.*/
scm_car(SOBJ obj)52 SOBJ scm_car(SOBJ obj)
53 {
54 if (!SCM_PAIRP(obj))
55 wrong_arg_type("car", obj);
56 return (SCM_CAR(obj));
57 }
58
59 /*S* (cdr PAIR) => OBJ */
60 /*D* Returns the contents of the cdr field of pair. Note that it is
61 an error to take the cdr of the empty list. */
scm_cdr(SOBJ obj)62 SOBJ scm_cdr(SOBJ obj)
63 {
64 if (!SCM_PAIRP(obj))
65 wrong_arg_type("cdr", obj);
66 return (SCM_CDR(obj));
67 }
68
69 /*S* (set-car! PAIR OBJ) => #undefined */
70 /*D* Stores OBJ in the car field of PAIR. */
scm_setcar(SOBJ obj,SOBJ val)71 SOBJ scm_setcar(SOBJ obj, SOBJ val)
72 {
73 if (!SCM_PAIRP(obj))
74 wrong_arg_type("set-car!", obj);
75 SCM_CAR(obj) = val;
76 return (scm_undefined);
77 }
78
79 /*S* (set-cdr! PAIR OBJ) => #undefined */
80 /*D* Stores OBJ in the cdr field of PAIR. */
scm_setcdr(SOBJ obj,SOBJ val)81 SOBJ scm_setcdr(SOBJ obj, SOBJ val)
82 {
83 if (!SCM_PAIRP(obj))
84 wrong_arg_type("set-cdr!", obj);
85 SCM_CDR(obj) = val;
86 return (scm_undefined);
87 }
88
internal_cxr(SOBJ l,char * fct)89 static SOBJ internal_cxr(SOBJ l, char *fct)
90 {
91 register SOBJ tmp = l;
92 register char *p;
93
94 for (p = fct + strlen(fct) - 1; *p != 'X'; p--) {
95 if (tmp == NULL || !SCM_PAIRP(tmp)) {
96 char name[50];
97 sprintf(name, "c%sr: bad list", fct + 1);
98 SCM_ERR(name, l);
99 }
100 tmp = (*p == 'a') ? SCM_CAR(tmp) : SCM_CDR(tmp);
101 }
102 return tmp;
103 }
104
scm_caar(SOBJ l)105 SOBJ scm_caar(SOBJ l) { return(internal_cxr(l, "Xaa")); }
scm_cdar(SOBJ l)106 SOBJ scm_cdar(SOBJ l) { return(internal_cxr(l, "Xda")); }
scm_cadr(SOBJ l)107 SOBJ scm_cadr(SOBJ l) { return(internal_cxr(l, "Xad")); }
scm_cddr(SOBJ l)108 SOBJ scm_cddr(SOBJ l) { return(internal_cxr(l, "Xdd")); }
scm_caaar(SOBJ l)109 SOBJ scm_caaar(SOBJ l) { return(internal_cxr(l, "Xaaa")); }
scm_cdaar(SOBJ l)110 SOBJ scm_cdaar(SOBJ l) { return(internal_cxr(l, "Xdaa")); }
scm_cadar(SOBJ l)111 SOBJ scm_cadar(SOBJ l) { return(internal_cxr(l, "Xada")); }
scm_cddar(SOBJ l)112 SOBJ scm_cddar(SOBJ l) { return(internal_cxr(l, "Xdda")); }
scm_caadr(SOBJ l)113 SOBJ scm_caadr(SOBJ l) { return(internal_cxr(l, "Xaad")); }
scm_cdadr(SOBJ l)114 SOBJ scm_cdadr(SOBJ l) { return(internal_cxr(l, "Xdad")); }
scm_caddr(SOBJ l)115 SOBJ scm_caddr(SOBJ l) { return(internal_cxr(l, "Xadd")); }
scm_cdddr(SOBJ l)116 SOBJ scm_cdddr(SOBJ l) { return(internal_cxr(l, "Xddd")); }
scm_caaaar(SOBJ l)117 SOBJ scm_caaaar(SOBJ l) { return(internal_cxr(l, "Xaaaa")); }
scm_cdaaar(SOBJ l)118 SOBJ scm_cdaaar(SOBJ l) { return(internal_cxr(l, "Xdaaa")); }
scm_cadaar(SOBJ l)119 SOBJ scm_cadaar(SOBJ l) { return(internal_cxr(l, "Xadaa")); }
scm_cddaar(SOBJ l)120 SOBJ scm_cddaar(SOBJ l) { return(internal_cxr(l, "Xddaa")); }
scm_caadar(SOBJ l)121 SOBJ scm_caadar(SOBJ l) { return(internal_cxr(l, "Xaada")); }
scm_cdadar(SOBJ l)122 SOBJ scm_cdadar(SOBJ l) { return(internal_cxr(l, "Xdada")); }
scm_caddar(SOBJ l)123 SOBJ scm_caddar(SOBJ l) { return(internal_cxr(l, "Xadda")); }
scm_cdddar(SOBJ l)124 SOBJ scm_cdddar(SOBJ l) { return(internal_cxr(l, "Xddda")); }
scm_caaadr(SOBJ l)125 SOBJ scm_caaadr(SOBJ l) { return(internal_cxr(l, "Xaaad")); }
scm_cdaadr(SOBJ l)126 SOBJ scm_cdaadr(SOBJ l) { return(internal_cxr(l, "Xdaad")); }
scm_cadadr(SOBJ l)127 SOBJ scm_cadadr(SOBJ l) { return(internal_cxr(l, "Xadad")); }
scm_cddadr(SOBJ l)128 SOBJ scm_cddadr(SOBJ l) { return(internal_cxr(l, "Xddad")); }
scm_caaddr(SOBJ l)129 SOBJ scm_caaddr(SOBJ l) { return(internal_cxr(l, "Xaadd")); }
scm_cdaddr(SOBJ l)130 SOBJ scm_cdaddr(SOBJ l) { return(internal_cxr(l, "Xdadd")); }
scm_cadddr(SOBJ l)131 SOBJ scm_cadddr(SOBJ l) { return(internal_cxr(l, "Xaddd")); }
scm_cddddr(SOBJ l)132 SOBJ scm_cddddr(SOBJ l) { return(internal_cxr(l, "Xdddd")); }
133
134 /*S* (null? OBJ) => BOOLEAN */
135 /*D* Returns #t if obj is the empty list, otherwise returns #f. */
scm_nullp(SOBJ obj)136 SOBJ scm_nullp(SOBJ obj)
137 {
138 return ((obj == NULL) ? scm_true : scm_false);
139 }
140
141 /* Return the length of SX, or -1 if it's not a proper list.
142 This uses the "tortoise and hare" algorithm to detect "infinitely
143 long" lists (i.e. lists with cycles in their cdrs), and returns -1
144 if it does find one. */
scm_list_length(SOBJ sx)145 long scm_list_length(SOBJ sx)
146 {
147 long i = 0;
148 SOBJ tortoise = sx;
149 SOBJ hare = sx;
150
151 do {
152 if (SCM_NULLP(hare)) return i;
153 if (!SCM_PAIRP(hare)) return -1;
154 hare = SCM_CDR(hare);
155 i++;
156 if (SCM_NULLP(hare)) return i;
157 if (!SCM_PAIRP(hare)) return -1;
158 hare = SCM_CDR(hare);
159 i++;
160 /* For every two steps the hare takes, the tortoise takes one. */
161 tortoise = SCM_CDR(tortoise);
162 }
163 while (hare != tortoise);
164
165 /* If the tortoise ever catches the hare, then the list must contain
166 a cycle. */
167 return -1;
168 }
169
170 /*S* (list? OBJ) => BOOLEAN */
171 /*D* Returns #t if obj is a list, otherwise returns #f. */
scm_listp(SOBJ obj)172 SOBJ scm_listp(SOBJ obj)
173 {
174 return (scm_list_length(obj) >= 0 ? scm_true : scm_false);
175 }
176
177 /*S* (list OBJ ...) => LIST */
178 /*D* Returns a newly allocated list of its arguments.*/
scm_list(int n,SOBJ * obja)179 SOBJ scm_list(int n, SOBJ *obja)
180 {
181 SOBJ *p, list = NULL;
182 p = obja + n;
183 while (--p >= obja) {
184 list = scm_cons(*p, list);
185 }
186 return (list);
187 }
188
189 /*S* (length LIST) => NUMBER */
190 /*D* Returns the length of LIST. */
scm_length(SOBJ obj)191 SOBJ scm_length(SOBJ obj)
192 {
193 int len;
194 len = scm_list_length(obj);
195 if (len < 0)
196 SCM_ERR("length: not calculable", obj);
197 return (SCM_MKINUM(len));
198 }
199
200 /*S* (append LIST ...) => LIST */
201 /*D* Returns a list consisting of the elements of the first list
202 followed by the elements of the other lists. */
scm_append(int len,SOBJ * l)203 SOBJ scm_append(int len, SOBJ *l)
204 {
205 SOBJ res,arg = NULL;
206 SOBJ *last = &res, *limit;
207
208 if (len == 0) return(NULL);
209 for (limit = l + len; l < limit; l++) {
210 for (arg = *l; arg; arg = SCM_CDR(arg)) {
211 if (!SCM_PAIRP(arg)) {
212 if (l < (limit - 1)) SCM_ERR("append: bad list", *l);
213 break;
214 }
215 *last = scm_cons(SCM_CAR(arg), NULL);
216 last = &SCM_CDR(*last);
217 }
218 }
219 *last = arg;
220 return res;
221 }
222
223 /*E* (append2 LIST1 LIST2) => LIST */
224 /*D* Returns a list consisting of the elements of the LIST1 followed
225 by the elements of the LIST2 */
scm_append2(SOBJ l1,SOBJ l2)226 SOBJ scm_append2(SOBJ l1, SOBJ l2)
227 {
228 SOBJ arg[2];
229 arg[0] = l1; arg[1] = l2;
230 return(scm_append(2, arg));
231 }
232
233 /*S* (reverse LIST) => LIST */
234 /*D* Returns a newly allocated list consisting of the elements of list in
235 reverse order. */
scm_reverse(SOBJ l)236 SOBJ scm_reverse(SOBJ l)
237 {
238 SOBJ n = NULL;
239 while (l) {
240 if (!SCM_PAIRP(l))
241 SCM_ERR("reverse: bad list", l);
242 n = scm_cons(SCM_CAR(l), n);
243 l = SCM_CDR(l);
244 }
245 return (n);
246 }
247
248 /*S* (list-tail LIST K) => LIST */
249 /*D* Returns the sublist of LIST obtained by omitting the first K
250 elements. It is an error if LIST has fewer than K elements. */
scm_list_tail(SOBJ list,SOBJ k)251 SOBJ scm_list_tail(SOBJ list, SOBJ k)
252 {
253 SOBJ l;
254 long x;
255
256 if (!SCM_PAIRP(list))
257 SCM_ERR("list-tail: bad list", list);
258 if (!SCM_INUMP(k))
259 SCM_ERR("list-tail: bad index", k);
260 x = SCM_INUM(k);
261 if (x < 0)
262 SCM_ERR("list-tail: index must be exact positive integer", k);
263 l = list;
264
265 for (l = list; x > 0; x--) {
266 if (l == NULL || !SCM_PAIRP(l))
267 SCM_ERR("list-tail: list too short", list);
268 l = SCM_CDR(l);
269 }
270 return l;
271 }
272
273 /*S* (list-ref LIST K) => OBJ */
274 /*D* Returns the Kth element of LIST. (This is the same as the car of
275 (list-tail LIST K).) It is an error if LIST has fewer than K
276 elements. */
scm_list_ref(SOBJ list,SOBJ k)277 SOBJ scm_list_ref(SOBJ list, SOBJ k)
278 {
279 SOBJ l;
280 long x;
281
282 if (!SCM_PAIRP(list))
283 SCM_ERR("list-ref: Bad list", list);
284 if (!SCM_INUMP(k))
285 SCM_ERR("list-tail: bad index", k);
286 x = SCM_INUM(k);
287 if (x < 0)
288 SCM_ERR("list-ref: index must be exact positive integer", k);
289 l = list;
290
291 for (; x > 0; x--) {
292 if (l == NULL || !SCM_PAIRP(l))
293 break;
294 l = SCM_CDR(l);
295 }
296 if (l == NULL || !SCM_PAIRP(l))
297 SCM_ERR("list-ref: list too short", list);
298
299 return(SCM_CAR(l));
300 }
301
lmember(SOBJ obj,SOBJ list,SOBJ (* predicate)(SOBJ,SOBJ))302 static SOBJ lmember(SOBJ obj, SOBJ list, SOBJ (*predicate) (SOBJ, SOBJ))
303 {
304 register SOBJ ptr;
305
306 if (!SCM_PAIRP(list) && !SCM_NULLP(list))
307 SCM_ERR("member: bad list", list);
308 for (ptr = list; !SCM_NULLP(ptr);) {
309 if (SCM_PAIRP(ptr)) {
310 if ((*predicate) (SCM_CAR(ptr), obj) == scm_true)
311 return(ptr);
312 } else
313 /* end of a dotted list */
314 return ((*predicate) (ptr, obj) == scm_true) ? ptr : scm_false;
315 if ((ptr = SCM_CDR(ptr)) == list)
316 SCM_ERR("member: circular list", NULL);
317 }
318 return(scm_false);
319 }
320
321 /*S* (memq OBJ LIST) => LIST | #f */
322 /*D* Return the first sublist of LIST whose car is OBJ. If OBJ does
323 not occur in LIST, then #f is returned. Memq uses eq? to compare OBJ
324 with the elements of LIST. */
scm_memq(SOBJ obj,SOBJ list)325 SOBJ scm_memq(SOBJ obj, SOBJ list)
326 {
327 return(lmember(obj, list, scm_eq));
328 }
329
330 /*S* (memv OBJ LIST) => LIST | #f */
331 /*D* Return the first sublist of LIST whose car is OBJ. If OBJ does
332 not occur in LIST, then #f is returned. Memq uses eqv? to compare OBJ
333 with the elements of LIST. */
scm_memv(SOBJ obj,SOBJ list)334 SOBJ scm_memv(SOBJ obj, SOBJ list)
335 {
336 return(lmember(obj, list, scm_eqv));
337 }
338
339 /*S* (member OBJ LIST) => LIST | #f */
340 /*D* Return the first sublist of LIST whose car is OBJ. If OBJ does
341 not occur in LIST, then #f is returned. Memq uses equal? to compare OBJ
342 with the elements of LIST. */
scm_member(SOBJ obj,SOBJ list)343 SOBJ scm_member(SOBJ obj, SOBJ list)
344 {
345 return(lmember(obj, list, scm_equal));
346 }
347
lassoc(SOBJ obj,SOBJ alist,SOBJ (* predicate)(SOBJ,SOBJ))348 static SOBJ lassoc(SOBJ obj, SOBJ alist, SOBJ (*predicate) (SOBJ, SOBJ))
349 {
350 register SOBJ l, tmp;
351
352 for (l = alist; SCM_PAIRP(l);) {
353 tmp = SCM_CAR(l);
354 if (SCM_PAIRP(tmp) && (*predicate) (SCM_CAR(tmp), obj) == scm_true)
355 return tmp;
356
357 if ((l = SCM_CDR(l)) == alist)
358 SCM_ERR("assoc function: cirular list", alist);
359 }
360 if (!SCM_NULLP(l))
361 SCM_ERR("assoc function: improper list", alist);
362
363 return (scm_false);
364 }
365
366 /*S* (assq OBJ ALIST) => PAIR | #f */
367 /*D* Return the first PAIR in ALIST whose car field eq? OBJ. If no
368 pair in ALIST has OBJ as its car, then #f is returned.*/
scm_assq(SOBJ obj,SOBJ alist)369 SOBJ scm_assq(SOBJ obj, SOBJ alist)
370 {
371 return(lassoc(obj, alist, scm_eq));
372 }
373
374 /*S* (assv OBJ ALIST) => PAIR | #f */
375 /*D* Return the first PAIR in ALIST whose car field eqv? OBJ. If no
376 pair in ALIST has OBJ as its car, then #f is returned.*/
scm_assv(SOBJ obj,SOBJ alist)377 SOBJ scm_assv(SOBJ obj, SOBJ alist)
378 {
379 return(lassoc(obj, alist, scm_eqv));
380 }
381
382 /*S* (assoc OBJ ALIST) => PAIR | #f */
383 /*D* Return the first PAIR in ALIST whose car field equal? OBJ. If no
384 pair in ALIST has OBJ as its car, then #f is returned.*/
scm_assoc(SOBJ obj,SOBJ alist)385 SOBJ scm_assoc(SOBJ obj, SOBJ alist)
386 {
387 return(lassoc(obj, alist, scm_equal));
388 }
389
390
scm_map2(SOBJ func,int argc,SOBJ * argv,int map)391 SOBJ scm_map2(SOBJ func, int argc, SOBJ *argv, int map)
392 {
393 SOBJ *code, res, *tmp, list;
394 int i, j;
395
396 code = alloca((argc + 6) * sizeof(SOBJ));
397 code[0] = SCM_OPCODE(SCM_OP_MARK);
398 code[1] = SCM_OPCODE(SCM_OP_PUSHN);
399 code[2] = SCM_MKINUM(argc + 1);
400
401 code[argc + 3] = func;
402 code[argc + 4] = SCM_OPCODE(SCM_OP_CALL);
403 code[argc + 5] = SCM_OPCODE(SCM_OP_END);
404
405 list = NULL; tmp = &list;
406 while(argv[0]) {
407 i = argc - 1;
408 j = 3;
409 while(i >= 0) {
410 if (argv[i] == NULL) SCM_ERR("list too short", argv[i]);
411 code[j] = SCM_CAR(argv[i]);
412 argv[i] = SCM_CDR(argv[i]);
413 i--;
414 j++;
415 }
416 res = scm_run_engine(code);
417 if (map) { *tmp = scm_cons(res, NULL); tmp = &SCM_CDR(*tmp); }
418 }
419 return((map) ? list : scm_undefined);
420 }
421
422 /*S* (map PROC LIST1 LIST2 ...) => LIST */
423 /*D* The lists must be lists, and proc must be a procedure taking as
424 many arguments as there are lists and returning a single value. If
425 more than one list is given, then they must all be the same
426 length. Map applies PROC element-wise to the elements of the lists
427 and returns a list of the results, in order. */
428 /*X* (map cadr '((a b) (d e) (g h))) => (b e h) */
429
scm_map(int argc,SOBJ * argv)430 SOBJ scm_map(int argc, SOBJ *argv)
431 {
432 SOBJ func;
433 if (argc < 2) return(NULL);
434 func = argv[0];
435 scm_sp = argv;
436 /* need to save scm_sp, because scm_map2 restarts a new vm */
437 return(scm_map2(func, argc-1, argv+1, TRUE));
438 }
439
440 /*S* (for-each proc list1 list2 ...) => #undefined */
441 /*D* The arguments to for-each are like the arguments to map, but
442 for-each calls proc for its side effects rather than for its values.
443 Unlike map, for-each is guaranteed to call proc on the elements of
444 the lists in order from the first element(s) to the last, and the
445 value returned by for-each is unspecified. */
446
scm_foreach(int argc,SOBJ * argv)447 SOBJ scm_foreach(int argc, SOBJ *argv)
448 {
449 SOBJ func;
450 if (argc < 2) return(NULL);
451 func = argv[0];
452 scm_sp = argv;
453 return(scm_map2(func, argc-1, argv+1, FALSE));
454 }
455
456 /*E* (nth K LIST) => OBJ */
457 /*D* Returns the Kth element of the LIST. */
scm_nth(SOBJ n,SOBJ l)458 SOBJ scm_nth(SOBJ n, SOBJ l)
459 {
460 int i, limit;
461 if (!SCM_INUMP(n)) SCM_ERR("bad index", n);
462 limit = SCM_INUM(n);
463 for (i = 0; (i < limit) && SCM_PAIRP(l); i++) {
464 l = SCM_CDR(l);
465 }
466 if (!SCM_PAIRP(l)) SCM_ERR("bad list or index out of range", scm_cons(n,l));
467 return(SCM_CAR(l));
468 }
469
470 /*E* (list-remove! LIST OBJ) => LIST */
471 /*D* Remove the pair containing OBJ from LIST. The original LIST is
472 modified by this function. eqv? is used to locate the OBJ */
473 /*X* (list-remove! '(a b c d) 'c) => (a b d) */
scm_list_remove(SOBJ list,SOBJ n)474 SOBJ scm_list_remove(SOBJ list, SOBJ n)
475 {
476 SOBJ l, last;
477
478 for (last = NULL, l = list; SCM_PAIRP(l); last = l, l = SCM_CDR(l)) {
479 if (scm_eqv(SCM_CAR(l), n) != scm_false) {
480 if (last) {
481 SCM_CDR(last) = SCM_CDR(l);
482 } else { /* first node */
483 list = SCM_CDR(list);
484 }
485 SCM_CDR(l) = NULL;
486 break;
487 }
488 }
489 return(list);
490 }
491
492 /*E* (list-replace! LIST OBJ NEW) => LIST */
493 /*D* Replace OBJ in LIST with the NEW object. The original LIST is
494 modified by this function. eqv? is used to locate the OBJ */
495 /*X* (list-replace! '(a b c d) 'c 'k) => (a b k d) */
scm_list_replace(SOBJ list,SOBJ item,SOBJ new)496 SOBJ scm_list_replace(SOBJ list, SOBJ item, SOBJ new)
497 {
498 SOBJ l;
499
500 for (l = list; SCM_PAIRP(l); l = SCM_CDR(l)) {
501 if (scm_eqv(SCM_CAR(l), item) != scm_false) {
502 SCM_CAR(l) = new;
503 break;
504 }
505 }
506 return(list);
507 }
508
509
510
511
scm_init_list()512 void scm_init_list()
513 {
514 scm_add_cprim("pair?" , scm_pairp , 1);
515 scm_add_cprim("cons" , scm_cons , 2);
516 scm_add_cprim("cons2" , scm_cons2 , 3);
517 scm_add_cprim("car" , scm_car , 1);
518 scm_add_cprim("cdr" , scm_cdr , 1);
519 scm_add_cprim("set-car!" , scm_setcar , 2);
520 scm_add_cprim("set-cdr!" , scm_setcdr , 2);
521 scm_add_cprim("caar" , scm_caar , 1);
522 scm_add_cprim("cdar" , scm_cdar , 1);
523 scm_add_cprim("cadr" , scm_cadr , 1);
524 scm_add_cprim("cddr" , scm_cddr , 1);
525 scm_add_cprim("caaar" , scm_caaar , 1);
526 scm_add_cprim("cdaar" , scm_cdaar , 1);
527 scm_add_cprim("cadar" , scm_cadar , 1);
528 scm_add_cprim("cddar" , scm_cddar , 1);
529 scm_add_cprim("caadr" , scm_caadr , 1);
530 scm_add_cprim("cdadr" , scm_cdadr , 1);
531 scm_add_cprim("caddr" , scm_caddr , 1);
532 scm_add_cprim("cdddr" , scm_cdddr , 1);
533 scm_add_cprim("caaaar" , scm_caaaar , 1);
534 scm_add_cprim("cdaaar" , scm_cdaaar , 1);
535 scm_add_cprim("cadaar" , scm_cadaar , 1);
536 scm_add_cprim("cddaar" , scm_cddaar , 1);
537 scm_add_cprim("caadar" , scm_caadar , 1);
538 scm_add_cprim("cdadar" , scm_cdadar , 1);
539 scm_add_cprim("caddar" , scm_caddar , 1);
540 scm_add_cprim("cdddar" , scm_cdddar , 1);
541 scm_add_cprim("caaadr" , scm_caaadr , 1);
542 scm_add_cprim("cdaadr" , scm_cdaadr , 1);
543 scm_add_cprim("cadadr" , scm_cadadr , 1);
544 scm_add_cprim("cddadr" , scm_cddadr , 1);
545 scm_add_cprim("caaddr" , scm_caaddr , 1);
546 scm_add_cprim("cdaddr" , scm_cdaddr , 1);
547 scm_add_cprim("cadddr" , scm_cadddr , 1);
548 scm_add_cprim("cddddr" , scm_cddddr , 1);
549 scm_add_cprim("null?" , scm_nullp , 1);
550 scm_add_cprim("list?" , scm_listp , 1);
551 scm_add_cprim("list*" , scm_list , -1);
552 scm_add_cprim("length" , scm_length , 1);
553 scm_add_cprim("append" , scm_append , -1);
554 scm_add_cprim("append2" , scm_append2 , 2);
555 scm_add_cprim("reverse" , scm_reverse , 1);
556 scm_add_cprim("list-tail" , scm_list_tail , 2);
557 scm_add_cprim("list-ref" , scm_list_ref , 2);
558 scm_add_cprim("memq" , scm_memq , 2);
559 scm_add_cprim("memv" , scm_memv , 2);
560 scm_add_cprim("member" , scm_member , 2);
561 scm_add_cprim("assq" , scm_assq , 2);
562 scm_add_cprim("assv" , scm_assv , 2);
563 scm_add_cprim("assoc" , scm_assoc , 2);
564 scm_add_cprim("map" , scm_map , -1);
565 scm_add_cprim("for-each" , scm_foreach , -1);
566 scm_add_cprim("nth" , scm_nth , 2);
567 scm_add_cprim("list-remove!" , scm_list_remove , 2);
568 scm_add_cprim("list-replace!" , scm_list_replace , 3);
569 }
570