SICP 問題 4.16

;; a
 (define (lookup-variable-value var env)
  (let ((target (env-loop var env (lambda (var vars vals) (car vals)))))
    (cond ((eq? target '*unassigned*) (error "Unassigned variable" var))
          (target target)
          (else (error "Unbound variable" var)))))

;; b
(define (scan-out-defines proc)
  ;; 選択子
  (define (def-list def-body-list) (car def-body-list))
  (define (body-list def-body-list) (cdr def-body-list))
  ;; lambda式の本体を受け取って，内部でdefineを使ってる式と使ってない式のリストを返す
  (define (split-def-body proc-body-list)
    (let iter ((proc-body-list proc-body-list)
               (def '())
               (body '()))
      (cond ((null? proc-body-list) (cons (reverse def) (reverse body)))
            ((definition? (car proc-body-list))
             (iter (cdr proc-body-list) (cons (car proc-body-list) def) body))
            (else (iter (cdr proc-body-list) def (cons (car proc-body-list) body))))))
  ;; 本体
  (let ((def-body-list (split-def-body (lambda-body proc))))
    (if (null? (def-list def-body-list))
        proc
        (list 'lambda (lambda-parameters proc)
              (make-let (map (lambda (x) (list (definition-variable x) '*unassigned*))
                             (def-list def-body-list))
                        (append (map (lambda (x) (list 'set!
                                                       (definition-variable x)
                                                       (definition-value x)))
                                     (def-list def-body-list))
                                (body-list def-body-list)))))))

gosh> (scan-out-defines '(lambda (vars)
                           (define u e1)
                           (define v e2)
                           e3))
(lambda (vars) (let ((u *unassigned*) (v *unassigned*)) ((set! u e1) (set! v e2) e3)))

;; c
;; どちらに組み込んだでも同じが，procedure-bodyは二箇所で呼ばれているので一箇所でしか呼ばれていないmake-procedureに組み込んだ方が良い．
(define (make-procedure parameters body env)
  (list 'procedure parameters (scan-out-defines body) env))