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