EoPL reading (32) 1.3.1 Free and Bound Variables
自動で、なのかなぁ。逆にこれって変換が OK かどうかの試験すれば良いのか。
名前付き let はスルーの方向で。以下の手続きを追加して
(define (make-lambda parameters body)
(cons 'lambda (cons parameters body)))
(define (let->combination exp)
(append (list (make-lambda (map car (cadr exp)) (cddr exp)))
(map cadr (cadr exp))))
(define (let*->nested-let exp)
(define (let*->nested-let-iter arg)
(cond ((null? arg) (caddr exp))
(else
(list 'let (list (car arg)) (let*->nested-let-iter (cdr arg))))))
(let*->nested-let-iter (cadr exp)))条件分岐に以下を追加。
((eqv? (car exp) 'let)
(occurs-free? var (let->combination exp)))
((eqv? (car exp) 'let*)
(occurs-free? var (let*->nested-let exp)))とりあえず上記三つの手続きを試験すれば良いのか。まず、make-lambda からで以下。
(use gauche.test)
(add-load-path ".")
(load "occurs-free-bound")
(test-start "make-lambda")
(test-section "ut")
(test* "(make-lambda '(x y z) '((+ x y z))) should returns (lambda (x y z) (+ x y z))"
'(lambda (x y z) (+ x y z))
(make-lambda '(x y z) '((+ x y z))))
(test-end)list->combination な手続きの定義では make-lambda に cadr の mapcar と cddr を渡している。ので、上記のような形になっているはず。let-combination 手続きも名前付きを対象外にしているので試験は楽。勢いで let*->nested-let の試験も書いたので両方以下に。
まず let->combination の試験から。
(use gauche.test)
(add-load-path ".")
(load "occurs-free-bound")
(test-start "let->combination")
(test-section "ut")
(test* "(let->combination '(let ((x 0) (y 1) (z 2)) (+ x y z))) should return ((lambda (x y z) (+ x y z)) 0 1 2)"
'((lambda (x y z) (+ x y z)) 0 1 2)
(let->combination '(let ((x 0) (y 1) (z 2)) (+ x y z))))
(test-end)次が let*->nested-let の試験。
(use gauche.test)
(add-load-path ".")
(load "occurs-free-bound")
(test-start "let*->nested-let")
(test-section "ut")
(test* "(let*->nested-let '(let* ((x 0) (y (+ x 1)) (z (+ y 1))) (+ x y z))) should return (let ((x 0)) (let ((y (+ x 1))) (let ((z (+ y 1))) (+ x y z))))"
'(let ((x 0)) (let ((y (+ x 1))) (let ((z (+ y 1))) (+ x y z))))
(let*->nested-let '(let* ((x 0) (y (+ x 1)) (z (+ y 1))) (+ x y z))))
(test-end)両方パス。あとは本体に組み込んで試験か。追加が以下なんですが、変換が上手くいってれば大丈夫なはずなので試験は以下で OK かなぁ。
(test-section "ex.1-24")
(test* "(occurs-free? 'x '(let ((y 1)) ())) should return #f"
#f
(occurs-free? 'x '(let ((y 1)) ())))
(test* "(occurs-free? 'x '(let ((y 1)) x)) should return #t"
#t
(occurs-free? 'x '(let ((y 1)) x)))同様に occurs-bound? にも仕込む。
((eqv? (car exp) 'let)
(occurs-bound? var (let->combination exp)))
((eqv? (car exp) 'let*)
(occurs-bound? var (let*->nested-let exp)))で、試験も書く。以下。
(test-section "Exercise.1-24")
(test* "(occurs-bound? 'x '(let ((x 1)) (+ x 1))) should returns #t"
#t
(occurs-bound? 'x '(let ((x 1)) (+ x 1))))
(test* "(occurs-bound? 'x '(let ((y 2)) (+ x 1))) should returns #f"
#f
(occurs-bound? 'x '(let ((y 2)) (+ x 1))))試験が通らん。
$ make Testing let->combination ... passed. Testing let*->nested-let ... passed. Testing make-lambda ... passed. Testing occurs-bound ... failed. discrepancies found. Errors are: test (occurs-bound? 'x '(let ((x 1)) (+ x 1))) should returns #t: expects #t => got #<error "pair required, but got 1"> test (occurs-bound? 'x '(let ((y 2)) (+ x 1))) should returns #f: expects #f => got #<error "pair required, but got 1"> Testing occurs-free ... passed. $
あらら。self-evaluating? あたり? 以下な実装で試験パスしてます。
(define (make-lambda parameters body)
(cons 'lambda (cons parameters body)))
(define (let->combination exp)
(append (list (make-lambda (map car (cadr exp)) (cddr exp)))
(map cadr (cadr exp))))
(define (let*->nested-let exp)
(define (let*->nested-let-iter arg)
(cond ((null? arg) (caddr exp))
(else
(list 'let (list (car arg)) (let*->nested-let-iter (cdr arg))))))
(let*->nested-let-iter (cadr exp)))
(define (self-evaluating? s)
(or (number? s)
(string? s)
(eq? #t s)
(eq? #f s)))
(define occurs-free?
(lambda (var exp)
(cond
((null? exp) #f)
((self-evaluating? exp) #f)
((symbol? exp) (eqv? exp var))
((eqv? (car exp) 'lambda)
(and (let f ((l (cadr exp)))
(cond ((null? l) #t)
((eqv? (car l) var) #f)
(else
(f (cdr l)))))
(occurs-free? var (cddr exp))))
((eqv? (car exp) 'if)
(or (occurs-free? var (cadr exp))
(occurs-free? var (cddr exp))))
((eqv? (car exp) 'let)
(occurs-free? var (let->combination exp)))
((eqv? (car exp) 'let*)
(occurs-free? var (let*->nested-let exp)))
(else
(or (occurs-free? var (car exp))
(occurs-free? var (cdr exp)))))))
(define occurs-bound?
(lambda (var exp)
(cond
((null? exp) #f)
((self-evaluating? exp) #f)
((symbol? exp) #f)
((eqv? (car exp) 'lambda)
(or (occurs-bound? var (cddr exp))
(and (let f ((l (cadr exp)))
(cond ((null? l) #f)
((eqv? (car l) var) #t)
(else
(f (cdr l)))))
(occurs-free? var (cddr exp)))))
((eqv? (car exp) 'if)
(or (occurs-bound? var (cadr exp))
(occurs-bound? var (cddr exp))))
((eqv? (car exp) 'let)
(occurs-bound? var (let->combination exp)))
((eqv? (car exp) 'let*)
(occurs-bound? var (let*->nested-let exp)))
(else
(or (occurs-bound? var (car exp))
(occurs-bound? var (cdr exp)))))))いやはや。occurs-bound? 方面に self-evaluating? な条件分岐を盛り込んでなかったのは違う意味で試験不足してないか? と思うんですが ...
# さっきまでは occurs-free? の内部手続きになってました
む
ナチュラルぶちカマシに気がついてます。
- occurs-bound? な試験に if の試験が入ってない
- let* 試験スルーしている
という事で検討開始。まず 1-23 な occurs bound な試験が以下。
(test-section "Exercise.1.23")
(test* "(occurs-bound? 'x '(if (= x 1) #t #f)) should return #f"
#f
(occurs-bound? 'x '(if (= x 1) #t #f)))
(test* "(occurs-bound? 'x '(if (= x 1) ((lambda (x) x) #t) #f)) should return #t"
#t
(occurs-bound? 'x '(if (= x 1) ((lambda (x) x) #t) #f)))
(test* "(occurs-bound? 'y '(if (= x 1) ((lambda (x) x) #t) #f)) should return #f"
#f
(occurs-bound? 'y '(if (= x 1) ((lambda (x) x) #t) #f)))
(test* "(occurs-bound? 'x '(lambda (x) (if (= x 1) #t #f))) should return #t"
#t
(occurs-bound? 'x '(lambda (x) (if (= x 1) #t #f))))
(test* "(occurs-bound? 'x '(lambda (x) (if (= y 1) #t #f))) should return #f"
#f
(occurs-bound? 'x '(lambda (x) (if (= y 1) #t #f))))
(test* "(occurs-bound? 'x '(lambda (y) (if (= x 1) #t #f))) should return #f"
#f
(occurs-bound? 'x '(lambda (y) (if (= x 1) #t #f))))
(test* "(occurs-bound? 'x '(lambda (y) (if (= y 1) #t #f))) should return #f"
#f
(occurs-bound? 'x '(lambda (y) (if (= y 1) #t #f))))あんま何も考えてないです。凄い機械的。機会的に 1-24 のナニも追加。
まず、occurs-bound? から
(test* "(occurs-bound? 'x '(let* ((x 1) (y (+ x 1))) (+ x y))) should return #t"
#t
(occurs-bound? 'x '(let* ((x 1) (y (+ x 1))) (+ x y))))
(test* "(occurs-bound? 'z '(let* ((x 1) (y (+ x 1))) (+ x y))) should return #f"
#f
(occurs-bound? 'z '(let* ((x 1) (y (+ x 1))) (+ x y))))occurs-free? はダウトを出して以下。
(test* "(occurs-free? 'x '(let* ((x 1) (y (+ x 1))) (+ x y))) should return #f"
#f
(occurs-free? 'x '(let* ((x 1) (y (+ x 1))) (+ x y))))
(test* "(occurs-free? 'z '(let* ((x 1) (y (+ x 1))) (+ x y))) should return #t"
#f
(occurs-free? 'z '(let* ((x 1) (y (+ x 1))) (+ x y))))
(test* "(occurs-free? 'z '(let* ((x 1) (y (+ x 1))) (+ x y z))) should return #t"
#t
(occurs-free? 'z '(let* ((x 1) (y (+ x 1))) (+ x y z))))以下は #t を戻すかと思ったんですがダウト。
(occurs-free? 'z '(let* ((x 1) (y (+ x 1))) (+ x y)))
こうなってれば #t が戻るのは
(test* "(occurs-free? 'z '(let* ((x 1) (y (+ x 1))) (+ x y z))) should return #t"
#t
(occurs-free? 'z '(let* ((x 1) (y (+ x 1))) (+ x y z))))以下の実装に依ります。
(define occurs-free?
(lambda (var exp)
(cond
((null? exp) #f)
((self-evaluating? exp) #f)
((symbol? exp) (eqv? exp var))随分理解はできたんですが、まだ直感的ではないです。
