問題4.9

;; doを作ってみる
(do binds (predicate value) body)
;; である。
;; binds部は
((var-name initialize-value update-expression) ... )
;; である。

(do ((var-name1 initialize-value1 update-expression1)
     (var-name2 initialize-value2 update-expression2))
    (predicate value)
  body)

;; ->

(let iter ((var-name1 initialize-value1)
           (var-name2 initialize-value2))
  (if predicate
      value
      (begin
        body
        (iter update-expression1 update-expression2))))

;; となるとよい。
(define (do->named-let exp)
  (let ((binds (cadr exp))
        (predicate (caaddr exp))
        (value (car (cdaddr exp)))
        (body (cdddr exp)))
    (let ((var-inits (map (lambda (bind) (list (car bind) (cadr bind))) binds))
          (updates (map caddr binds))
          (iter-name (gensym)))
      `(let ,iter-name ,var-inits
            (if ,predicate
                ,value
                (begin
                  ,@body
                  (,iter-name ,@updates)))))))

(define (eval-do exp env)
  (eval (do->named-let exp) env))

(put 'eval 'do eval-do)


(do->named-let
 '(do ((var-name1 initialize-value1 update-expression1)
       (var-name2 initialize-value2 update-expression2))
      (predicate value)
    body))

;; ->
;(let G2 ((var-name1 initialize-value1)
;         (var-name2 initialize-value2))
;  (if predicate
;      value
;      (begin
;        body
;        (G2 update-expression1 update-expression2))))

;; ok

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

;; -> do化すると、

(do ((a 1 (+ a b)) (b 0 a) (count 5 (- count 1)))
    ((= count 0) b))

;; -> named-let化すると

;(let G6 ((a 1)
;         (b 0)
;         (count 5))
;  (if (= count 0)
;      b
;      (begin
;        (G6 (+ a b) a (- count 1)))))

;; ok!