1
2(define vector
3  (lambda args
4    (list->vector args)))
5
6
7(define list-n
8  (lambda (n)
9    (if (zero? n) '()
10	(cons n (list-n (- n 1))))))
11
12(define list-ref
13  (lambda (l n)
14    (if (zero? n)
15	(car l)
16	(list-ref (cdr l) (- n 1)))))
17
18(define length
19  (lambda (l)
20    (if (or (null? l) (not (pair? l))) 0
21        (+ 1 (length (cdr l))))))
22
23(define filter
24  (lambda (l f)
25    (if (null? l) '()
26	(if (f (car l))
27	    (cons (car l) (filter (cdr l) f))
28	    (filter (cdr l) f)))))
29
30(define reverse
31  (letrec
32      ((rev
33	(lambda (l acc)
34	  (if (null? l) acc
35	      (rev (cdr l) (cons (car l) acc))))))
36    (lambda (l)
37      (rev l '()))))
38
39(define append
40  (lambda (l . ls)
41    (if (null? l)
42	(if (pair? ls)
43	    (if (pair? (cdr ls))
44		(apply append ls)
45		(car ls)) ls)
46	(cons (car l)
47	      (apply append (cons (cdr l) ls))))))
48
49(define eqv? eq?)
50(define equal?
51  (lambda (obj1 obj2)
52    (if (and (pair? obj1) (pair? obj2))
53	(and (equal? (car obj1) (car obj2))
54	     (equal? (cdr obj1) (cdr obj2)))
55	(if (or (pair? obj1) (pair? obj2)) #f
56	    (eqv? obj1 obj2)))))
57
58(define memgeneric
59  (lambda (obj l pred)
60    (if (null? l) '()
61	(if (pred obj (car l)) l
62	    (memgeneric obj (cdr l) pred)))))
63
64(define memq
65  (lambda (obj l) (memgeneric obj l eq?)))
66(define memv
67  (lambda (obj l) (memgeneric obj l eqv?)))
68(define member
69  (lambda (obj l) (memgeneric obj l equal?)))
70
71(define association
72  (lambda (obj l pred)
73    (if (null? l) #f
74	(if (and (pair? (car l))
75		 (pred obj (car (car l))))
76	    (car l)
77	    (association obj (cdr l) pred)))))
78
79(define assq
80  (lambda (obj l) (association obj l eq?)))
81(define assv
82  (lambda (obj l) (association obj l eqv?)))
83(define assoc
84  (lambda (obj l) (association obj l equal?)))
85
86
87(define map-over-single-list
88  (lambda (p l)
89    (if (null? l) '()
90	(cons (p (car l))
91	      (map-over-single-list p (cdr l))))))
92
93(define map
94  (lambda (proc . lists)
95    (if (memq '() lists) '()
96	(cons
97	 (apply proc
98		(map-over-single-list car lists))
99	 (apply map
100		(cons proc (map-over-single-list cdr lists)))))))
101
102(define for-each
103  (lambda (proc . lists)
104    (if (memq '() lists) '()
105	(begin
106	 (apply proc
107		(map-over-single-list car lists))
108	 (apply for-each
109		(cons proc (map-over-single-list cdr lists)))))))
110
111(define pow (lambda (x y) (exp (* y (log x)))))
112
113