sicp-ex-4.5

  
  
 (define (extended-cond-syntax? clause) (eq? (cadr clause) '=>)) 
 (define (extended-cond-test clause) (car clause)) 
 (define (extended-cond-recipient clause) (caddr clause)) 
 (define (cond->if expr) 
         (expand-clauses (cond-clauses expr))) 
 ;; convert cond expression to if expression 
 (define (expand-clauses clauses) 
         (if (null? clauses) 
                 #f 
                 (let ((first (car clauses)) 
                           (rest (cdr clauses))) 
                         (cond ((cond-else-clause? first) 
                                    (if (null? rest) 
                                            (sequence->exp (cond-actions first)) 
                                            (error "ELSE clause isn't last -- COND->IF" clauses))) 
                                   ((extended-cond-syntax? first) 
                                    (make-if (extended-cond-test first) 
                                                         (list (extended-cond-recipient first) 
                                                                   (extended-cond-test first)) 
                                                         (expand-clauses rest))) 
                                 (else  
                                         (make-if (cond-predicate first) 
                                                      (sequence->exp (cond-actions first)) 
                                                      (expand-clauses rest))))))) 

  
  
  
 (define (expand-clauses clauses) 
   (if (null? clauses) 
       'false                          ; no else clause 
       (let ((first (car clauses)) 
             (rest (cdr clauses))) 
         (if (cond-else-clause? first) 
             (if (null? rest) 
                 (sequence->exp (cond-actions first)) 
                 (error "ELSE clause isn't last -- COND->IF" 
                        clauses)) 
             (let ((test (cond-predicate first)) 
                   (recepient (if (eq? (car (cond-actions first)) '=>) 
                                  (cadr (cond-actions first)) 
                                  false))) 
               (make-if test 
                        (if recepient 
                            (list recepient test) ;test-recepient cond 
                            (sequence->exp (cond-actions first))) ;normal cond 
                        (expand-clauses rest)))))))