SICP演習問題5.42

(define (found? var)
  (if (not (eq? var 'not-found)) var false))

(define (compile-variable exp target linkage compile-time-env)
  (let ((found (found? (find-variable exp compile-time-env))))
    (end-with-linkage
     linkage
     (make-instruction-sequence
      '(env)
      (list target)
      (if found
          `((assign ,target
                    (op lexical-address-lookup)
                    (const ,found)
                    (reg env)))
          `((assign ,target
                    (op lookup-variable-value)
                    (const ,exp)
                    (reg env))))))))
(define (compile-assignment exp target linkage compile-time-env)
  (let ((var (assignment-variable exp))
        (get-value-code
         (compile (assignment-value exp) 'val 'next compile-time-env)))
      (let ((found (found? (find-variable var compile-time-env))))
        (end-with-linkage
         linkage
         (preserving
          '(env)
          get-value-code
          (make-instruction-sequence
           '(env val)
           (list target)
           (if found
               `((perform (op lexical-address-set!)
                          (const ,found)
                          (reg val)
                          (reg env))
                 (assign ,target (const ok)))
               `((perform (op set-variable-value!)
                          (const ,var)
                          (reg val)
                          (reg env))
                 (assign ,target (const ok)))))))
        )))

実行

(print-after-compiler
 (compile
  '(lambda (x y)
     (lambda (a)
       (* x y a)
       (set! w y)
       (set! y a)))
  'val
  'next
  '()))

(env)
(val)
  (assign val (op make-compiled-procedure) (label entry18) (reg env))
  (goto (label after-lambda19))
entry18
  (assign env (op compiled-procedure-env) (reg proc))
  (assign env (op extend-environment) (const (x y)) (reg argl) (reg env))
  (assign val (op make-compiled-procedure) (label entry20) (reg env))
  (goto (reg continue))
entry20
  (assign env (op compiled-procedure-env) (reg proc))
  (assign env (op extend-environment) (const (a)) (reg argl) (reg env))
  (save continue)
  (save env)
  (assign proc (op lookup-variable-value) (const *) (reg env))
  (assign val (op lexical-address-lookup) (const (0 0)) (reg env))
  (assign argl (op list) (reg val))
  (assign val (op lexical-address-lookup) (const (1 1)) (reg env))
  (assign argl (op cons) (reg val) (reg argl))
  (assign val (op lexical-address-lookup) (const (1 0)) (reg env))
  (assign argl (op cons) (reg val) (reg argl))
  (test (op primitive-procedure?) (reg proc))
  (branch (label primitive-branch22))
compiled-branch23
  (assign continue (label after-call24))
  (assign val (op compiled-procedure-entry) (reg proc))
  (goto (reg val))
primitive-branch22
  (assign val (op apply-primitive-procedure) (reg proc) (reg argl))
after-call24
  (restore env)
  (restore continue)
  (assign val (op lexical-address-lookup) (const (1 1)) (reg env))
  (perform (op set-variable-value!) (const w) (reg val) (reg env))
  (assign val (const ok))
  (assign val (op lexical-address-lookup) (const (0 0)) (reg env))
  (perform (op lexical-address-set!) (const (1 1)) (reg val) (reg env))
  (assign val (const ok))
  (goto (reg continue))
after-lambda21
after-lambda19

ちゃんとwや*はlookup-variable-value, set-variable-value!が使われていて，x,yなどにはlexical~が使われいる．