(sicp50)m4.9のdoの修正と4.10

4.10 好きな制御構造の作成

dotimesを作ってみた。（何か大げさな様な気もするけど）

;;使用例
 (let ((fact 1))
   (dotimes (e 10 fact) (set! fact (* fact (+ 1 e)))))
;; gosh> 3628800

named-letを使った再帰に置き換えて定義する。

(define (run-dotimes exp)
  (let ((definition (cadr exp))
        (body (caddr exp)))
    (let ((var (car definition))
          (last (cadr definition))
          (ret-value (if (null? (cddr definition))
                         '() ;defaultの戻り値
                         (caddr definition))))
      (make-let (list 'loop (list (list var 0))
                      (make-if (list '>= var last)
                               ret-value
                               (make-begin (list body
                                                (list 'loop (list '+ var 1))))))))))
  (print  (run-dotimes '(dotimes (n 3 'done) (print n))))
;; gosh> (let loop ((n 0)) (if (>= n 3) 'done (begin (print n) (loop (+ n 1)))))

evalに組み合わせる

(define (eval-dotimes exp env)
  (let ((first (car exp))
        (rest (cdr exp)))
    (eval-sequence (list (eval-dotimes first)
                         rest)
                   env)))

doを使ってdotimesを定義する方が自然かもしれない。

問題4.9の修正

doの定義も勘違いしていた。(bodyを受け取っていない。)

(define (run-do exp)
  (let ((binding (cadr exp))
        (predicate&value (caddr exp))
        (body (if (null? (cdddr exp)) '() (cadddr exp))))
    (let ((vars&exps (map (lambda (e) (list (car e) (cadr e))) binding))
          (set-f (map caddr binding)))
      (make-let (list 'loop vars&exps
                      (make-if (car predicate&value)
                               (cadr predicate&value)
                               (if body
                                   (make-begin (list body (cons 'loop set-f)))
                                   (cons 'loop set-f))))))))


(run-do '(do ((n 0 (+ n (car l))) (l l (cdr l))) ((null? l) n) (print n)))
;; gosh> (let loop ((n 0) (l l)) (if (null? l) n (begin (print n) (loop (+ n (car l)) (cdr l)))))

doを使ったdotimesの定義

(define (make-do binding predicate&ret-v body) 
  (list 'do binding predicate&ret-v body))

(define (run-dotimes2 exp)
  (let ((definition (cadr exp))
        (body (caddr exp)))
    (let ((var (car definition))
          (limit (cadr definition))
          (ret-value (if (null? (cddr definition))
                         '() ;defaultの戻り値
                         (caddr definition))))
      (make-do (list (list 'tlimit limit) (list var 0 (list '+ var 1)))
               (list (list '>=  var 'tlimit) ret-value)
               body))))

(run-dotimes2 '(dotimes (n 3 'done) (print n)))
;; gosh> (do ((tlimit 3) (n 0 (+ n 1))) ((>= n tlimit) 'done) (print n))

実行可能な式ができればいいのかな？
何か勘違いしているところがあるかもしれない。