計算機プログラムの構造と解釈　第二版 P222 問題4.8

sicp

これもおおよそ一緒のタイプの問題。書き換えでできる。

やることはちょっと変わる。

  • let->combinationに振り分け機能
  • named-let-clauses手続き
  • named-let-bindings手続き(ここまでparameterってしてたよ。)
  • named-let-body手続き
  • expand-named-let-clauses手続き

まず、書き換えを行ってみる。
こいつが、、、

(define (fib n)
  (let fib-iter ((a 1)
                 (b 0)
                 (count n)) 
    (if (= count 0)
      b   
      (fib-iter (+ a b) a (- count 1)))))

こうなる、、、

(define (fib n)
  (define (fib-iter a b count)
    (if (= count 0)
      b   
      (fib-iter (+ a b) a (- count 1))))
  (fib-iter 1 0 n))

defineで書き換えた方がなんか慣れたかんじだな。
あとは、書き換え。定義と実行の2工程に別れているので、make-beginを使う。
make-defineってないから、自分でdefineのリストを作る。


実装

#!/usr/local/bin/gosh
;; -*- coding: utf-8 -*-


;;フィボナッチってなんだっけ？
(define (fib n)
  (if (= n 0) 0
    (if (= n 1) 1
    (+ (fib (- n 2)) (fib (- n 1))))))


;;4.8に載っている
(define (fib n)
  (let fib-iter ((a 1)
                 (b 0)
                 (count n))
    (if (= count 0)
      b
      (fib-iter (+ a b) a (- count 1)))))


;;iterをつかう
(define (fib n)
  (define (fib-iter a b count)
    (if (= count 0)
      b
      (fib-iter (+ a b) a (- count 1))))
  (fib-iter 1 0 n))


;;;実装
(load "./modules/4th.scm")
(load "./modules/let.scm")

(define (let->combination exp)
  (if (pair? (car (let-clauses exp)))
      (expand-let-clauses (let-clauses exp))
      (expand-named-let-clauses (let-clauses exp))))

(define (named-let-var clauses) (car clauses))

(define (named-let-bindings clauses) (cadr clauses))

(define (named-let-body clauses) (caddr clauses))

(define (expand-named-let-clauses clauses)
  (make-begin
    (list
      (list 'define (cons (named-let-var clauses)
                          (map car (named-let-bindings clauses)))
            (named-let-body clauses))
      (cons (named-let-var clauses)
            (map cadr (named-let-bindings clauses))))))

(define the-global-environment (setup-environment))
(driver-loop)


実行

;;; M-Eval input:
(define (fib n)
  (let fib-iter ((a 1)
                 (b 0)
                 (count n)) 
    (if (= count 0)
      b   
      (fib-iter (+ a b) a (- count 1)))))

;;; M-Eval value:
ok

;;; M-Eval input:
(fib 10)

;;; M-Eval value:
55