SICP問題4.5

cond節のもう一つの構文(=>)

• が真の値に評価されると、が評価される。
• その値は一引数の手続きでなければならない
• この手続きは次にの値に対して呼び出され、その結果がcond式の値として返る。

(例)

(cond ((assoc 'b '((a 1) (b 2))) => cadr)
      (else #f))

は2を返す。この拡張構文が使えるよう、condの処理を修正する

上記の例は、以下の構文のsyntax sugarだと考えられる

(cond ((assoc 'b '((a 1) (b 2))) (cadr (assoc 'b '((a 1) (b 2)))))
      (else #f))

ので、cond-actionsだけを修正すればOKかな?
元の cond関連の手続き

(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-actinos clause) (cdr clause))
(define (cond->if exp)
  (expand-clauses (cond-clauses exp)))
(define (expand-clauses clauses)
  (if (null? clauses)
      #f ; else節なし
      (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))
            (make-if (cond-predicate first)
                     (sequence->exp (cond-actions first))
                     (expand-clauses rest))))))

拡張構文を追加したcond(修正部分のみ)

;; 拡張構文か?
(define (extended-cond? clause)
  (if (cond-else-clause? clause)
      #f
      (eq? (cadr clause) '=>)))
;; 拡張構文のtest
(define (extended-cond-test clause)
  (car clause))
;; 拡張構文のrecipient
(define (extended-cond-recipient clause)
  (caddr clause))
;; cond-actions を修正
(define (cond-actions clause)
  (if (extended-cond? clause)
      (list (extended-cond-recipient clause)
            (extended-cond-test clause))
      (cdr clause)))