SICP 読み (161) 4.1.3 評価器のデータ構造

問題 4.12

昨晩の敗因は scan だの env-loop だのを流用しようという浅はかな考えだったのだろうか。環境を渡り歩く手続きをイチから考えた方が良いのかも。
と言いつつ既存をコピッた手続きを書いてしまい、再度ハマる。今後こそイチから考える。環境を探索して変数を見つければええだけじゃん、と。(ハマりまくってるヤツが何を言うか)
とりあえず、scan の流用できる部分は流用しよ。

(define (scan vars vals)
  (cond ((null? vars) #f)
	((eq? var (car vars)) vars)
	(else
	 (scan (cdr vars) (cdr vals)))))

フレーム毎に上記の手続きを使って変数を探せば良いか。いずれも以下のシーケンスを使って scan を呼ぶ形になるはず。

(let ((f (first-frame env)))
  (let ((result (scan (frame-variables f)
		      (frame-values f))))
    (if result
        ; vars に対する処理
        ; 探索失敗時の処理
	)))

例えば lookup だと result が #t の場合は (car result) してやれば良いし、#f の場合には
enclosing-environment を上記の処理に渡してやれば良い、と。

lookup で手続きを書いてみる。

(define (scan vars vals)
  (cond ((null? vars) #f)
	((eq? var (car vars)) vars)
	(else
	 (scan (cdr vars) (cdr vals)))))
(define (search f)
  (scan (frame-variables f)
	(frame-values f)))
(define (lookup-variable-value var env)
  (let lookup-variable-value-iter ((env env))
    (if (eq? env the-empty-environment)
	(error "Unbound variable" var)
	(let ((result (search (first-frame env))))
	  (if result
	      (car result)
	      (lookup-variable-value-iter (enclosing-environment env)))))))

微妙。一旦以下の形で lookup な試験にパス。

(define (search var f)
  (define (scan vars vals)
    (cond ((null? vars) #f)
	  ((eq? var (car vars)) vals)
	  (else
	   (scan (cdr vars) (cdr vals)))))
  (scan (frame-variables f)
	(frame-values f)))

(define (lookup-variable-value var env)
  (let lookup-variable-value-iter ((env env))
    (if (eq? env the-empty-environment)
	(error "Unbound variable" var)
	(let ((result (search var (first-frame env))))
	  (if result
	      (car result)
	      (lookup-variable-value-iter (enclosing-environment env)))))))

set と define も追加してみよう。

(define (set-variable-value! var val env)
  (let set-variable-value!-iter ((env env))
    (if (eq? env the-empty-environment)
	(error "Unbound variable" var)
	(let ((result (search var (first-frame env))))
	  (if result
	      (set-car! result val)
	      (set-variable-value!-iter (enclosing-environment env)))))))

(define (define-variable! var val env)
  (let ((f (first-frame env)))
    (let ((result (search var f)))
      (if result
	  (set-car! result val)
	  (add-binding-to-frame! var val f)))))

試験は以下。

#!/usr/bin/env gosh

(use test.unit)
(require "4.1.2")

(define-test-suite "4.1.2"

  ("4.12"
   ("define"
    (let ((e (extend-environment '(x) '(1) the-global-environment)))
      (define-variable! 'a 10 e)
      (define-variable! 'x 2 e)
      (assert-equal 10 (lookup-variable-value 'a e))
      (assert-equal 2 (lookup-variable-value 'x e))
      (let ((e2 (extend-environment '(y) '(2) e)))
	(define-variable! 'b 5 e2)
	(define-variable! 'y 3 e2)
	(define-variable! 'x 3 e2)
	(assert-equal 5 (lookup-variable-value 'b e2))
	(assert-equal 3 (lookup-variable-value 'y e2))
	(assert-equal 3 (lookup-variable-value 'x e2))
	(assert-equal 2 (lookup-variable-value 'x e))
	(assert-error (lambda () (lookup-variable-value 'b e)))
	(assert-error (lambda () (lookup-variable-value 'y e)))
	)
      )
    )

   ("set"
    (let ((e (extend-environment '(x) '(1) the-global-environment)))
      (set-variable-value! 'x 2 e)
      (assert-equal 2 (lookup-variable-value 'x e))
      (assert-error (lambda () (set-variable-value! 'y 2 e)))
      (let ((e2 (extend-environment '(y) '(2) e)))
	(set-variable-value! 'x 3 e2)
	(set-variable-value! 'y 4 e2)
	(assert-equal 3 (lookup-variable-value 'x e2))
	(assert-equal 4 (lookup-variable-value 'y e2))
	(assert-error (lambda () (set-variable-value! 'z 3 e2)))
	)
      )
    )

   ("lookup"
    (let ((e (extend-environment '(x) '(1) the-global-environment)))
      (assert-equal 1 (lookup-variable-value 'x e))
      (assert-error (lambda () (lookup-variable-value 'y e)))
      (let ((e2 (extend-environment '(y) '(2) e)))
	(assert-equal 1 (lookup-variable-value 'x e2))
	(assert-equal 2 (lookup-variable-value 'y e2))
	(assert-error (lambda () (lookup-variable-value 'z e2)))
	)
      )
    )
   )
  )

まだちょっと微妙。lookup と set はなんとかできんものか。search した結果を戻す手続きを作ってみるか。

(define (env-loop var env)
  (if (eq? env the-empty-environment)
      (error "Unbound variable" var)
      (search var (first-frame env))))

(define (lookup-variable-value var env)
  (let f ((env env))
    (let ((result (env-loop var env)))
      (if result
	  (car result)
	  (f (enclosing-environment env))))))

微妙 ...
くりかえしも一緒にしちまえば良いのか。名前も env-loop だし。

(define (env-loop var env)
  (let env-loop-iter ((env env))
    (if (eq? env the-empty-environment)
	(error "Unbound variable" var)
	(let ((result (search var (first-frame env))))
	  (if result
	      result
	      (env-loop-iter (enclosing-environment env)))))))

(define (lookup-variable-value var env)
  (car (env-loop var env)))

動いてるなぁ。もひとつ。

(define (set-variable-value! var val env)
  (set-car! (env-loop var env) val))

これも OK らしい。

教訓

横着してはいけない。これに尽きる。(とほほ