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

色々見てみるに、define-datatype の定義とかって全然関係なくって、ただのナチュラル君の大暴れな事が判明しつつあります。
しかも最初は構文木って 2 分木じゃないと駄目なの? って思ったら、それさえもナチュラルである事が判明しつつあります。やれやれ。
試験を書いてみた。以下。

(test* "(app-exp (var-exp a) (var-exp b)) is expression"
       #t
       (expression? '(app-exp (var-exp a) (var-exp b))))
(test* "(app-exp (var-exp a) (app-exp (var-exp b) (var-exp c))) is expression"
       #t
       (expression? '(app-exp (var-exp a) (app-exp (var-exp b) (var-exp c)))))
(test* "(app-exp (var-exp a) (var-exp b) (var-exp c)) is expression"
       #t
       (expression? '(app-exp (var-exp a) (var-exp b) (var-exp c))))

上記、いずれも expression 認定。別に 2 分木でなくても OK。define-datatype の実装は現時点で以下ですが

(define-datatype expression expression?
  (lit-exp
   (datum number?))
  (var-exp
   (id symbol?))
  (if-exp
   (test-exp expression?)
   (true-exp expression?)
   (false-exp expression?))
  (lambda-exp
   (ids (list-of symbol?))
   (body expression?))
  (app-exp
   (rator expression?) 
   (rand (list-of expression?))))

上記に構わず expression? って以下でもセイフなだけに。

(test* "(app-exp) is expression"
       #t
       (expression? '(app-exp)))

この件で問題なのは parse.scm の実装とか試験とかな模様。とりあえず、parse-expression 手続きの app-exp な部分を以下に修正。

	    (else
	     (app-exp
	      (parse-expression (car datum))
	      (parse-expression (if (null? (cddr datum))
				    (cadr datum)
				    (cdr datum)))))))

あと、lambda 式の body 部分は式一発な BNF なので面倒なのでそーゆー事にしときます。って上記だと二分木になるな。
else な部分を以下に修正。

	    (else
	      (let f ((rslt '(app-exp)) (datum datum))
		(if (null? datum)
		    rslt
		    (f (append rslt (list (parse-expression (car datum))))
		       (cdr datum)))))))

を、これで parse な以下の試験にパス。

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

これで lambda body も cddr 取り出しでなんとかなる?

      (cond ((eqv? (car datum) 'lambda)
	     (lambda-exp (cadr datum)
			 (parse-expression (caddr datum))))

で、以下な試験を追加。

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

試験パスしてます。いやはや。次はこの考え方を踏ませて unparse-expression の実装と試験を。あら? unparse はどう書けば良いのかな。ってか現時点での実装が以下で

(define unparse-expression
  (lambda (exp)
    (cases expression exp
	   (lit-exp (num) num)
	   (var-exp (id) id)
	   (if-exp (test-exp true-exp false-exp)
		   (list 'if test-exp true-exp false-exp))
	   (lambda-exp (ids body)
		       (list 'lambda ids
			     (unparse-expression body)))
	   (app-exp (rator rands)
		    (list (unparse-expression rator)
			  (unparse-expression rands))))))

パスしてない試験が以下。

(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 (4), expects (lambda (x) (f x y)) ==> ERROR: GOT #<error "wrong number of arguments for #<closure (unparse-expression unparse-expression)> (required 2, got 3)">
test unparse (5), expects (lambda (x) (x)) ==> ERROR: GOT #<error "wrong number of arguments for #<closure (unparse-expression unparse-expression)> (required 2, got 1)">

うーむ。元に戻ったカンジ。こうしたら

	   (app-exp (rator . rand)
		    (list (unparse-expression rator)
			  (unparse-expression rand))))))

全部試験 NG。つい、expression な app-exp を以下にしたくなりますが、

  (app-exp
;;   (rator expression?) 
;;   (rand (list-of expression?))))
   (data (list-of expression?))))

あるいは unparse-expression 手続きが以下

	   (app-exp (data)
		    (list (unparse-expression (car data))
			  (unparse-expression (cdr data)))))))

この場合、以下が試験にパスしない。

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

これはオシい、のだろうか。で、parse と同じ方式に変更してみた。

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

うーん。なんとなく前に進んだ気もするんですが、そうでもなかったりします。とりあえずここで投入。

む

define-datatype.scm の define-datatype:case-helper なナニを以下で parse の試験が通りました。

    ((_ Variant (Purported-variant-name (Purported-field-name ...)
                  Body0 Body1 ...)
       Clause ...)
     (if (eq? (car Variant) 'Purported-variant-name)
;;         (apply (lambda (Purported-field-name ...) Body0 Body1 ...)
         (apply (lambda ((list Purported-field-name ...)) Body0 Body1 ...)
           (cdr Variant))
         (define-datatype:case-helper Variant Clause ...)))

ぬ。ちなみに現時点で unparse-expression の該当部分は以下。

	   (app-exp (data)
;;	   (app-exp (rator rand)
;;	   (app-exp (rator . rands)
		    (let f ((rslt '()) (data data))
		      (if (null? data)
			  rslt
			  (f (append rslt (list (unparse-expression (car data))))
			     (cdr data))))))))

なぜか unparse な試験がパスしなくなってます。微妙。この状態で止めた方が良さげ。ってかこの直前に戻せる状態かな。