EoPL reading (19) 1.3.1 Free and Bound Variables

あまりきちんと読めてません。なんとなくな英語の理解で練習問題着手。

Exercise-1.19

lambda な式から occur free な変数のリストを戻す free-vars を書け、という事と見て検討着手。
とりあえず一番簡単なのから。

(use gauche.test)

(add-load-path ".")
(load "free-vars")

(test-start "free-vars")
(test-section "free-vars")
(test* "(free-vars ’(lambda (x) y)) should return y"
       '(y)
       (free-vars ’(lambda (x) y)))
(test-end)

これで実装を書いてみます。とりあえず以下でパスするはず。

(define (free-vars l)
  '(y)
  )

当たり前にパス。これではあまりにも馬鹿なので真面目に検討。なんとなくぼさっと考えながら以下なソレがでっちあがったんですが

(define (free-vars l)
  (let ((arg (cadr l)))
    (define (free-symbol s)
      (let f ((l arg))
	(cond ((null? l) '())
	      ((eq? (car l) s) s)
	      (else
	       (f (cdr l))))
	)
      )
    (let f ((rslt '()) (l (cddr l)))
      (if (null? l)
	  rslt
	  (let ((ret (free-symbol (car l))))
	    (f (if (null? ret)
		   rslt
		   (cons ret rslt))
	       (cdr l))))
      )
    )
  )

試験にパスしない。free なナニをスルーしてるし。ここです。

	    (f (if (null? ret)
		   rslt
		   (cons ret rslt))
	       (cdr l))))

ここを以下に修正したらとりあえず試験パス。

	    (f (if (null? ret)
		   (cons (car l) rslt)
		   rslt)
	       (cdr l))))

これは逆に free-symbol な手続きを、ってかもっと手続きの定義自体がシンプルになりそうな気がするなぁ。あと、lambda body がもっと複雑だった場合、上記ではダメな感触。
で、以下なナニがでっちあがりました。

(define (free-vars l)
  (let ((arg (cadr l)))
    (define (free-symbol s)
      (let f ((l arg))
	(cond ((null? l) '())
	      ((eq? (car l) s) s)
	      (else
	       (f (cdr l))))
	)
      )
    (let f ((rslt '()) (l (cddr l)))
      (if (null? l)
	  rslt
	  (if (symbol? (car l))
	      (let ((ret (free-symbol (car l))))
		(f (if (null? ret)
		       (cons (car l) rslt)
		       rslt)
		   (cdr l)))
	      (f (f rslt (car l)) (cdr l))))
      )
    )
  )

一応最初の試験にはパスしてます。以下な試験もパス。

(test* "(free-vars '(lambda (x) (y))) should return (y)"
       '(y)
       (free-vars '(lambda (x) (y))))

で、以下を追加したら "pair required, but got 1" というエラー。

(test* "(free-vars '(lambda (x y) (x 1 2) ((y) 3 z)) should return (z)"
       '(z)
       (free-vars '(lambda (x y) (x 1 2) ((y) 3 z))))

確認してみたら 1 とかって symbol ではない。pair? で切り分けな方向で以下に修正。

	  (if (pair? (car l))
	      (f (f rslt (car l)) (cdr l))
	      (let ((ret (free-symbol (car l))))
		(f (if (null? ret)
		       (cons (car l) rslt)
		       rslt)
		   (cdr l)))))

で、試験したら以下なナニ。

$ make
Testing free-vars ...                                            failed.
discrepancies found.  Errors are:
test (free-vars '(lambda (x y) (x 1 2) ((y) 3 z)) should return (z): expects (z) => got (z 3 2 1)
$

む。意味分からんぞ、と言いつつ free-symbol な手続きを最初に色々手を入れてたんですが、free-symbol から '() が戻った後が問題な事に相当時間がかかってわかりました。とりあえず下記な試験に

(use gauche.test)

(add-load-path ".")
(load "free-vars")

(test-start "free-vars")
(test-section "free-vars")
(test* "(free-vars '(lambda (x) y)) should return (y)"
       '(y)
       (free-vars '(lambda (x) y)))
(test* "(free-vars '(lambda (x) (y))) should return (y)"
       '(y)
       (free-vars '(lambda (x) (y))))
(test* "(free-vars '(lambda (x y) (x 1 2) ((y) 3 z)) should return (z)"
       '(z)
       (free-vars '(lambda (x y) (x 1 2) ((y) 3 z))))
(test-end)

以下の実装でパスしています。

(define (free-vars l)
  (let ((arg (cadr l)))
    (define (free-symbol s)
      (let f ((l arg))
	(cond ((null? l) '())
	      ((eq? (car l) s)  s)
	      (else
	       (f (cdr l))))
	)
      )
    (let f ((rslt '()) (l (cddr l)))
      (if (null? l)
	  rslt
	  (if (pair? (car l))
	      (f (f rslt (car l)) (cdr l))
	      (let ((ret (free-symbol (car l))))
		(f (if (and (null? ret) (symbol? (car l)))
		      (cons (car l) rslt)
		       rslt)
		   (cdr l)))))
      )
    )
  )

とりあえずまだ試験は足りていないはず。とり急ぎ Reading Gauche 方面に去ります。