AtlatestRepositorysigil-r7rs

sigil-r7rs / tree / src / schemecxr.sgl

1;;; (scheme cxr) - R7RS CXR Library
2;;;
3;;; Extended car/cdr accessor procedures for nested pair structures.
4;;; Provides all compositions of `car` and `cdr` from three to four levels deep
5;;; (e.g., `caaddr`, `cddddr`).
6;;;
7;;; For basic two-level accessors (`caar`, `cadr`, `cdar`, `cddr`), use
8;;; `(scheme base)` or the prelude.
9;;;
10;;; See: [R7RS Small](https://small.r7rs.org/) §6.4
12(define-library (scheme cxr)
13 (export
14 ;; Three-level accessors
15 caaar caadr cadar caddr
16 cdaar cdadr cddar cdddr
17 ;; Four-level accessors
18 caaaar caaadr caadar caaddr
19 cadaar cadadr caddar cadddr
20 cdaaar cdaadr cdadar cdaddr
21 cddaar cddadr cdddar cddddr)
23 (begin
25 ;; ============================================================
26 ;; Three-level accessors
27 ;; ============================================================
29 (define (caaar x) (car (car (car x))))
30 (define (caadr x) (car (car (cdr x))))
31 (define (cadar x) (car (cdr (car x))))
32 (define (caddr x) (car (cdr (cdr x))))
33 (define (cdaar x) (cdr (car (car x))))
34 (define (cdadr x) (cdr (car (cdr x))))
35 (define (cddar x) (cdr (cdr (car x))))
36 (define (cdddr x) (cdr (cdr (cdr x))))
38 ;; ============================================================
39 ;; Four-level accessors
40 ;; ============================================================
42 (define (caaaar x) (car (car (car (car x)))))
43 (define (caaadr x) (car (car (car (cdr x)))))
44 (define (caadar x) (car (car (cdr (car x)))))
45 (define (caaddr x) (car (car (cdr (cdr x)))))
46 (define (cadaar x) (car (cdr (car (car x)))))
47 (define (cadadr x) (car (cdr (car (cdr x)))))
48 (define (caddar x) (car (cdr (cdr (car x)))))
49 (define (cadddr x) (car (cdr (cdr (cdr x)))))
50 (define (cdaaar x) (cdr (car (car (car x)))))
51 (define (cdaadr x) (cdr (car (car (cdr x)))))
52 (define (cdadar x) (cdr (car (cdr (car x)))))
53 (define (cdaddr x) (cdr (car (cdr (cdr x)))))
54 (define (cddaar x) (cdr (cdr (car (car x)))))
55 (define (cddadr x) (cdr (cdr (car (cdr x)))))
56 (define (cdddar x) (cdr (cdr (cdr (car x)))))
57 (define (cddddr x) (cdr (cdr (cdr (cdr x)))))))