EoPL reading (108) 2.3 Representation Strategies for Data Types

scheme EoPL

とりあえず Exercise 2.17 は昨晩のナニで OK ってコトにします。
実装が以下。

(define eopl:error error)

(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)
            (if (eqv? cmd 'pred)
                (has-association? env sym)
                (apply-env env sym)))))))

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

(define has-association?
  (lambda (env sym)
    (env 'pred 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))))))

上記だと has-association? で変数の束縛が見つかった時に #t が戻りません。ので試験が以下な形になってます。

(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* "(not (has-association? ((a b) (1 2)) 'a)) returns #f"
       #f
       (not (has-association? (extend-env '(a b) '(1 2) (empty-env)) 'a)))

(test-end)

has-association? で変数束縛を確認した時点で #t を戻すのであれば、extend-env が戻す手続きが以下になってれば良いのですが

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

これはあまりにキタナいカンジ。もうすこし簡潔にならんかな、と言いつつ以降が面白そうなのと、scheme 的に以下の評価はあり、という事でこれでヨシ、って事にします。

$ gosh
gosh> (add-load-path ".")
("." "/usr/share/gauche/site/lib" "/usr/share/gauche/0.8.13/lib")
gosh> (load "Fig2.3")
#t
gosh> (define l (extend-env '(a b) '(1 2) (empty-env)))
l
gosh> l
#<closure (extend-env extend-env)>
gosh> (if (has-association? l 'a) (apply-env l 'a))
1
gosh>

条件式が #f でなければ if は #t である、と判断する、ってコトで。

この後

ReadingGauche 方面に出力した後に、smart.fm して 2.3.3 方面に着手予定。