“LETREC + CALL/CC = SET! even in a limited setting” とは？

“L.i.S.P”より (C. Queinnec’s L.i.S.P book and code — https://pages.lip6.fr/Christian.Queinnec/WWW/LiSP.html) 第３章の問題、の元ネタ。

LETREC + CALL/CC = SET! even in a limited setting — https://groups.google.com/d/msg/comp.lang.scheme/cxbti-YRs7U/gDGTpkpROgYJ を読み解いてみたいと思います。

シンプルな一番下から。

(define (test)
  (letrec ((x (call-with-current-continuation
                (lambda (c)
                  (list #T c)))))
    (if (car x)
      ((cadr x) (list #F (lambda () x)))
      (eq? x ((cadr x))))))

letrec で評価される c には letrec を待ち構えている継続が束縛されています。さてこれを呼び出した時に、 x の束縛はどうなっているのか？特に、 (lambda () x) で捕捉したものは？というのがポイントだと考えられます。 letrec の場合、結果 #t になります。

まず、 letrec の所がもし let だったら何が起こるかを確認します。

(let ((x (call/cc
           (lambda (c)
             (list #T c)))))
  (if (car x)
    ((cadr x) (list #F (lambda () x)))
    (eq? x ((cadr x)))))
;; 継続 #0#
;; PRINT-THEN-REPL は省略します
(lambda (a)
  (let ((x a))
    (if (car x)
      ((cadr x) (list #F (lambda () x)))
      (eq? x ((cadr x))))))
;; 評価
(let ((x '(#T #0#)))
  (if (car x)
    _((cadr x) (list #F (lambda () x)))_
    (eq? x (cadr x))))
;; 評価 継続 #0# 呼び出し
_(#0# (list #F (lambda () x)))_
;; 評価 継続 (#0# (list ...))
((lambda (a)
   (let ((x a))
     (if (car x)
       ((cadr x) (list #F (lambda () x)))
       (eq? x ((cadr x))))))
 (list #F (lambda () x))) ;; ここで、 x は #0# で見えていた束縛

継続 #0# へ渡されるリストの無名関数内の x は、継続 #0# で見えていた束縛です。一方、 (#0# ...) の評価の最初で、 (let ((x a)) ...) で新たな束縛が導入されるので、この二つを eq? すると、 #f となります。これはわかります。

では本題、 letrec の場合。 letrec が let と set! で実現されているとしたらば、と考えてみます。

(letrec ((x (call/cc
              (lambda (c)
                (list #T c)))))
  (if (car x)
    ((cadr x) (list #F (lambda () x)))
    (eq? x ((cadr x)))))
;; letrec を set! で表現しようとしてみます。
(let ((x #f))
  (let ((xtmp (call/cc
                (lambda (c)
                  (list #T c)))))
    (set! x xtmp)
    (if (car x)
      ((cadr x) (list #F (lambda () x)))
      (eq? x ((cadr x))))))
;; 継続 #0#
(let ((x #f)) ;; こんな具合に let ((x #f)) は終わっていると考えられます、
              ;; 言い替えると、継続に含まれていない、と。
  (lambda (a)
    (let ((xtmp a))
      (set! x xtmp)
      (if (car x)
        ((cadr x) (list #F (lambda () x)))
        (eq? x ((cadr x)))))))
;;
(let ((x #f))
  (let ((xtmp '(#T #0#)))
    (set! x xtmp)
    (if (car x)
      _((cadr x) (list #F (lambda () x))_)
      (eq? x ((cadr x))))))
;; 評価 継続 #0# 呼び出し
_(#0# (list #F (lambda () x)))_
;; 評価 継続
;; x の束縛は eq? => #t なものを見ている。
((lambda (a)
   (let ((xtmp a))
     (set! x xtmp)
     (if (car x)
       ((cadr x) (list #F (lambda () x)))
       (eq? x ((cadr x))))))
 (list (#F (lambda () x))))

継続 #0# 評価中でも x の束縛は eq? ⇒ #t となります。言い替えると x の束縛は継続の評価中に作られるわけではなく、というのが透けて見えます。

次はメールの二番目の例の make-cell 。 'set で呼ぶと、一旦無名関数を返す、というのが興味深いです。無名関数の呼び出しを待ち構えている継続が、最後に呼び出される、と。

(let ()
  (define (make-cell initial-value)
    (letrec ((state (call-with-current-continuation
                      (lambda (return-new-state)
                        (list initial-value return-new-state #F)))))
      (if (caddr state)
        ((caddr state) 'done)
        (lambda (op)
          (case op
            ((get) (car state))
            ((set)
             (lambda (new-value)
               (call-with-current-continuation
                 (lambda (return-from-set)
                   ((cadr state)
                    (list new-value (cadr state) return-from-set)))))))))))

  (let ((cell (make-cell 44))
        (set #f))
    (values
     cell
     (cell 'get)
     (begin (set! set (cell 'set)) set)
     (set 33)
     (cell 'get))))
;;=>#<closure (make-cell op)>, 44, #<closure ((make-cell make-cell) new-value)>, done, 33

練習として、無名関数を返さないバージョンを考えてみます。

(let ()
  (define (make-cell value)
    (letrec ((state (call/cc (lambda (store) (list value store #f)))))
      (if (caddr state)
        ((caddr state) 'done)
        (lambda (op . args)
          (case op
            ((get) (car state))
            ((set) (call/cc
                     (lambda (caller)
                       (let1 store (cadr state)
                         (store (list (car args) store caller)))))))))))

  (let1 cell (make-cell 44)
    (values
     cell
     (cell 'get)
     (cell 'set 33)
     (cell 'get))))
;;=> #<closure (make-cell op . args)>, 44, done, 33

store を呼んで、そのまま caller を呼んでもらう形です。

最後、“L.i.S.P”の問題に出てくるものの写経。

(let ()
  (define (make-box value)
    (let ((box
           (call/cc
             (lambda (exit)
               (letrec
                   ((behavior
                     (call/cc
                       (lambda (store)
                         (exit (lambda (msg . new)
                                 (call/cc
                                   (lambda (caller)
                                     (case msg
                                       ((get) (store (cons (car behavior)
                                                           caller)))
                                       ((set) (store (cons (car new)
                                                           caller))))))))))))
                 ((cdr behavior) (car behavior)))))))
      (box 'set value)
      box))

  (let1 box1 (make-box 33)
    (values
     box1
     (box1 'get)
     (box1 'set 44)
     (box1 'get))))
;;=> #<closure ((#f #f #f) msg . new)>, 33, 44, 44

あらためて、こうやって比較して眺めてみると、 letrec の EXPR 部分に VAR が出て来ないもの（上の方の例）は、確かに不自然です。動かすにはそうする必要があるのだけれども。