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

昨晩夜更かしし杉で午前中 gdgd だった。現在夕刻なんですが続きをナニ。
とりあえず unparse については以下の試験を追加。

(test* "(unparse '(append (cons w x) y (cons w z)))"
       '("append" ("cons" w x) y ("cons" w z))
       (unparse (app-term (list (constant-term "append")
				(app-term
				 (list
				  (constant-term "cons")
				  (var-term 'w)
				  (var-term 'x)))
				(var-term 'y)
				(app-term
				 (list
				  (constant-term "cons")
				  (var-term 'w)
				  (var-term 'z)))))))

テキストに出てる例です。パスしたので OK ってコトで。最後は all-ids になります。まず試験から、という事なんですが、こんなもんで良いのだろうか。

(use gauche.test)

(add-load-path ".")
(load "all-ids")

(test-start "all-ids")
(test-section "all-ids")
(test* "(all-ids x)"
       '(x)
       (all-ids (var-term 'x)))

(test* "(all-ids (cons x y))"
       '(x y)
       (all-ids (app-term
		 (list
		  (constant-term "cons")
		  (var-term 'x)
		  (var-term 'y)))))

(test* "(all-ids (cons w x) y (cons w z))"
       '(w x y z)
       (all-ids (app-term
		 (list
		  (constant-term "append")
		  (app-term
		   (list
		    (constant-term "cons")
		    (var-term 'w)
		    (var-term 'x)))
		  (var-term 'y)
		  (app-term
		   (list
		    (constant-term "cons")
		    (var-term 'w)
		    (var-term 'z)))))))

(test-end)

で、実装を検討。ってか Exercise 2.10 の実装を見つつナニ。

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

(define all-ids
  (lambda (exp)
    (let f ((rslt '()) (exp exp))
      (cases term exp
	     (constant-term (datum) rslt)
	     (var-term (id) (if (memv id rslt)
				rslt
				(append rslt (list id))))
	     (app-term (terms)
		       (let g ((rslt rslt) (terms terms))
			 (if (null? terms)
			     rslt
			     (g (f rslt (car terms))
				(cdr terms)))))))))

試験パス。とりあえず次回から 2.3 節に突入します。