EoPL reading (41) 1.3.1 Free and Bound Variables

Exercise.1-32

(test* "(un-lexical-address '(lambda (a) (: 0 1)))
        should return #f"
       #f
       (un-lexical-address '(lambda (a) (: 0 1))))

な試験を書いて make してみたらパスしない。とりあえず call/cc 使うべ、と言いつつ手続きに盛り込んだのですがそれでも NG。
ぢつは元々の処理の以下の部分

	  (else
	   (if (eqv? (car l) ':)
	       (let f ((d 0) (dict dict))
		 (cond ((null? dict) #f)
		       ((eq? (cadr l) d)
			(let f-inner ((p 0) (dict (car dict)))
			  (if (eq? (caddr l) p)
			      (car dict)
			      (f-inner (+ p 1) (cdr dict)))))
		       (else
			(f (+ d 1) (cdr dict)))))

の f-inner な内部手続き (というかループ) の条件分岐に null? な判断が無かったのが原因でした。やはりヌケがあったか。
以下の試験

(use gauche.test)

(add-load-path ".")
(load "un-lexical-address")

(test-start "un-lexical-address")
(test-section "un-lexical-address")

(test* "(un-lexical-address '(lambda (a) (: 0 0)))
        should return (lambda (a) a)"
       '(lambda (a) a)
       (un-lexical-address '(lambda (a) (: 0 0))))

(test* "(un-lexical-address '(lambda (a) (: 0 1)))
        should return #f"
       #f
       (un-lexical-address '(lambda (a) (: 0 1))))

(test* "(un-lexical-address '(lambda (a) (: 1 0)))
        should return #f"
       #f
       (un-lexical-address '(lambda (a) (: 1 0))))

(test* "(un-lexical-address '(lambda (a)
                               (lambda (b c)
                                 ((: 1 0) (: 0 0) (: 0 1)))))
         should return (lambda (a) (lambda (b c) (a b c)))"
       '(lambda (a) (lambda (b c) (a b c)))
       (un-lexical-address '(lambda (a)
                               (lambda (b c)
                                 ((: 1 0) (: 0 0) (: 0 1))))))

(test-end)

に一応パスしている実装が以下です。

(define (un-lexical-address exp)
  (call/cc
   (lambda (cont)
     (letrec ((un-lexical-address-inner
               (lambda (rslt dict l)
                 (cond ((null? l) rslt)
                       ((eqv? (car l) 'lambda)
                        (un-lexical-address-inner (append rslt `(lambda ,(cadr l)))
                                                  (cons (cadr l) dict) (cddr l)))
                       (else
                        (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)))))
                            (let g ((rslt rslt) (l l))
                              (if (null? l)
                                  rslt
                                  (g (append rslt (list (un-lexical-address-inner '()
                                                                                  dict
                                                                                  (car l))))
                                     (cdr l))))
                            )
                        )))))
       (un-lexical-address-inner '() '() exp)))))

微妙に横に長いんですが、ご容赦をば。