EoPL reading (104) 2.3 Representation Strategies for Data Types

ええと、Figure 2.3 の試験を書いてから Exercise 2.15 に着手する方向で。
Figure 2.3 の一連の手続き定義が以下。

(define eopl:error error)

(define empty-env
  (lambda ()
    (lambda (sym)
      (eopl:error 'apply-env "No binding for ~s" sym))))

(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))))))

(define apply-env
  (lambda (env sym)
    (env 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))))))

まず、list-index 手続きの試験から検討。こんなカンジで OK ?

(use gauche.test)

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

(test-start "list-index")
(test-section "list-index")
(test* "search '()"
       #f
       (list-index (lambda (sym) (eqv? sym 'a)) '()))
(test* "unmatch"
       #f
       (list-index (lambda (sym) #f) '(a b c)))
(test* "match"
       0
       (list-index (lambda (sym) (eqv? sym 'a)) '(a b c)))
(test* "match"
       2
       (list-index (lambda (sym) (eqv? sym 'c)) '(a b c)))
(test* "unmatch"
       #f
       (list-index (lambda (sym) (eqv? sym 'd)) '(a b c)))

(test-end)

ちなみに pred に (lambda (sym) 'a) をセットしたら 0 が戻ってきました。#f 以外は真と見做す模様。引き続き list-find-position 手続きの試験が以下。

(use gauche.test)

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

(test-start "list-find-position")
(test-section "list-find-position")
(test* "unmatch"
       #f
       (list-find-position 'z '(a b c)))
(test* "match"
       0
       (list-find-position 'a '(a b c)))
(test* "match"
       1
       (list-find-position 'b '(a b c)))
(test* "match"
       2
       (list-find-position 'c '(a b c)))
(test* "match"
       #f
       (list-find-position 'd '(a b c)))

(test-end)

以降が微妙。

む

extend-env 凄いな。ぱっと見よく分からんかったのですが、探索失敗な処理

	    (apply-env env sym))))))

は extend する前の環境をナニしてるのか。ちょっと今日 NDK の makefile ニラんでたので scheme 脳が退化してるかも。単体試験になってないけど以下。

(use gauche.test)

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

(test-start "extend-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)

明日はこれを元にして本文も読みつつ 2.15 に着手予定。明後日は健康診断後に OSC 参加予定ッス。