EoPL reading (21) 1.3.1 Free and Bound Variables
Exercise-1.19
bound-vars の方も。free-vars の試験をコピッて以下をでっち上げる。
(use gauche.test)
(add-load-path ".")
(load "bound-vars")
(test-start "bound-vars")
(test-section "bound-vars")
(test* "(bound-vars '(lambda (x) y)) should return ()"
'()
(bound-vars '(lambda (x) y)))
(test* "(bound-vars '(lambda (x) (y))) should return ()"
'()
(bound-vars '(lambda (x) (y))))
(test* "(bound-vars '(lambda (x y) (x 1 2) ((y) 3 z)) should return (x y)"
'(x y)
(bound-vars '(lambda (x y) (x 1 2) ((y) 3 z))))
(test* "(bound-vars '(lambda (x) (x))) should return (x)"
'(x)
(bound-vars '(lambda (x) (x))))
(test* "(bound-vars '(lambda (x) (x 1 2 3))) should return (x)"
'(x)
(bound-vars '(lambda (x) (x 1 2 3))))
(test* "(bound-vars '(lambda (x) ()) should return ()"
'()
(bound-vars '(lambda (x) ())))
(test* "(bound-vars '(lambda () (x)) should return ()"
'()
(bound-vars '(lambda () (x))))
(test* "(bound-vars '(lambda () ((x) (y))) should return ()"
'()
(bound-vars '(lambda () ((x) (y)))))
(test-end)よく考えたら以下なケイスってどうなるんだろ。
(lambda (x)
((lambda (y)
(+ 2 y))
x))手続き的に lambda 一発にしか対応してないはず。あと、bound-vars も free-vars をコピーして作ったんですが、以下。
(define (bound-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 (null? ret)
rslt
(append rslt (list (car l))))
(cdr l)))))
)
)
)最初、free-vas.scm の以下の部分をどう書きかえたものやら、と思ってたんですが
(f (if (and (null? ret) (symbol? (car l)))
(append rslt (list (car l)))
rslt)
(cdr l)))))ret が ’() でありつつ (car l) が symbol ではない、というケイスはあり得ない事が判明。微妙スギ。こーゆーケイスを発見してしまうと試験が微妙なんだろな、とヘコみます。いかんなぁ。
とりあえずテキストに例示されている
(lambda (y) ((lambda (x) x) y))
とか
(lambda (f)
(lambda (x)
(f x)))を吸わせてきちんと答えが戻ってくるようにすべく再検討します。
む
試験が微妙だった模様。free-vars 手続きは以下でないと駄目でした。
(f (if (and (null? ret) (symbol? (car l)))
(append rslt (list (car l)))
rslt)
(cdr l)))))よく考えたら当たり前だな。
続き
ええと、以下な試験を追加。
(test* "(free-vars '(lambda (y) ((lambda (x) x) y)) should return ()"
'()
(free-vars '(lambda (y) ((lambda (x) x) y))))試験は当たり前にパスしません。
$ make Testing bound-vars ... passed. Testing free-vars ... failed. discrepancies found. Errors are: test (free-vars '(lambda (y) ((lambda (x) x) y)) should return (): expects () => got (lambda x x) $
ええと、car がペアでその car が lambda なら云々スか。とりあえず試験にパスする手続きがでっち上がりましたが、これはマズいですな。
(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 (let ((l (car l)))
(if (eq? 'lambda (car l))
(append rslt (free-vars l))
(f rslt l)))
(cdr l))
(let ((ret (free-symbol (car l))))
(f (if (and (null? ret) (symbol? (car l)))
(append rslt (list (car l)))
rslt)
(cdr l)))))
)
)
)例えば以下な式を渡すと
(lambda (x) ((lambda (y) (+ y x)) 3))
x は free-vars だ、って言われそうな気がします。以下な試験を追加。
(test* "(free-vars '(lambda (x) ((lambda (y) (+ y x)) 3)) should return (+)"
'(+)
(free-vars '(lambda (x) ((lambda (y) (+ y x)) 3))))で実行。
$ make Testing bound-vars ... passed. Testing free-vars ... failed. discrepancies found. Errors are: test (free-vars '(lambda (x) ((lambda (y) (+ y x)) 3)) should return (+): expects (+) => got (+ x) $
あららら。どうしたもんやら。そもそもの手続きのつくりがダウトですな。arg は要素が追加できないと駄目なはず。なので名前付き let な f の引数にしてあげないと駄目スか。
で、でっち上がったのが以下。
(define (free-vars l)
(let f ((rslt '()) (arg (cadr l)) (body (cddr l)))
(define (free-symbol l s)
(cond ((null? l) '())
((eq? (car l) s) s)
(else
(free-symbol (cdr l) s)))
)
(if (null? body)
rslt
(if (pair? (car body))
(f (let ((l (car body)))
(if (eq? 'lambda (car l))
(f rslt (append arg (cadr l)) (cddr l))
(f rslt arg l)))
arg (cdr body))
(let ((ret (free-symbol arg (car body))))
(f (if (and (null? ret) (symbol? (car body)))
(append rslt (list (car body)))
rslt)
arg (cdr body)))))
)
)以下な試験にパスしてます。
(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* "(free-vars '(lambda (x) (x))) should return ()"
'()
(free-vars '(lambda (x) (x))))
(test* "(free-vars '(lambda (x) (x 1 2 3))) should return ()"
'()
(free-vars '(lambda (x) (x 1 2 3))))
(test* "(free-vars '(lambda (x) ()) should return ()"
'()
(free-vars '(lambda (x) ())))
(test* "(free-vars '(lambda () (x)) should return (x)"
'(x)
(free-vars '(lambda () (x))))
(test* "(free-vars '(lambda () ((x) (y))) should return (x y)"
'(x y)
(free-vars '(lambda () ((x) (y)))))
(test* "(free-vars '(lambda (y) ((lambda (x) x) y)) should return ()"
'()
(free-vars '(lambda (y) ((lambda (x) x) y))))
(test* "(free-vars '(lambda (y) ((lambda (x) (+ z x)) y)) should return (+ z)"
'(+ z)
(free-vars '(lambda (y) ((lambda (x) (+ z x)) y))))
(test* "(free-vars '(lambda (x) ((lambda (y) (+ y x)) 3)) should return (+)"
'(+)
(free-vars '(lambda (x) ((lambda (y) (+ y x)) 3))))
(test-end)次。bound-vars ですが、この書き換えは簡単なはず。冗長なので差分のみ。
(define (bound-vars l)
;; ry
(let ((ret (free-symbol arg (car body))))
(f (if (null? ret)
rslt
(append rslt (list (car body))))
arg (cdr body)))))
)
)で、以下な試験を既存に追加。
(test* "(bound-vars '(lambda (y) ((lambda (x) x) y)) should return (x y)"
'(x y)
(bound-vars '(lambda (y) ((lambda (x) x) y))))
(test* "(bound-vars '(lambda (y) ((lambda (x) (+ z x)) y)) should return (x y)"
'(x y)
(bound-vars '(lambda (y) ((lambda (x) (+ z x)) y))))
(test* "(bound-vars '(lambda (x) ((lambda (y) (+ y x)) 3)) should return (y x)"
'(y x)
(bound-vars '(lambda (x) ((lambda (y) (+ y x)) 3))))試験パス。
$ cat test.log Testing bound-vars ============================================================ <bound-vars>------------------------------------------------------------------- test (bound-vars '(lambda (x) y)) should return (), expects () ==> ok test (bound-vars '(lambda (x) (y))) should return (), expects () ==> ok test (bound-vars '(lambda (x y) (x 1 2) ((y) 3 z)) should return (x y), expects (x y) ==> ok test (bound-vars '(lambda (x) (x))) should return (x), expects (x) ==> ok test (bound-vars '(lambda (x) (x 1 2 3))) should return (x), expects (x) ==> ok test (bound-vars '(lambda (x) ()) should return (), expects () ==> ok test (bound-vars '(lambda () (x)) should return (), expects () ==> ok test (bound-vars '(lambda () ((x) (y))) should return (), expects () ==> ok test (bound-vars '(lambda (y) ((lambda (x) x) y)) should return (x y), expects (x y) ==> ok test (bound-vars '(lambda (y) ((lambda (x) (+ z x)) y)) should return (x y), expects (x y) ==> ok test (bound-vars '(lambda (x) ((lambda (y) (+ y x)) 3)) should return (y x), expects (y x) ==> ok passed. Testing free-vars ============================================================= <free-vars>-------------------------------------------------------------------- test (free-vars '(lambda (x) y)) should return (y), expects (y) ==> ok test (free-vars '(lambda (x) (y))) should return (y), expects (y) ==> ok test (free-vars '(lambda (x y) (x 1 2) ((y) 3 z)) should return (z), expects (z) ==> ok test (free-vars '(lambda (x) (x))) should return (), expects () ==> ok test (free-vars '(lambda (x) (x 1 2 3))) should return (), expects () ==> ok test (free-vars '(lambda (x) ()) should return (), expects () ==> ok test (free-vars '(lambda () (x)) should return (x), expects (x) ==> ok test (free-vars '(lambda () ((x) (y))) should return (x y), expects (x y) ==> ok test (free-vars '(lambda (y) ((lambda (x) x) y)) should return (), expects () ==> ok test (free-vars '(lambda (y) ((lambda (x) (+ z x)) y)) should return (+ z), expects (+ z) ==> ok test (free-vars '(lambda (x) ((lambda (y) (+ y x)) 3)) should return (+), expects (+) ==> ok passed. $
ごろごろしつつ、続きを検討予定。
