(define +1 (x) (+ x 1)) (define length (l) (if (null? l) 0 (+1 (length (cdr l))))) (define caar (l) (car (car l))) (define cadr (l) (car (cdr l))) (define cddr (l) (cdr (cdr l))) (define caddr (l) (car (cdr (cdr l)))) (define cadar (l) (car (cdr (car l)))) (define cadddr (exp) (car (cdr (cdr (cdr exp))))) (define list1 (x) (cons x '())) (define list2 (x y) (cons x (cons y '()))) (define list3 (x y z) (cons x (cons y (cons z '())))) (define or (x y) (if x x y)) (define and (x y) (if x y x)) (define not (x) (if x f t)) ; association list as pair: list, notfound ; these functions work on the first element of the pair ; without disturbing the secont (define alist-cdr (alist) (pair (cdr (fst alist)) (snd alist))) (define alist-car (alist) (car (fst alist))) (define alist-cons (p alist) (pair (cons p (fst alist)) (snd alist))) (define empty-assoc (failure) (pair '() failure)) (define assoc (x alist) (if (null? (fst alist)) (snd alist) (if (= x (fst (alist-car alist))) (snd (alist-car alist)) (assoc x (alist-cdr alist))))) (define mkassoc (x y alist) (if (null? (fst alist)) (alist-cons (pair x y) (empty-assoc (snd alist))) (if (= x (fst (alist-car alist))) (alist-cons (pair x y) (alist-cdr alist)) (alist-cons (alist-car alist) (mkassoc x y (alist-cdr alist)))))) ; association list as pair: list, notfound ; these functions work on the first element of the pair ; without disturbing the secont (unique a-pair a-key a-val) (unique alist assocs failure) (define alist-cdr (an-alist) (alist (cdr (assocs an-alist)) (failure an-alist))) (define alist-car (an-alist) (car (assocs an-alist))) (define alist-cons (p an-alist) (alist (cons p (assocs an-alist)) (failure an-alist))) (define empty-assoc (failure) (alist '() failure)) (define assoc (x an-alist) (if (null? (assocs an-alist)) (failure an-alist) (if (= x (a-key (alist-car an-alist))) (a-val (alist-car an-alist)) (assoc x (alist-cdr an-alist))))) (define mkassoc (x y an-alist) (if (null? (assocs an-alist)) (alist-cons (a-pair x y) (empty-assoc (failure an-alist))) (if (= x (a-key (alist-car an-alist))) (alist-cons (a-pair x y) (alist-cdr an-alist)) (alist-cons (alist-car an-alist) (mkassoc x y (alist-cdr an-alist)))))) (val al (empty-assoc 'not-found!)) (val al (mkassoc 'I 'Ching al)) (val al (mkassoc 'E 'coli al)) (val al (mkassoc 'I 'Magnin al)) (define o (f g) (lambda (x) (f (g x)))) (val curry (lambda (f) (lambda (x) (lambda (y) (f x y))))) (val uncurry (lambda (f) (lambda (x y) ((f x) y))))