Exercise 4.5

Read Exercise 4.5 ~ Solution ~ Test suite

---

Tests first (in future I won’t include tests unless there is anything especially interesting about them.)

(test-case  
 "cond special form : ( => )"
 (test-equal? "cond t=>r with true value"
              2
              (run-interpreter '(cond ((assoc 'b '((a 1) (b 2))) => cadr)
                                      (else false))))
 
 (test-equal? "cond t=>r without true value"
              'fail
              (run-interpreter '(cond ((assoc 'z '((a 1) (b 2))) => cadr)
                                      (else (quote fail)))))
 
 (test-equal? "cond t=>r returning string value"
              "something else"
              (run-interpreter '(cond ((assoc 'z '((a 1) (b 2))) => cadr) 
                                      ("valueless" => (lambda (v) (if (equal? v "values")
                                                                      "really values"
                                                                      "something else"))))))
 
 (test-equal? "cond t=>r returning string value"
              "really values"
              (run-interpreter '(cond ((assoc 'z '((a 1) (b 2))) => cadr) 
                                      ("values" => (lambda (v) (if (equal? v "values")
                                                                   "really values"
                                                                   "something else"))))))) 

The new cond evaluation

(define (cond? exp)                (tagged-list? exp 'cond))
(define (cond-clauses exp)         (cdr exp))
(define (cond-else-clause? clause) (eq? (cond-predicate clause) 'else))
(define (cond-predicate clause)    (car clause))
(define (cond-recipient clause) (caddr clause))
(define (cond-recipient-clause? clause) (eq? (cadr clause) '=>))


; this checks against the 2 forms for cond clauses
; 1) ((pred-clauses) (value-clauses)) -> result is (value-clauses)
; 2) ((pred-values) => proc)         -> result is (proc v)

(define (make-cond-recipient clause predicate)
  (list (cond-recipient clause) predicate))

(define (cond-consequent clause predicate)
  (if (cond-recipient-clause? clause)
      (make-cond-recipient clause predicate)
      (sequence->exp (cond-actions clause))))

(define (cond-actions clause)
  (cdr clause))

(define (cond->if exp)
  (expand-clauses (cond-clauses exp)))

(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 ((predicate (cond-predicate first)))
              (make-if predicate
                       (cond-consequent first predicate)
                       (expand-clauses rest)))))))