SICP 読み (142) 4.1.2 式の表現

久々の酷い頭痛。某ネットワーク機器メーカさんは保守契約しないと設置サポートしねぇ、っていいやがるし今日はどうにも日が悪い。(何
で、現実トウヒ分も含め、ぼさっと検討を始めたんですがなかなかに興味深いのが問題 4.5 ッス。

訂正

なんかもの凄い大ボケをカマシてる事が判明。以下、修正済みです。

問題 4.5

p.221 にて例示されている cond 関連の一連の手続きが以下。

(define (last-exp? seq) (null? (cdr seq)))
(define (first-exp seq) (car seq))

(define (sequence->exp seq)
  (cond ((null? seq) seq)
	((last-exp? seq) (first-exp seq))
	(else (make-begin seq))))
(define (make-begin seq) (cons 'begin seq))

(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-actions clause) (cdr clause))

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

(define (expand-clauses clauses)
  (if (null? clauses)
      'false
      (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))))))

手を入れる必要があるのは expand-clauses のはず。else な処理は手を入れなくても良いかな。
# ケツの else って何だろ。（訂正済み）自分で書いてて意味不明。
てーか、以下がどんな形に変換されないとイケないのか。

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

例示されている上記の例はどうなれば良いのか。とりあえず let が使えれば良いのですが

(let ((x (assoc 'b '((a 1) (b 2)))))
  (if x
      (cadr x)
      false))

みたいな感じで。でも cond を if に書き換える、という方式だと let 使って置き換えようとすると、let の中で定義する変数名をどうすりゃ良いのか、という話になる。
でも、以下なソレだと

(if (assoc 'b '((a 1) (b 2)))
    (cadr (assoc 'b '((a 1) (b 2))))
    false)

ちょっと頭悪いなぁ、というか predicate なソレが重い手続きだと駄目じゃね? と。
で、何かわしの知らんヒミツの手続きというか特殊形式があるのか、と R5RS 見てみると 7.3 節に define-syntax 使った cond の定義の例が出ていて、当たり前なんですが let が使ってある。
うーん。define-syntax を含め、scheme の実装ってどうなってるんだろう。気になる。

解

とりあえず、let を使わない方式なソレが以下です。

(define (expand-clauses clauses)
  (if (null? clauses)
      'false
      (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)
		     (if (equal? '=> (cadr first))
			 (list (caddr first) (cond-predicate first))
			 (sequence->exp (cond-actions first)))
		     (expand-clauses rest))))))

うーん。これって試験できるんだったっけ? あ、あるある。まず上記の修正を盛り込んで既存の試験にはパス。既存なソレに試験を追加したナニを以下に。

   ("expand-clauses"
    (assert-equal 'false (expand-clauses '()))
    (assert-error (lambda () (expand-clauses '((else (x)) ((= x 1) (y))))))
    (let ((l '(cond ((last-exp? exps) (eval (first-exp exps) env))
		    (else (eval (first-exp exps) env)
			  (eval-sequence (rest-exps exps) env)))))
      (let ((if-S '(if (last-exp? exps)
		       (eval (first-exp exps) env)
		       (begin (eval (first-exp exps) env)
			      (eval-sequence (rest-exps exps) env)))))
	(assert-equal if-S (expand-clauses (cond-clauses l)))))
    (let ((l '(cond ((null? seq) seq)
		    ((last-exp? seq) (first-exp seq))
		    (else (make-begin seq)))))
      (let ((if-S '(if (null? seq)
		       seq
		       (if (last-exp? seq)
			   (first-exp seq)
			   (make-begin seq)))))
	(assert-equal if-S (expand-clauses (cond-clauses l)))))
    (let ((l '(cond ((assoc 'b '((a 1) (b 2))) => cadr)
		    (else false))))
      (let ((if-S '(if (assoc 'b '((a 1) (b 2)))
		       (cadr (assoc 'b '((a 1) (b 2))))
		       false)))
	(assert-equal if-S (expand-clauses (cond-clauses l)))))
    )

一応試験にはパスしてます。引き続き、もすこしスマートな解を検討してみます。

追記

投入したエントリが無茶苦茶だった。恥ずかしひ。