]> git.rkrishnan.org Git - sicp.git/blob - src/sicp/ex4_5.rkt
rewrite `quote->cons' using `match'.
[sicp.git] / src / sicp / ex4_5.rkt
1 #lang racket
2
3 (define (cond? exp) (tagged-list? exp 'cond))
4 (define (cond-clauses exp) (cdr exp))
5 (define (cond-else-clause? clause)
6   (eq? (cond-predicate clause) 'else))
7 (define (cond-predicate clause) (car clause))
8
9 (define (cond-arrow-clause? clause) (eq? (cadr (cond-actions clause)) '=>))
10 (define (cond-arrow-clause-recipient clause) (caddr clause))
11 (define (cond-actions clause) 
12   (if (cond-arrow-clause? clause)
13       (apply (cond-arrow-clause-recipient clause) (cond-predicate clause))
14       (cdr clause)))
15
16 (define (cond->if exp)
17   (expand-clauses (cond-clauses exp)))
18
19 (define (expand-clauses clauses)
20   (if (null? clauses)
21       'false                          ; no else clause
22       (let ((first (car clauses))
23             (rest (cdr clauses)))
24         (if (cond-else-clause? first)
25             (if (null? rest)
26                 (sequence->exp (cond-actions first))
27                 (error "ELSE clause isn't last -- COND->IF"
28                        clauses))
29             (make-if (cond-predicate first)
30                      (sequence->exp (cond-actions first))
31                      (expand-clauses rest))))))