2015/12/23

# 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))
``````