L.i.S.P 写経(その1)、3章

L.i.S.P 3章のインタープリタで継続とは何かを考えます。まずは自分の頭の中を整理します。

(begin
  (display "Hello,")
  (display _(call/cc (lambda (k) (k " world") "Hi!"))_)
  (display "!")
  (newline))

いつも通りここで、 k に束縛される継続を関数で表現しようとしてみます。

(lambda (x)
  ((lambda (v)
     (PRINT-THEN-REPL v))
   ((lambda (v)
      (display v)
      (display "!")
      (newline))
    x)))

このような関数で表すことができると考えられます。ただ、この例で行くと、テキストで上の方の部分。

  ((lambda (v)
     (PRINT-THEN-REPL v))
   ((lambda (v)
      (display v)
...
...            )
...  ))

ここまでは納得できます。というのは、 call/cc を評価しようとする時には既に"見て"いるから、と考えるからです。

  ((lambda (v)
     (PRINT-THEN-REPL v))
   ((lambda (v)
      (display v)
      (display "!") ;; ここからは `k` が束縛された時には、まだ
      (newline))    ;; 見ていなかったように思える
    x))

わかっていないのはこのコメントで書いた部分です。まだ見ていなかったように思える式を、関数で表現しようとした時に書き下ろすことができてしまっている、これが納得できない、ということをもって、わからない、と考えています。今注目しているフォーム _(call/cc ...)_ の先にある式をなぜ書き下ろすことができるのか？という。

ここで、一歩引いて、 (begin ...) の方へ注目します。これは一つずつ式を次々に評価していくわけです。つまり、次の式を評価していく、という継続がそこにあるわけで、 _(call/cc ...)_ を待ち構えているのは (display ...) で、更に、次の式を評価していく継続が続く、と。言い替えると、このタイミングで既に見ていた。

こう考えると納得できます、また、継続とは必ずしも評価する式をそのまま書き下ろす、というような直接的な表現方法を使わなくても、同等のことを実現できそうな気もしてきます。

While the immediate goal is to evaluate the expression in the environment, the long term goal is to return a value to the continuation.

Quoting

式を評価してその結果の値を継続へ渡す、ということで、最もシンプルな例から。

(define (evaluate e r k)
...
  (if (atom? e)
    (cond ((symbol? e) (evaluate-variable e r k))
          (else ...))
...))

(define (evaluate-quote v r k)
  (resume k v))

もう一度書くと、式を評価して値が定まったら継続へ渡す。理に適っています。

最小で動かしたいので、試しに。

(define-class <testing-cont> (<continuation>) ())

(define-method resume ((k <testing-cont>) v)
  ((~ k 'k) v))

(evaluate '"100" #f (make <testing-cont> :k values))
;;=> "100"
(evaluate '100 #f (make <testing-cont> :k values))
;;=> 100

;; 何回も試したい気がするのでショートカット用に。
(define eval-testing (cut evaluate <> #f (make <testing-cont> :k values)))

(test* 'tiral
       '("100" 100 symbol-100)
       (list
        (eval-testing "100")
        (eval-testing '100)
        (eval-testing '(quote symbol-100))))

;; 更に短く。
(define-syntax is
  (syntax-rules ()
    ((_ e ...) (test* "`is'" e ...))))

(is '("100" 100 symbol-100)
    (list
     (eval-testing "100")
     (eval-testing '100)
     (eval-testing '(quote symbol-100))))
;;>> test `is', expects ("100" 100 symbol-100) ==> ok

Alteratives

if 式。 if 式を評価する、ということは、まず条件の式 (cadr e) を評価して、その値が定まったら、その値によって true 部か false 部の式で評価を続けていきます。条件部を再帰的に evaluate に渡し、その時に true/false 部をそのまま保持する継続を作っている、環境は if を評価しようとしているもの、継続も同様。言い替えると true/false 部を評価した結果の値は、 if 式そのものを待ち構えている継続に渡されるということ。なるほど。

(define (evaluate e r k)
...
    (case (car e)
...
      ((if) (evaluate-if (cadr e) (caddr e) (cadddr e) r k))
...
...                                                    ))

(defclass <if-cont> (<continuation>) et ef r)

(define (evaluate-if ec et ef r k)
  (evaluate ec r (make <if-cont> :k k :et et :ef ef :r r)))

(define-method resume ((k <if-cont>) v)
  (evaluate (if v (~ k 'et) (~ k 'ef)) (~ k 'r) (~ k 'k)))

動かしてみます、待ち構える継続オブジェクトを直接 make してみると継続に値が次々に渡されていく理解の助けになります。

(is 'te (eval-testing '(if #t 'te 'ef)))

(is 'ef (eval-testing '(if (if #t #f #f) 'te 'ef)))
(is 'ef (resume (make <if-cont>
                  :et ''te :ef ''ef :r #f
                  :k (make <testing-cont> :k values))
                #f))

(is 'ef
    (eval-testing '(if (if #t #f #f) (if #t 'te #t) (if #t 'ef #t))))
(is 'ef
     (let* ((k0 (make <testing-cont> :k values))
            (k1 (make <if-cont>
                  :k k0 :et '(if 'te #t) :ef '(if #t 'ef #t) :r #f))
            (k2 (make <if-cont>
                  :k k1 :et #f :ef #f :r #f)))
       (resume k2
               ;; この下の部分が最初の (if _#t_ #f #f) に対応します。
               ;; evaluate-quote が
               (resume k2 #t)
               )))

evaluate と resume それぞれが呼び出し会う格好です。前章までの evaluate だけを再帰的に呼び出すインタープリタと違って、どこへ処理を続けていくか、ということを制御できる余地がありそうな所が、大きく違うところでしょうか。

Sequence

順次評価です、値が定まることがあるのが注意点。

(define (evaluate e r k)
...
    (case (car e)
...
      ((begin) (evaluate-begin (cdr e) r k))
...
...                                                     ))

(defclass <begin-cont> (<continuation>) e* r k)

(define (evaluate-begin e* r k)
  (if (pair? e*)
    (if (pair? (cdr e*))
      (evaluate (car e*) r (make <begin-cont> :e* e* :r r :k k))
      (evaluate (car e*) r k))
    (resume k +empty-begin-value+)))

(define-method resume ((k <begin-cont>) _v)
  (evaluate-begin (cdr (~ k 'e*)) (~ k 'r) (~ k 'k)))

(is +empty-begin-value+ (eval-testing '(begin)))
(is 'symbol-begin (eval-testing '(begin 'symbol-begin)))
(is 'symbol-begin
    ;; 途中が評価されているかは resume に #?=_v する？
    (eval-testing '(begin (begin 'a 'b) 'symbol-begin)))

begin-cont の resume では、 begin を評価中なので、 evaluate ではなく evaluate-begin を呼び出しています。

Variable Environment

<full-env> はスロットだけ定義されているクラスなのだろうと考えられます。（メソッドを定義する意味が良くわからない。）インスタンスを作られないことにするという方法がありそうだけれど。

Functions

関数について。

<apply-cont> を作った後 evaluate-arguments を経由して <apply-cont> が resume する、という所で迷子になったので復習します。

(define (evaluate-application e e* r k)
  (evaluate e r (make <evfun-cont> :e* e* :r r :k k)))

(define-method resume ((k <evfun-cont>) f)
  (evaluate-arguments (~ k 'e*)
                      (~ k 'r)
                      (make <apply-cont> :f f :r (~ k 'r) :k (~ k 'k))))

(define (evaluate-arguments e* r k)
  (if (pair? e*)
    (evaluate (car e*) r (make <argument-cont> :e* e* :r r :k k))
    (resume k '())))

(define-method resume ((k <argument-cont>) v)
  (evaluate-arguments (cdr (~ k 'e*))
                      (~ k 'r)
                      (make <gather-cont> :k (~ k 'k) :v v)))

(define-method resume ((k <gather-cont>) v*)
  (resume (~ k 'k) (cons (~ k 'v) v*)))

(define-method resume ((k <apply-cont>) v*)
  (invoke (~ k 'f) v* (~ k 'r) (~ k 'k)))
(is 'a
    (evaluate-application
     '(lambda (a b) 'a)
     '('a 'b)
     (make <null-env>)
     (make <testing-cont> :k values)))

;; evaluate-arguments: '(a b) <apply>
;; evaluate: 'a <argument> '(a b) <apply>
;; resume <argument> 'a:
;; evaluate-arguments: '(b) <gather> 'a <apply>
;; evaluate: 'b <argument> '(b) <gather> 'a <apply>
;; resume <argument> 'b:
;; evaluate-arguments: '() <gather> 'b <gather> 'a <apply>
;; resume <gather> '():
;; (cons 'b '()) <gather> 'a <apply>
;; (cons 'a (b)) <apply>
;; invoke <apply> '(a b)

<argument-cont> が resume すると、再帰的に evaluate-argument を呼び出します。ただ、 <argument-cont> ではなく <gather-cont> に入れ替えた形になり、この <gather-cont> を次に待ち構える継続にして <argument-cont> を作って評価します。（この段落の最初に戻る）そして、最終的に、 <gather-cont> を待ち構える継続 <apply-cont> に評価された引数が渡される、と。

call/cc

本題。 call/cc 関数は、 <primitive> として定義します、渡された関数を、 k を引数に呼び出します。すごい、そのまんまです。更に、継続オブジェクトは呼び出すことができるので、 invoke に反応するようにします。

(definitial call/cc
  (make <primitive>
    :name 'call/cc
    :address (lambda (v* r k)
               (if (= (length v*) 1)
                 (invoke (car v*) (list k) r k)
                 (wrong "Incorrect arity" 'call/cc v*)))))

(define-method invoke ((f <continuation>) v* r k)
  (if (= (length v*) 1)
    (resume f (car v*))
    (wrong "Continuations expect one argument" v* r k)))

(is "Hello, world!\n"
    (with-output-to-string
      (lambda ()
        (eval~ '(begin
                  (display "Hello,")
                  (display (call/cc (lambda (k) (k " world") "Hi!")))
                  (display "!")
                  (newline))))))

(definitial k #f)

(is '((car . cdr) (car . cdr))
    (begin
      (eval~ '(begin (set! k (cons 'car (call/cc call/cc))) k))
      (list
       (eval~ '((cdr k) 'cdr))
       (eval~ 'k))))

継続を陽に作るインタープリタでは、このようにどこを取っても resume で切り出して呼び出すことができる、というのを確認しました。評価する時に、待ち受ける継続を作り評価した値を継続に渡していく、というのを再帰的に行っていくことで、計算が進んでいきます。

継続オブジェクトが評価する部分式そのものを保持しているので、書き下ろすということに近いと感じられます。一方、部分式そのものを持っているナイーブな実装であると言うことができます。

(select-module user)

(define-module t.LiSP.chapter3f.stuff
  (use gauche.interactive :prefix gosh:)
  (use srfi-13))
(select-module t.LiSP.chapter3f.stuff)

(define-values (eval~ <bottom-cont>)
  (with-module t.LiSP.chapter3f (values eval~ <bottom-cont>)))

;; (definitial k #f) しています

(let1 k (begin
          (eval~ '(begin
                    (display "Hello,")
                    ((lambda (_ v)
                       (display v))
                     'dummy-arg
                     (call/cc
                       (lambda (kk)
                         (set! k kk)
                         (kk " world")
                         "Hi!")))
                    (display "!")
                    (newline)))
          (eval~ 'k))
  (for-each
   (let1 level 0
     (lambda (k)
       (with-input-from-string (with-output-to-string (cut gosh:d k))
         (lambda ()
           (let loop ((line (read-line)))
             (unless (eof-object? line)
               (dotimes (level) (display " "))
               (print (if (> (string-length line) #0=(- 66 level))
                        (string-take line #0#)
                        line))
               (loop (read-line))))))
       (update! level (pa$ + 2))))
   (let recur ((k k)
               (c values))
     (if (is-a? k <bottom-cont>)
       (cons k (c '()))
       (recur (~ k 'k) (lambda (r) (cons k (c r))))))))
;;>> Hello, world!
;;>> #<<bottom-cont> 0x2e594f0> is an instance of class <bottom-cont>
;;>> slots:
;;>>   f         : #<subr (values :rest args)>
;;>>   k         : #<unbound>
;;>>   #<<begin-cont> 0x2e78a90> is an instance of class <begin-cont>
;;>>   slots:
;;>>     e*        : (((lambda (_ v) (display v)) 'dummy-arg (call/cc (
;;>>     r         : #<<variable-env> 0x3903890>
;;>>     k         : #<<bottom-cont> 0x2e594f0>
;;>>     #<<apply-cont> 0x2e7aa40> is an instance of class <apply-cont>
;;>>     slots:
;;>>       f         : #<<function> 0x2e78270>
;;>>       r         : #<<variable-env> 0x3903890>
;;>>       k         : #<<begin-cont> 0x2e78a90>
;;>>       #<<gather-cont> 0x2e7a2c0> is an instance of class <gather-c
;;>>       slots:
;;>>         v         : dummy-arg
;;>>         k         : #<<apply-cont> 0x2e7aa40>
;;>>         #<<argument-cont> 0x2e7cfc0> is an instance of class <argu
;;>>         slots:
;;>>           e*        : ((call/cc (lambda (kk) (set! k kk) (kk " wor
;;>>           r         : #<<variable-env> 0x3903890>
;;>>           k         : #<<gather-cont> 0x2e7a2c0>