EoPL reading (107) 2.3 Representation Strategies for Data Types

再び合間を縫って検討。
has-association? という述語を追加との事ですが、現状の実装ではエラーを捕捉できないと微妙。Gauche にそうした実装がありそげではありますが問題の主旨とは異なるのではないか、と言いつつテキストをニラむ。
結局は constructor が戻す手続きオブジェクトの i/f を変えないとダメ、ってか最近ヤッた stack の実装なアイデアしか出てこない。
とりあえず環境な手続きオブジェクトを以下にナニして

(define empty-env
  (lambda ()
    (lambda (cmd sym)
      (if (eqv? cmd 'pred)
	  #f
	  (eopl:error 'apply-env "No binding for ~s" sym)))))

(define extend-env
  (lambda (syms vals env)
    (lambda (cmd sym)
      (let ((pos (list-find-position sym syms)))
	(if (number? pos)
	    (list-ref vals pos)
	    (apply-env env sym))))))

(define apply-env
  (lambda (env sym)
    (env 'apply sym)))

既存の試験を実行してみました。一応試験パス。次は has-association? の追加ですな。

(define has-association?
  (lambda (env sym)
    (env 'pred sym)))

を追加して以下な試験を追加。

(use gauche.test)

(add-load-path ".")
(load "Fig2.3")

(test-start "has-association")
(test-section "has-association")
(test* "(has-association? (empty-env) 'a) returns #f"
       #f
       (has-association? (empty-env) 'a))
(test* "(has-association? ((a b) (1 2)) 'c) returns #f"
       #f
       (has-association? (extend-env '(a b) '(1 2) (empty-env)) 'c))

(test-end)

試験にパスせず。原因としては has-association? から env 手続き呼び出してるんですが、

    (env 'pred sym)))

extend-env が戻す手続きが

    (lambda (cmd sym)
      (let ((pos (list-find-position sym syms)))
	(if (number? pos)
	    (list-ref vals pos)
	    (apply-env env sym))))

になってるので最終的にエラーになってしまうため。これを以下に修正したら試験パス。

    (lambda (cmd sym)
      (let ((pos (list-find-position sym syms)))
	(if (number? pos)
	    (list-ref vals pos)
	    (if (eqv? cmd 'pred)
		(has-association? env sym)
		(apply-env env sym)))))))

若干無理矢理気味。がしかし、以下の試験を追加してみたんですが、

(test* "(has-association? ((a b) (1 2)) 'a) returns #t"
       #t
       (has-association? (extend-env '(a b) '(1 2) (empty-env)) 'a))

パスしません。

test (has-association? ((a b) (1 2)) 'a) returns #t: expects #t => got 1

これって以下な試験ではダメかなぁ。

(test* "(has-association? ((a b) (1 2)) 'a) returns #t"
       #f
       (not (has-association? (extend-env '(a b) '(1 2) (empty-env)) 'a)))

おそらくはもう少し良い解があるんだろうな、と言いつつエントリ投入。