SICP 読み (337) 5.5 翻訳系

問題 5.39

残りをヤッツケてみる事に。ええと

• *unassigned* ならエラー
• lexical-address-set! の実装

ですか。とりあえず試験を書こう。微妙に忘れてたりして9.22 gauche.test - 単体テストを見つつ。
で、でっち上げたのが以下

(use gauche.test)

(add-load-path ".")
(load "5.39.scm")

(test-start "5.39")

(test-section "lookup")
(let ((env (extend-environment 
	    '(y z) 
	    '(1 2)
	    (extend-environment
	     '(a b c d e)
	     '(3 4 5 6 7)
	     (extend-environment
	      '(x y)
	      '(8 9)
	      '())))))
  (test* "x is 8 (2 0)" 8 (lexical-address-lookup '(2 0) env))
  (test* "y is 1 (0 0)" 1 (lexical-address-lookup '(0 0) env))
  (test* "c is 5 (1 2)" 5 (lexical-address-lookup '(1 2) env)))

(test-section "set!")
(let ((env (extend-environment 
	    '(y z) 
	    '(1 2)
	    (extend-environment
	     '(a b c d e)
	     '(3 4 5 6 7)
	     (extend-environment
	      '(x y)
	      '(8 9)
	      '())))))
  (lexical-address-set! '(2 0) 10 env)
  (test* "x is 10 (2 0)" 10 (lexical-address-lookup '(2 0) env))
  (lexical-address-set! '(0 0) 20 env)
  (test* "x is 20 (0 0)" 20 (lexical-address-lookup '(0 0) env))
  (lexical-address-set! '(1 2) 30 env)
  (test* "x is 30 (1 2)" 30 (lexical-address-lookup '(1 2) env)))

(test-section "*unassigned*")
(let ((env (extend-environment '(x y) '(*unassigned 0) '())))
  (test* "(0 0) is *unassigned*" *test-error* (lambda ()
						(lexical-address-lookup
						 '(0 0) env)))
  (test* "(0 1) is 0" 0 (lexical-address-lookup '(0 1) env)))

(test-end)

うーむ。とりあえず以下の手続きを書いて

(load "load-eceval-compiler")
(load "ch5-compiler")
(define true #t)
(define false #f)

(define (lexical-address-lookup add env)
  (let ((result (list-ref (cdr (list-ref env (car add))) (cadr add))))
    (if (eq? '*unassigned* result)
	(error "variable is unassigned -- " result)
	result)))

(define (lexical-address-set! add val env)
  (define (scan n l)
    (if (= n 0)
	(set-car! l val)
	(scan (- n 1) (cdr l))))
  (scan (cadr add) (cdr (list-ref env (car add)))))

試験してみたんですがパスしない。

$ make
Testing 5.39 ...                                                 failed.
discrepancies found.  Errors are:
test (0 0) is *unassigned*: expects #<error> => got #<closure (#f #f)>
$

何故だ、と言いつつリファレンス見てみたら

• 試験な手続きが手動な thunk だったら test
• test* は試験する手続きを thunk にしてくれる

という記述あり。*unassigned* な試験は正しくは以下な模様。

(test-section "*unassigned*")
(let ((env (extend-environment '(x y) (list '*unassigned* 0) '())))
  (test* "(0 0) is *unassigned*" *test-error* (lexical-address-lookup
					       '(0 0) env))
  (test* "(0 1) is 0" 0 (lexical-address-lookup '(0 1) env)))

この後天性記憶不全の進行具合はレベル的にどうなのでしょうか。(誰

追記

ちなみに上記の試験はバグ入り。修正したのを書くの忘れてました。不具合があった試験は

(let ((env (extend-environment '(x y) '(*unassigned 0) '())))

ってなってました。「*unassigned」です。これも直上の試験に修正する時に盛り込んでおります。