/var/log/messages

Nov 25, 2013 - 1 minute read - Comments - EoPL Scheme

EoPL の Exercise 2.23

ゲンジツトウヒ気味に着手。必要な手続きは以下なのかどうか。

  • empty-env
  • extend-env
  • apply-env
  • list-find-position
  • list-index

single pair of ribs が前提なのであれば (sim val) なリストのリストで良いのか。これで作るとして試験を先に考えます。

なんとなく書き始めて list-index は不要なのかな、と思っているなど。とりあえず empty-env な試験は以下で良いのかな。

(test-section "enpty-env")
(test* "empty-env"
       '()
       (empty-env))

あるいは list-find-position の試験が以下。

(test-section "list-find-position")
(test* "(list-find-position 'a '())"
       #f
       (list-find-position 'a '()))
(test* "(list-find-position 'a '((b 1)))"
       #f
       (list-find-position 'a '((b 1))))
(test* "(list-find-position 'a '((a 1)))"
       1
       (list-find-position 'a '((a 1))))

あるいは apply-env とか extend-env が以下。

(test-section "extend-env")
(test* "(extend-env 'a 1 (empty-env))"
       '((a 1))
       (extend-env 'a 1 empty-env))

(test-section "apply-env")
(test* "(apply-env (empty-env) 'x)"
       (test-error)
       (apply-env (empty-env) 'x))
(test* "(apply-env (extend-env 'a 1 (empty-env)) 'x)"
       (test-error)
       (apply-env (extend-env 'a 1 (empty-env)) 'x))
(test* "(apply-env (extend-env 'a 1 (empty-env)) 'a)"
       1
       (apply-env (extend-env 'a 1 (empty-env)) 'a))

実装書いてみます。以下で試験パス。なんとなく問題の主旨からそれているのではないか的難易度だったりするんですがorz

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

(define list-find-position
  (lambda (sym env)
    (cond ((null? env) #f)
      ((eqv? sym (car (car env))) (cadr (car env)))
      (else
       (list-find-position sym (cdr env))))))

(define extend-env
  (lambda (sym val env)
    (cons (list sym val) env)))

(define apply-env
  (lambda (env sym)
    (cond ((null? env)
           (error "No binding for " sym))
          (else
           (let ((val (list-find-position sym env)))
             (if (not val)
                 (apply-env (cdr env) sym)
                 val))))))