EoPL reading (42) 1.3.1 Free and Bound Variables
Exercise.1-32
帰宅中に map 使えるんじゃね?、とゆーコトに気づきかけましたがそんな単純な話では無さげ、という事に帰宅後気づく。
でも
(if (eqv? (car l) ':)
(let f ((d 0) (dict dict))
(cond ((null? dict) (cont #f))
((eq? (cadr l) d)
(let f-inner ((p 0) (dict (car dict)))
(cond ((null? dict) (cont #f))
((eq? (caddr l) p) (car dict))
(else
(f-inner (+ p 1) (cdr dict))))))
(else
(f (+ d 1) (cdr dict)))))なあたり、もう少し上手に (というかいいカンジに) 書けないかなぁ。手続き戻す手続きで抽象化云々って再帰な繰り返し使ってるあたりがナニ。
Exercise.1-33
ええと、意図としては以下と見て良いのでしょうか。
(use gauche.test)
(add-load-path ".")
(load "check-redeclaration"
(test-start "check-redeclaration"
(test-section "check-redeclaration"
(test* "(redeclaration? '(lambda (a) (lambda (a) a))) should return #t"
#t
(redeclaration? '(lambda (a) (lambda (a) a))))
(test-end)lambda が出てくる度に cadr なリストとそれまでの引数リストと比べて重複したのがあればその時点でダウト、ですか。面倒なのでまた call/cc 使ってしまえ。あら? 使わなくても良いのかな。
ってか、(a b c) なリストと ((x y z) (o p q)) なリストの要素に重複したシンボルがあるかどうかをチェックする手続きが作れれば一発なのか。
最近横着になっちゃって gauche で何か無いのか、と思いつつも探せない。とりあえず内部手続きとして以下を定義。
(define (check-redec l1 l2)
(if (null? l1)
#f
(let check-redec-inner ((item (car l1)) (list (car l2)))
(cond ((null? list) (check-redec (cdr l1) l2))
((memq item list) #t)
(else
(check-redec-inner item (cdr list))))))
)11 なリストの要素が l2 なリストのリストの要素とカブッてたら #t を戻す形。
gosh> (define l '((a b c) (d f))) l gosh> (check-redec '(x) l) #f gosh> (check-redec '(a) l) #t gosh>
で、以下をナニして試験したらパスしない。
(define (redeclaration? l)
(define (check-redec l1 l2)
(cond ((null? l2) #f)
((null? l1) #f)
(else
(let check-redec-inner ((item (car l1)) (list (car l2)))
(cond ((null? list) (check-redec (cdr l1) l2))
((memq item list) #t)
(else
(check-redec-inner item (cdr list)))))))
)
(define (redec-inner dict l)
(cond ((null? l) #t)
((eq? (car l) 'lambda)
(if (check-redec (cadr l) dict)
#f
(redec-inner (cons (cadr l) dict)
(cddr l))))
(else
(or (and (pair? (car l))
(redec-inner dict (car l)))
(redec-inner dict (cdr l))))))
(redec-inner '() l)
)出力は以下。
$ make Testing check-redeclaration ... failed. discrepancies found. Errors are: test (redeclaration? '(lambda (a) (lambda (a) a))) should return #t: expects #t => got #<error "pair required, but got ()">
むむ、と言いつつ手続きをニラんで以下に修正 (check-redec のみ)。
(define (check-redec l1 l2)
(cond ((null? l2) #f)
((null? l1) #f)
(else
(let check-redec-inner ((item (car l1)) (list (car l2)))
(cond ((null? list) (check-redec (cdr l1) l2))
((memq item list) #t)
(else
(check-redec-inner item (cdr l2)))))))
)凄いケアレスなナニ。やれやれ、と思いつつ以下な試験を追加すると
(test* "(redeclaration? '(lambda (a b c) (lambda (d e f) a))) should return #f"
#f
(redeclaration? '(lambda (a b c) (lambda (d e f) a))))パスしない。あら?
と思ったらリストの終端に来たら #f 戻すのか。なんかぼろぼろだな。現時点で試験してるのが以下。
(use gauche.test)
(add-load-path ".")
(load "check-redeclaration")
(test-start "check-redeclaration")
(test-section "check-redeclaration")
(test* "(redeclaration? '()) should return #f"
#f
(redeclaration? '()))
(test* "(redeclaration? '(lambda (a) (lambda (a) a))) should return #t"
#t
(redeclaration? '(lambda (a) (lambda (a) a))))
(test* "(redeclaration? '(lambda (a b c) (lambda (d e f) a))) should return #f"
#f
(redeclaration? '(lambda (a b c) (lambda (d e f) a))))
(test-end)実装が以下。
(define (redeclaration? l)
(define (check-redec l1 l2)
(cond ((null? l2) #f)
((null? l1) #f)
(else
(let check-redec-inner ((item (car l1)) (list (car l2)))
(cond ((null? list) (check-redec (cdr l1) l2))
((memq item list) #t)
(else
(check-redec-inner item (cdr l2)))))))
)
(define (redec-inner dict l)
(cond ((null? l) #f)
((eq? (car l) 'lambda)
(if (check-redec (cadr l) dict)
#t
(redec-inner (cons (cadr l) dict)
(cddr l))))
(else
(or (and (pair? (car l))
(redec-inner dict (car l)))
(redec-inner dict (cdr l))))))
(redec-inner '() l)
)一応試験にはパスしてます。こんなのも試験に追加。
(test* "(redeclaration? '(lambda (a b c) (lambda (d e a) a))) should return #t"
#t
(redeclaration? '(lambda (a b c) (lambda (d e a) a))))パスしてます。余裕があれば試験追加かも。
