(wat-aro)

生きてます

SICP 問題 4.16

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

;; b
(define (scan-out-defines proc-body)
  ;; 選択子
  (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 proc-body)))
    (if (null? (def-list def-body-list))
        proc-body
        (list (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)))))))

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