dynamic-wind

Kent Dybvig さんの本に_dynamic-wind の実装_なコードがありました。
本を持ち歩けない、というか持ち歩いても読めないので件の実装手続きを以下に引用。

(define dynamic-wind #f)
(let ((winders '()))
  (define common-tail
    (lambda (x y)
      (let ((lx (length x)) (ly (length y)))
        (do ((x (if (> lx ly) (list-tail x (- lx ly)) x) (cdr x))
             (y (if (> ly lx) (list-tail y (- ly lx)) y) (cdr y)))
            ((eq? x y) x)))))
   (define do-wind
     (lambda (new)
       (let ((tail (common-tail new winders)))
         (let f ((l winders))
           (if (not (eq? l tail))
               (begin
                 (set! winders (cdr l))
                 ((cdar l))
                 (f (cdr l)))))
          (let f ((l new))
            (if (not (eq? l tail))
                (begin
                  (f (cdr l))
                  ((caar l))
                  (set! winders l)))))))
  (set! call/cc
    (let ((c call/cc))
      (lambda (f)
        (c (lambda (k)
             (f (let ((save winders))
                  (lambda (x)
                    (if (not (eq? save winders)) (do-wind save))
                    (k x)))))))))
  (set! call-with-current-continuation call/cc)
  (set! dynamic-wind
    (lambda (in body out)
      (in)
      (set! winders (cons (cons in out) winders))
      (let ((ans (body)))
        (set! winders (cdr winders))
        (out)
        ans))))

なんだこれは。ぢつは手で入力したんですが、意味不明。
明日、gauche で試験しつつ、手続き確認予定ッス。