traverse puzzle とは？

限定継続 (delimited continuation) の動作を理解する - 映画は中劇 — http://d.hatena.ne.jp/miyakawa_taku/20170323/1490281499

こちらで触れられている “Olivier Danvy’s puzzle” なのですけれども、なぜそうなるのか全くわからない。

元ネタとして挙げられているコードはこちら。 Continuations and delimited control, How to remove a dynamic prompt: static and dynamic delimited continuation operators are equally expressible — http://okmij.org/ftp/continuations/#impromptu-shift

;; racket
(require racket/control)

(let ()
  (define (traverse xs)
    (define (visit xs)
      (if (null? xs)
        '()
        (visit (shift k (cons (car xs) (k (cdr xs)))))))

    (reset (visit xs)))

  (traverse '(a b c)))
;;=> '(a b c)

(let ()
 (define (traverse xs)
   (define (visit xs)
     (if (null? xs)
       '()
       (visit (control k (cons (car xs) (k (cdr xs)))))))

   (prompt (visit xs)))

 (traverse '(a b c)))
;;=> '(c b a)

参照している方にも当ります。こちら。 Shift to control (PDF) — http://homes.soic.indiana.edu/ccshan/recur/recur.pdf

これらを見るとようやく、何がわからなかったのか、というのが把握できました。そもそも reset/shift と prompt/control はどういうもので何が違うのかを全く理解していなかった、というオチでした。限定継続オペレータを俯瞰できるので、それぞれどんな違いがあるのかを一望できます。（レポートのリファレンスを更に辿るのも良い）

というわけで、一歩一歩トレースしてみます。

shift や control が来たら、継続を関数で表現しようとしてみて、続くフォームの評価をどんな継続へ渡してゆくのかを考えてゆく、ということにしました。

まずは、 reset/shift について。

(reset (shift k (cons 1 (k #f)))
       (shift k (cons 2 (k #f)))
       '())
;; 評価
(reset _(shift k (cons 1 (k #f)))_
       (shift k (cons 2 (k #f)))
       '())
;; 継続 #0#
(lambda (x)
  ((lambda (v)
     ;; shift は reset を付ける #0#
     (reset v))
   ((lambda (v)
      v
      (shift k (cons 2 (k #f)))
      '())
    x)))
;; 評価 shift の継続
((lambda (v)
   (reset v))
 _(cons 1 (#0# #f))_)
;; 評価
((lambda (v)
   (reset v))
 ((lambda (v)
    (cons 1 v))
  _(#0# #f)_))
;; 評価 #0# 展開
((lambda (v)
   (reset v))
 ((lambda (v)
    (cons 1 v))
  _((lambda (x)
      ((lambda (v)
         ;; shift は reset を付ける #0#
         (reset v))
       ((lambda (v)
          v
          (shift k (cons 2 (k #f)))
          '())
        x)))
    #f)_))
;; 評価
((lambda (v)
   (reset v))
 ((lambda (v)
    (cons 1 v))
  ((lambda (v)
     ;; shift は reset を付ける #0#
     (reset v))
   ((lambda (v)
      v
      _(shift k (cons 2 (k #f)))_
      '())
    #f))))
;; 継続 #1#
(lambda (x)
  ((lambda (v)
     ;; shift は reset を付ける #1#
     (reset v))
   ((lambda (v)
      v
      '())
    x)))
;; 評価 shift の継続
((lambda (v)
   (reset v))
 ((lambda (v)
    (cons 1 v))
  ((lambda (v)
     ;; shift は reset を付ける #0#
     (reset v))
   _(cons 2 (#1# #f))_)))
;; 評価
((lambda (v)
   (reset v))
 ((lambda (v)
    (cons 1 v))
  ((lambda (v)
     ;; shift は reset を付ける #0#
     (reset v))
   ((lambda (v)
      (cons 2 v))
    _(#1# #f)_))))
;; 評価 #1# 展開
((lambda (v)
   (reset v))
 ((lambda (v)
    (cons 1 v))
  ((lambda (v)
     ;; shift は reset を付ける #0#
     (reset v))
   ((lambda (v)
      (cons 2 v))
    _((lambda (x)
        ((lambda (v)
           ;; shift は reset を付ける #1#
           (reset v))
         ((lambda (v)
            v
            '())
          x)))
      #f)_))))
;; 評価
((lambda (v)
   (reset v))
 ((lambda (v)
    (cons 1 v))
  ((lambda (v)
     ;; shift は reset を付ける #0#
     (reset v))
   ((lambda (v)
      (cons 2 v))
    ((lambda (v)
       ;; shift は reset を付ける #1#
       (reset v))
     ((lambda (v)
        v
        '())
      #f))))))
;;=> '(1 2)

次に、 prompt/control について。

(prompt (control k (cons 1 (k #f)))
        (control k (cons 2 (k #f)))
        '())
;; 評価
(prompt _(control k (cons 1 (k #f))_)
        (control k (cons 2 (k #f)))
        '())
;; 継続 #0#
(lambda (x)
  ((lambda (v)
     ;; control は prompt を付けない #0#
     v
     (control k (cons 2 (k #f)))
     '())
   x))
;; 評価 control の継続
((lambda (v)
   (prompt v))
 _(cons 1 (#0# #f))_)
;; 評価
((lambda (v)
   (prompt v))
 ((lambda (v)
    (cons 1 v))
  _(#0# #f)_))
;; 評価 #0# 展開
((lambda (v)
   (prompt v))
 ((lambda (v)
    (cons 1 v))
  _((lambda (x)
      ((lambda (v)
         ;; control は prompt を付けない #0#
         v
         (control k (cons 2 (k #f)))
         '())
       x))
    #f)_))
;; 評価
((lambda (v)
   (prompt v))
 ((lambda (v)
    (cons 1 v))
  ((lambda (v)
     ;; control は prompt を付けない #0#
     v
     _(control k (cons 2 (k #f)))_
     '())
   #f)))
;; 継続 #1#
(lambda (x)
  ;; control は prompt を付けない #1#
  ((lambda (v)
     (cons 1 v))
   ((lambda (v)
      v
      '())
    x)))
;; 評価 control の継続
((lambda (v)
   (prompt v))
 _(cons 2 (#1# #f))_)
;; 評価
((lambda (v)
   (prompt v))
 ((lambda (v)
    (cons 2 v))
  _(#1# #f)_))
;; 継続 #1# 展開
((lambda (v)
   (prompt v))
 ((lambda (v)
    (cons 2 v))
  _((lambda (x)
      ;; control は prompt を付けない #1#
      ((lambda (v)
         (cons 1 v))
       ((lambda (v)
          v
          '())
        x)))
    #f)_))
;; 評価
((lambda (v)
   (prompt v))
 ((lambda (v)
    (cons 2 v))
  ((lambda (v)
     (cons 1 v))
   ((lambda (v)
      v
      '())
    #f))))
;;=> '(2 1)

このように、 shift では reset を付けるので、この調子で継続を表現しようとしていくと、関数がどんどん深くなっていきます。これに対して control では prompt を付けないので、継続を表す関数はその都度再計算されます（いや、継続は、その都度計算される、というのは共通しているので、表現が何かおかしいのだけれども（ prompt までの継続が毎度 k に束縛されるので当然なのだけれども））。

字面が継続渡し形式に似ているのに気付いた。ので、まとめてみます。(継続渡し形式についてのメモはこちら直観に反する？ — https://t.laafc.net/2018/04/19/counterintuitivep.html)

(require racket/control
         srfi/1)

(let ()
  (define (dup xs)
    (fold-right cons '() xs))
  (define (rev xs)
    (fold cons '() xs))

  (define (dup-k xs)
    (define (recur xs k)
      (if (null? xs)
        (k '())
        (recur (cdr xs) (lambda (r) (k (cons (car xs) r))))))

    (recur xs values))
  (define (rev-k xs)
    (define (recur xs k)
      (if (null? xs)
        (k '())
        (recur (cdr xs) (lambda (r) (cons (car xs) (k r))))))

    (recur xs values))

  (define (dup-c xs)
    (define (visit xs)
      (if (null? xs)
        '()
        (visit (shift k (cons (car xs) (k (cdr xs)))))))

    (reset (visit xs)))
  (define (rev-c xs)
    (define (visit xs)
      (if (null? xs)
        '()
        (visit (control k (cons (car xs) (k (cdr xs)))))))

    (prompt (visit xs)))

  (let* ((xs '(a b c))
         (ys (reverse xs)))
    (values
     (list= equal? xs (dup xs) (dup-k xs) (dup-c xs))
     (list= equal? ys (rev xs) (rev-k xs) (rev-c xs)))))
;;=> #t, #t