EoPL reading (67) 2.2 An Abstraction for Inductive Data Type

むむ。直前エントリに追記した情報は誤りですね。。
朝イチ頭の回転が良い時間にいくつか検討実施。
まず app-exp な分岐の記述を以下にしたら

	   (app-exp (rator rands)
		    (append (list (unparse-expression rator))
			    (if (pair? rands)
				(unparse-expression rands)
				(if (null? rands)
				    '()
				    (list rands)))))

試験の出力が以下になりました (unparse 部分のみ)。

<unparse-expression>-----------------------------------------------------------
test unparse (1), expects a ==> ok
test unparse (2), expects (lambda (x) x) ==> ok
test unparse (3), expects ((lambda (x) x) a) ==> ERROR: GOT ((lambda (x) x) . a)
test unparse (4), expects (lambda (x) (f x y)) ==> ERROR: GOT (lambda (x) (f x . y))
test unparse (5), expects (lambda (x) (x)) ==> ERROR: GOT #<error "wrong number of arguments for #<closure (unparse-expression unparse-expression)> (required 2, got 1)">
test unparse (6), expects (lambda (x y z) x) ==> ERROR: GOT #<error "wrong number of arguments for #<closure (unparse-expression unparse-expression)> (required 2, got 3)">
test unparse (7), expects (lambda () x) ==> ok

ええと、(6) の試験は以下を変換しようとしていた模様。

       (unparse-expression '(lambda-exp (x y z) (var-exp x) '()))

これは以下に修正したら試験パス。

       (unparse-expression '(lambda-exp (x y z) (var-exp x)))

で、これまでの流れを見るにどう考えても app-exp なケイスの手続きに渡す引数はリスト一発じゃないと微妙、という事にて expression の app-exp な定義を以下に修正。

  (app-exp
   (rands (list-of expression?))))

でも、ただこうするだけでは駄目。ちょっと define-datatype.scm の define-datatype:case-helper なソレに以下を追加。

    ((_ Variant (Purported-variant-name (Purported-field-name)
                  Body0 Body1 ...))
     (apply (lambda (Purported-field-name) Body0 Body1 ...)
       (list (cdr Variant))))

引数一つならリストになる (はず)。で、試験動かしてみると以下な出力。

<unparse-expression>-----------------------------------------------------------
test unparse (1), expects a ==> ERROR: GOT (a)
test unparse (2), expects (lambda (x) x) ==> ERROR: GOT (lambda (x) (x))
test unparse (3), expects ((lambda (x) x) a) ==> ERROR: GOT ((var-exp a) (lambda-exp (x) (var-exp x)))
test unparse (4), expects (lambda (x) (f x y)) ==> ERROR: GOT (lambda (x) ((var-exp y) (var-exp x) (var-exp f)))
test unparse (5), expects (lambda (x) (x)) ==> ERROR: GOT (lambda (x) ((var-exp x)))
test unparse (6), expects (lambda (x y z) x) ==> ERROR: GOT (lambda (x y z) (x))
test unparse (7), expects (lambda () x) ==> ERROR: GOT (lambda () (x))

むむ。間違えた。

	   (app-exp (rands)
		    (let f ((rslt '()) (rands rands))
		      (if (null? rands)
			  rslt
			  (f (append (list (car rands)) rslt) (cdr rands)))))

ってなっていたので以下に修正。

	   (app-exp (rands)
		    (let f ((rslt '()) (rands rands))
		      (if (null? rands)
			  rslt
			  (f (append (list (unparse-expression (car rands))) rslt) (cdr rands)))))

で試験してみたら出力が以下。

<unparse-expression>-----------------------------------------------------------
test unparse (1), expects a ==> ERROR: GOT (a)
test unparse (2), expects (lambda (x) x) ==> ERROR: GOT (lambda (x) (x))
test unparse (3), expects ((lambda (x) x) a) ==> ERROR: GOT ((a) (lambda (x) (x)))
test unparse (4), expects (lambda (x) (f x y)) ==> ERROR: GOT (lambda (x) ((y) (x) (f)))
test unparse (5), expects (lambda (x) (x)) ==> ERROR: GOT (lambda (x) ((x)))
test unparse (6), expects (lambda (x y z) x) ==> ERROR: GOT (lambda (x y z) (x))
test unparse (7), expects (lambda () x) ==> ERROR: GOT (lambda () (x))

む。引数一発なソレが全部リストになっているなぁ。しかも順番逆だし。こうか。

	   (app-exp (rands)
		    (let f ((rslt '()) (rands rands))
		      (if (null? rands)
			  rslt
			  (f (append rslt (list (unparse-expression (car rands)))) (cdr rands)))))

試験の出力が以下。

<unparse-expression>-----------------------------------------------------------
test unparse (1), expects a ==> ERROR: GOT (a)
test unparse (2), expects (lambda (x) x) ==> ERROR: GOT (lambda (x) (x))
test unparse (3), expects ((lambda (x) x) a) ==> ERROR: GOT ((lambda (x) (x)) (a))
test unparse (4), expects (lambda (x) (f x y)) ==> ERROR: GOT (lambda (x) ((f) (x) (y)))
test unparse (5), expects (lambda (x) (x)) ==> ERROR: GOT (lambda (x) ((x)))
test unparse (6), expects (lambda (x y z) x) ==> ERROR: GOT (lambda (x y z) (x))
test unparse (7), expects (lambda () x) ==> ERROR: GOT (lambda () (x))

キタナい修正ですが一引数なソレを修正。

	   (lit-exp (datum) (car datum))
	   (var-exp (id) (car id))

parse な以下の試験にはパス。

(use gauche.test)

(add-load-path ".")
(load "define-datatype")
(load "expression")
(load "occurs-free")
(load "parse")

(test-start "parse")
(test-section "unparse-expression")
(test* "unparse (1)"
       'a
       (unparse-expression '(var-exp a)))
(test* "unparse (2)"
       '(lambda (x) x)
       (unparse-expression '(lambda-exp (x) (var-exp x))))
(test* "unparse (3)"
       '((lambda (x) x) a)
       (unparse-expression '(app-exp (lambda-exp (x) (var-exp x)) (var-exp a))))
(test* "unparse (4)"
       '(lambda (x) (f x y))
       (unparse-expression '(lambda-exp (x) (app-exp (var-exp f) (var-exp x) (var-exp y)))))
(test* "unparse (5)"
       '(lambda (x) (x))
       (unparse-expression '(lambda-exp (x) (app-exp (var-exp x)))))
(test* "unparse (6)"
       '(lambda (x y z) x)
       (unparse-expression '(lambda-exp (x y z) (var-exp x))))
(test* "unparse (7)"
       '(lambda () x)
       (unparse-expression '(lambda-exp () (var-exp x))))

(test-section "parse-expression")
(test* "parse (1)"
       '(var-exp a)
       (parse-expression 'a))
(test* "parse (2)"
       '(lambda-exp (x) (var-exp x))
       (parse-expression '(lambda (x) x)))
(test* "parse (3)"
       '(app-exp (lambda-exp (x) (var-exp x)) (var-exp a))
       (parse-expression '((lambda (x) x) a)))
(test* "parse (4)"
       '(lit-exp 5)
       (parse-expression 5))
(test* "parse (5)"
       *test-error*
       (parse-expression "a"))
(test* "parse (6)"
       '(app-exp (var-exp a) (var-exp b) (var-exp c))
       (parse-expression '(a b c)))
(test* "parse (7)"
       '(app-exp (lambda-exp (x) (app-exp (var-exp +) (var-exp x) (var-exp x))) (var-exp a))
       (parse-expression '((lambda (x) (+ x x)) a)))
(test* "parse (8)"
       '(lambda-exp (x) (app-exp (var-exp x)))
       (parse-expression '(lambda (x) (x))))

(test-end)

以降は朝の生産性が良い時間にがっつりお仕事な検討着手。

occurs-free も

以下に修正。

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

(define occurs-free?
  (lambda (var exp)
    (cases expression exp
	   (lit-exp (num) #f)
	   (var-exp (id) (eqv? (car id) var))
	   (if-exp (test-exp true-exp false-exp)
		   (or (occurs-free? test-exp)
		       (occurs-free? true-exp)
		       (occurs-free? false-exp)))
	   (lambda-exp (id body)
		       (and (not (eqv? id var))
			    (occurs-free? var body)))
	   (app-exp (rands)
		    (let f ((rands rands))
		      (cond ((null? rands) #f)
			    ((occurs-free? var (car rands)) #t)
			    (else
			     (f (cdr rands)))))))))

以下に試験にパスしてます。

(use gauche.test)

(add-load-path ".")
(load "define-datatype")
(load "expression")
(load "occurs-free")

(test-start "occurs-free?")
(test-section "var-exp")
(test* "not occurs free (var-exp)"
       #f
       (occurs-free? 'x '(var-exp y)))
(test* "occurs free (var-exp)"
       #t
       (occurs-free? 'y '(var-exp y)))

(test-section "lambda-exp")
(test* "occurs free (lambda-exp)"
       #t
       (occurs-free? 'y '(lambda-exp x (var-exp y))))
(test* "not occurs free (lambda-exp)"
       #f
       (occurs-free? 'y '(lambda-exp y (var-exp y))))
(test* "not occurs free (lambda-exp)"
       #f
       (occurs-free? 'y '(lambda-exp x (var-exp x))))

(test-section "app-exp")
(test* "occurs free (app-exp)"
       #t
       (occurs-free? 'y '(app-exp (lambda-exp x (var-exp y)) (var-exp y))))

(test* "occurs free (app-exp)"
       #t
       (occurs-free? 'y '(app-exp (lambda-exp y (var-exp y)) (var-exp y))))

(test* "not occurs free (app-exp)"
       #f
       (occurs-free? 'y '(app-exp (lambda-exp y (var-exp y)) (var-exp x))))

(test-end)

ようやく Exercise 2.7 に着手できるんでしょうか。