EoPL reading (113) 2.3 Representation Strategies for Data Types

Exercise 2.23

single pair of ribs で実装ときた。これって

gosh> (empty-env)
()
gosh>

で、

gosh> (extend-env '(y) '(8) (empty-env))
((y) . (8))
gosh>

で、

gosh> (extend-env '(d x) '(6 7) (exptend-env '(y) '(8) (empty-env)))
((d x y) . (6 7 8))
gosh>

という事なのかなぁ。
とりあえず上記な試験はさくっと書けそう。当たり前ですが、問題は実装ですね。extend-env はこう?

(define extend-env
  (lambda (syms vals env)
    (cons (append syms (car env)) (append vals (cdr env)))))

どっちかというと apply-env が問題。てーか上記な実装だと検索が繰り返しでなくなるんですが、extend する前の環境に復帰できませんがそれは OK なのだろーか。
とりあえず env 戻せるようにするには env が手続き戻す方式じゃないと微妙か。

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

む。これって例示されてるそのまんまだな。env を脱ぎたい場合はこれで、そうでなければ上記で良いのでしょうか。
とりあえず以下ってコトで。

(define empty-env
  (lambda () (cons '() '())))

(define extend-env
  (lambda (syms vals env)
    (cons (append syms (car env)) (append vals (cdr env)))))

(define apply-env
  (lambda (env sym)
    (if (null? env)
	(eopl:error 'apply-env
		    "No binding for " sym)
	(let ((syms (car env))
	      (vals (cdr env)))
	  (let ((pos (list-find-position sym syms)))
	    (if (number? pos)
		(list-ref vals pos)
		(eopl:error 'apply-env
			    "No bindicatng for " sym)))))))

(define list-find-position
  (lambda (sym los)
    (list-index (lambda (sym1) (eqv? sym1 sym)) los)))

(define list-index
  (lambda (pred ls)
    (cond ((null? ls) #f)
          ((pred (car ls)) 0)
          (else
           (let ((list-index-r (list-index pred (cdr ls))))
             (if (number? list-index-r)
                 (+ list-index-r 1)
                 #f))))))

とり急ぎ作った試験が以下。

(use gauche.test)

(add-load-path ".")
(load "env")

(test-start "extend-env")
(test-section "empty-env")
(test* "empty env is '(cons '() '())"
       '(())
       (empty-env))

(test-section "extend-env")
(test* "(extend-env '() '() (empty-env))"
       '(())
       (extend-env '() '() (empty-env)))
(test* "(extend-env '(a) '(1) (empty-env))"
       '((a) 1)
       (extend-env '(a) '(1) (empty-env)))
(test* "(extend-env '(d x) '(6 7)
          (extend-env '(y) '(8)
            (empty-env)))"
       '((d x y) 6 7 8)
       (extend-env '(d x) '(6 7)
		   (extend-env '(y) '(8)
			       (empty-env))))
	      
(test-section "abnormal end")
(test* "apply empty-env"
       *test-error*
       (apply-env (empty-env) 'a))
(test* "search 'a from '(b c)"
       *test-error*
       (apply-env (extend-env '(b c) '(0 1) (empty-env))
		  'a))
(test* "search 'z from '((a) (b c))"
       *test-error*
       (apply-env (extend-env '(a) '(0)
			      (extend-env '(b c) '(1 2) (empty-env)))
		  'z))
       
(test-section "normal end")
(test* "search 'a from '(a b)"
       0
       (apply-env (extend-env '(a b) '(0 1) (empty-env))
		  'a))
(test* "search 'b from '(a b)"
       1
       (apply-env (extend-env '(a b) '(0 1) (empty-env))
		  'b))
(test* "search 'c from '((a b) (c))"
       2
       (apply-env (extend-env '(a b) '(0 1)
			      (extend-env '(c) '(2) (empty-env)))
		  'c))

(test-end)

試験にはパスしてるんですが、extend-env が戻す値について微妙な試行錯誤が御座いました。英語の練習してから着手可能であれば次に着手してみる方向で。

む

そーゆー意味ではいっちゃん上の戻り予想は完全ダウトですな。

gosh> (empty-env)
(())
gosh>

で、

gosh> (extend-env '(y) '(8) (empty-env))
((y) 8)
gosh>

で、

gosh> (extend-env '(d x) '(6 7) (exptend-env '(y) '(8) (empty-env)))
((d x y) 6 7 8)
gosh>

なのか。とほほ。