SICP 読み (149) 4.1.2 式の表現

夏だとゆーのに外に出て遊ぶ気持ちになれん。天気も悪いんですが。家でごろごろしてても仕方が無いので問題を検討。

問題 4.9

R5RS に出ている例から。do という特殊形式があるらしい。

(do ((vec (make-vector 5))
     (i 0 (+ i 1)))
    ((= i 5) vec)
  (vector-set! vec i i))

ええと、名前 let でやってみよう。名前がカブる云々の問題はスルー。

(let f ((vec (make-vector 5)) (i 0))
  (cond ((= i 5) vec)
	(else
	 (vector-set! vec i i)
	 (f vec (+ i 1)))))

なんかこうして比べてみると導出は楽そげに見えるんですがアマいんだろうな。

(define (do->let exp)
  (define (make-init l)
    (let f ((result '()) (l l))
      (cond ((null? l) result)
	    (else
	     (f (cons (list (car (car l)) (cadr (car l))) result) (cdr l))))
      )
    )

  (define (make-step l)
    (let f ((result '()) (l l))
      (cond ((null? l) result)
	    (else
	     (if (null? (cddr (car l)))
		 (f result (cdr l))
		 (f (cons (caddr (car l)) result) (cdr l)))))
      )
    )

  (let ((init (make-init (cadr exp))) (step (make-step (cadr exp))))
    (list 'let 'f
	  init
	  (list 'cond (caddr exp)
		(cons 'else
		      (append (cdddr exp) step))))))

長い。else ナシ、という不具合があるも、ほぼ一発か。以下は出力されたソレを整形。

(let f ((i 0) (vec (make-vector 5))) 
  (cond ((= i 5) vec) 
	(else 
	 (vector-set! vec i i) 
	 (+ i 1))))

あ、駄目ぢゃん。(爆
make-step も微妙。

(define (do->let exp)
  (define (make-init l)
    (let f ((result '()) (l l))
      (cond ((null? l) result)
	    (else
	     (f (cons (list (car (car l)) (cadr (car l))) result) (cdr l))))
      )
    )

  (define (make-step l)
    (let f ((result '()) (l l))
      (cond ((null? l) result)
	    (else
	     (if (null? (cddr (car l)))
		 (f (cons (car (car l)) result) (cdr l))
		 (f (cons (caddr (car l)) result) (cdr l)))))
      )
    )

  (let ((init (make-init (cadr exp))) (step (make-step (cadr exp))))
    (list 'let 'f
	  init
	  (list 'cond (caddr exp)
		(cons 'else
		      (cons (cdddr exp) (list (append (list 'f) step))))))))

出力が以下。

(let f ((i 0) (vec (make-vector 5))) 
  (cond ((= i 5) vec) 
	(else 
	 ((vector-set! vec i i)) 
	 (f (+ i 1) vec))))

うーん。滅茶苦茶。

(define (do->let exp)
  (define (make-init l)
    (let f ((result '()) (l l))
      (cond ((null? l) result)
	    (else
	     (f (cons (list (car (car l)) (cadr (car l))) result) (cdr l))))
      )
    )

  (define (make-step l)
    (let f ((result '()) (l l))
      (cond ((null? l) result)
	    (else
	     (if (null? (cddr (car l)))
		 (f (cons (car (car l)) result) (cdr l))
		 (f (cons (caddr (car l)) result) (cdr l)))))
      )
    )

  (let ((init (make-init (cadr exp))) (step (make-step (cadr exp))))
    (list 'let 'f
	  init
	  (list 'cond (caddr exp)
		(cons 'else
		      (append (cdddr exp) (list (append (list 'f) step))))))))

どうか。ってか長いなぁ。

(let f ((i 0) (vec (make-vector 5))) 
  (cond ((= i 5) vec) 
	(else 
	 (vector-set! vec i i) 
	 (f (+ i 1) vec))))

順番が変わってるのが微妙。

試験

とりあえず R5RS の二つの式で試してみる。

  ("do->let"
   ("first"
    (let ((l '(do ((vec (make-vector 5))
		   (i 0 (+ i 1)))
		  ((= i 0) vec)
		(vector-set! i i)))
	  (result '(let f ((i 0)
			   (vec (make-vector 5)))
		     (cond ((= i 0) vec)
			   (else
			    (vector-set! i i)
			    (f (+ i 1) vec))))))
      (assert-equal result (do->let l))
      )
    )

   ("2nd"
    (let ((l '(do ((x x (cdr x))
		   (sum 0 (+ sum (car x))))
		  ((null? x) sum)))
	  (result '(let f ((sum 0) (x x))
		     (cond ((null? x) sum)
			   (else
			    (f (+ sum (car x)) (cdr x)))))))
      (assert-equal result (do->let l))
      )
    )
   )

一応パス。手続きはリファクタリングな余地がたくさんありそげ。てーか、f という手続きの名前にしてるあたりが一番微妙なんですが。

改善検討

make-step は

  (define (make-step l)
    (let f ((result '()) (l l))
      (cond ((null? l) result)
	    (else
	     (let ((s (if (null? (cddr (car l)))
			  (car (car l))
			  (caddr (car l)))))
	       (f (cons s result) (cdr l)))))))

の方が scheme 的な見た目で良さげかも。(何
手続き本体もツッコミどころ満載な気がするので、もう少しニラんでみます。

追記

そりゃええが、問題の主旨と全然違うコトしてるな。

反復構造を設計し、その使用例を示し、それを導出された式としてそう実装するか示せ。

という事でした。
でも上記が書けてれば普通の繰返しは大体書けそう。って、いきなり R5RS なソレを引いてしまったのが敗因っぽい。違う意味で易きに流れた感じです。スミマセン。