手続きによるパターンの抽象化

9章3節。
id:yagiey:20090309:1236597268の最後で挙げた3つの手続きは、以下の共通部分を持つ。

(lambda (elt lis . optionals)
  (let-optionals* optionals ((cmp-fn equal?))
    (define loop
      (lmabda (lis)
        (cond
         ((null? lis) ○○)
         ((cmp-fn elt (△△ lis)) (□□ lis))
         (else ☆☆))))
    (loop lis)))

違うのは○○、△△、、□□、☆☆の箇所だけ。
じゃあ○○、△△、□□、☆☆を引数で受け取って、手続きを返せば良くね？と。
そうすれば何度も同じソースコード書かなくて済むじゃん！みたいな。
ってことで、○○をfallback、△△をget-key、□□をreturn、☆☆をrepeatと名付けて、my-memberやdelete-1やmy-assocみたいな手続きを返すtraverse手続きを書いてみよう、と。

(define traverse
  (lambda (fallback get-key return repeat)
    (lambda (elt lis . optionals)
      (let-optionals* optionals ((cmp-fn equal?))
        (define loop
          (lambda (lis)
            (cond
              ((null? lis) fallback)
              ((cmp-fn elt (get-key lis)) (return lis))
              (else (repeat loop lis)))))
        (loop lis)))))

ってな感じ。
repeatの部分は、loopを引数で受け取らないといけないので、単純に

(else ☆☆)

じゃないけど。
このtraverseを使えば、member、delete-1、my-assocは

(define my-member
  (traverse #f car (lambda (x) x) (lambda (loop lis) (loop (cdr lis)))))

(define delete-1
  (traverse '() car cdr (lambda (loop lis) (cons (car lis) (loop (cdr lis))))))
  
(define my-assoc
  (traverse #f (lambda (p) (car (car p))) car (lambda (loop lis) (loop (cdr lis)))))

ってできるね、ということらしい。
いいねーっ！楽チン。

本書ではtraverseでmember2を作る時に、returnにvalues手続きを渡しているのが不思議だった。
ってことで、valudesで返した多値をrecieveで受け取らなかったらどうなるか実験してみた。

gosh> (cdr (values '(foo bar) '(baz qux)))
(bar)

1つ目の値が使われるみたいだね。