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))))))