EoPL reading (109) 2.3 Representation Strategies for Data Types

2.3.3 節に突入。ソース修正。
盛り込んだナニが以下。

(add-load-path ".")
(load "define-datatype")

(define scheme-value? (lambda (v) #t))

(define list-of
  (lambda (pred)
    (lambda (val)
      (or (null? val)
          (and (pair? val)
               (pred (car val))
               ((list-of pred) (cdr val)))))))

(define-datatype environment environment?
  (empty-envrecord)
  (extended-env-record
   (syms (list-of symbol?))
   (vals (list-of scheme-value?))
   (env (environment?))))

(define empty-env
  (lambda ()
    (empty-env-record)))

(define extend-env
  (lambda (syms vals env)
    (extended-env-record syms vals env)))

(define apply-env
  (lambda (env sym)
    (cases environment env
	   (empty-env-record 
	    ()
	    (eopl:error 'apply-env
			"No binding for" sym))
	   (extended-env-record 
	    (syms vals env)
	    (let ((pos (list-find-position sym syms)))
	      (if (number? pos)
		  (list-ref vals pos)
		  (apply-env 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))))))

で試験してみたらパスせず。extend-env な試験のみ。

Testing extend-env ============================================================
<abnormal end>-----------------------------------------------------------------
test apply empty-env, expects #<error> ==> (cases environment env (empty-env-record () (eopl:error 'apply-env No binding for sym)) (extended-env-record (syms vals env) (let ((pos (list-find-position sym syms))) (if (number? pos) (list-ref vals pos) (apply-env env sym)))))
ok
test search 'a from '(b c), expects #<error> ==> ok
test search 'z from '((a) (b c)), expects #<error> ==> ok
<normal end>-------------------------------------------------------------------
test search 'a from '(a b), expects 0 ==> ERROR: GOT #<error "environment? \"expects 1 argument, not 0.\"">
test search 'b from '(a b), expects 1 ==> ERROR: GOT #<error "environment? \"expects 1 argument, not 0.\"">
test search 'c from '((a b) (c)), expects 2 ==> ERROR: GOT #<error "environment? \"expects 1 argument, not 0.\"">
failed.
discrepancies found.  Errors are:
test search 'a from '(a b): expects 0 => got #<error "environment? \"expects 1 argument, not 0.\"">
test search 'b from '(a b): expects 1 => got #<error "environment? \"expects 1 argument, not 0.\"">
test search 'c from '((a b) (c)): expects 2 => got #<error "environment? \"expects 1 argument, not 0.\"">

むむ。試験が以下です。

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

一つづつ見てきます。なんか define-datatype でバグあり。

(define-datatype environment environment?
  (empty-envrecord)

がしかし、結果は微妙。よくよく見たら extend-env に渡すナニは

(test* "apply empty-env"
       *test-error*
       (apply-env (empty-env) 'a))

な形になってないと駄目なんですが、これは 2.3.2 な試験に問題あり、という事でしょうか。こんななってるんですが

(test* "apply empty-env"
       *test-error*
       (apply-env empty-env 'a))

微妙。しかも試験を修正したらパスしやがった。よく考えたら empty でも (empty) でも例外がナニなので error な試験にパスするのか。とほほほ杉。
意味不明なので gosh で確認。

$ gosh
gosh> (add-load-path ".")
("." "/usr/share/gauche/site/lib" "/usr/share/gauche/0.8.13/lib")
gosh> (load "Fig2.3")
define-datatype.scm version J3 2002-01-02 10:55
#t
gosh> (extended-env-record '(d x) '(6 7) (empty-env))
*** ERROR: environment? "expects 1 argument, not 0."
Stack Trace:
_______________________________________
  0  (environment?)
        At line 19 of "./Fig2.3.scm"
  1  p

  2  (for-each (lambda (a f p pname) (if (not (p a)) (define-datatype:r ...
        [unknown location]
gosh> 

む。あった。

(define-datatype environment environment?
  (empty-env-record)
  (extended-env-record
   (syms (list-of symbol?))
   (vals (list-of scheme-value?))
   (env (environment?))))

こうじゃん。

(define-datatype environment environment?
  (empty-env-record)
  (extended-env-record
   (syms (list-of symbol?))
   (vals (list-of scheme-value?))
   (env environment?)))

試験パス。どうもいかん。続けて Exercise 2.18 なんですが gosh 上で見てみるに

gosh> (load "Fig2.3")
define-datatype.scm version J3 2002-01-02 10:55
#t
gosh> (extended-env-record '(d x) '(6 7) (empty-env))
(extended-env-record (d x) (6 7) (empty-env-record))
gosh> (define l (extended-env-record '(d x) '(6 7) (empty-env)))
l
gosh> l
(extended-env-record (d x) (6 7) (empty-env-record))
gosh> 

そのまんまだし。これって

(define environment-to-list (lambda (env) env))

で良いのではないかと思うんですがどうなんでしょ。