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 らしい。
教訓
横着してはいけない。これに尽きる。(とほほ