パターンマッチみたいなことをするプログラム(schemeで)

http://d.hatena.ne.jp/tana-laevatein/20101111/1289483291
ちょっと面白そうだったのでやってみました。
matchという名前にするとutil.matchと名前が被ってしまうので@matchという名前にしました。*1

(define (@match xs ys)
  (let/cc break
    (define (collect xs ys init)
      (fold (lambda (x y r)
              (cond ((and (list? x) (list? y)) (collect x y r))
                    ((symbol? x) (acons x y r))
                    ((equal? x y) r)
                    (else (break #f))))
            init xs ys))
    (reverse (collect xs ys '()))))

(@match '(1 2 a) '(1 2 3)) ; => ((a . 3))
(@match '(1 (2 a) b (c d 3)) '(1 (2 1) 2 (3 4 3))) ; => ((a . 1) (b . 2) (c . 3) (d . 4))
(@match '(1 (2 a) b (c d 3)) '(1 3 2 (3 4 3))) ; => #f
(@match '(a b c)  '((1 (2) 3) (((4))) (5 6 7))) ; => ((a 1 (2) 3) (b ((4))) (c 5 6 7))

*1:useしなければ衝突はしないけれどミーム的な意味で何か嫌