Scheme:初心者の質問箱から移動
最近のEcmaScriptにはジェネレータという機能があります。それと同じような感覚で使えるものをSchemeで実装してみようとこんなものを書きました。
(define (make-generator proc) (define next #f) (lambda () (if (not next) (call/cc (lambda(break) (proc (lambda arg (call/cc (lambda(cc) (set! next cc) (apply break arg))))) #f)) (next))))
で、使い方としてはこんなカンジです。
(define (fib) (make-generator (lambda (yield) (let loop ((i 0) (j 1)) (yield i) (loop j (+ j i)))))) (let ((g (fib)) (i 0)) (while (< i 10) (display (g)) (newline) (inc! i)))
ここ↓のサイトにインスパイアされました。
http://developer.mozilla.org/en/docs/New_in_JavaScript_1.7
で、このコードの最後でwhileループでまわしているところをdoに置き換えると停止せずに突っ走ってしまいます。 こう↓するととまらない。
(let ((g (fib))) (do ((i 0 (+ i 1))) ((>= i 10) i) (display (g))))
私が考える限りではdoでもwhileでも同じようなものだと思ったのですが、浅はかでしょうか?いったいどこに問題があるのでしょう。
ミソはdo/whileというより、inc!ですかね。
(let ((g (fib)) (i 0)) (while (< i 10) #?="mae" #?=i (print (g)) (inc! i) #?="ato" #?=i)) (let ((g (fib))) (do ((i 0 (+ i 1))) ((>= i 10) i) #?="mae" #?=i (print (g)) #?="ato" #?=i))
こんな風にデバッグプリントを入れてみれば、
なぜ無限ループになるかは判りますよね。
では何故、そうなるのか?
(g)が呼ばれた時にnextつまりcall/ccで切り出した継続が呼ばれますけど、
call/cc式で継続が切り出された時にiはどうだったんでしょう。
こんな風にジェネレータに観測用の引数を渡せる様に変更を入れて確認してみましょう。
(define (make-generator proc) (define next #f) (lambda (a) #?="MAE" #?=a (if (not next) (call/cc (lambda (break) (proc (lambda arg #?="ATO" #?=a (call/cc (lambda (cc) (set! next cc) (apply break arg))))) #f)) (next)))) (define (fib a) (make-generator (lambda (yield) (let loop ((i 0) (j 1)) (yield i) (loop j (+ j i)))))) (let ((g (fib 0)) (i 0)) (while (< i 10) #?="mae" (print (g #?=i)) (inc! i) #?="ato" #?=i)) (let ((g (fib 0))) (do ((i 0 (+ i 1))) ((>= i 10) i) #?="mae" (print (g #?=i)) #?="ato" #?=i))
これでどうですかね。:-)cut-sea:2006/08/09 08:55:39 PDT
Shiro: doとwhileの違いについては、cut-seaさんの見解のとおり、 破壊的変更の有無にあります。doは再帰で本体を呼び出しているので、一度 束縛されたiは変更されません。この違いは、本体内でiをクローズしてみると わかります。
gosh> (define procs (let ((ps '())) (do ((i 0 (+ i 1))) ((>= i 5) (reverse ps)) (push! ps (lambda () i))))) procs gosh> ((ref procs 0)) 0 gosh> ((ref procs 1)) 1 gosh> ((ref procs 2)) 2
procsには手続きのリストが束縛されます。doを使った場合、 それぞれの手続きはその時点でのiの値をクローズしているので、返す値が違います。
gosh> (define procs (let ((ps '()) (i 0)) ;; <-- これ (while (< i 5) (push! ps (lambda () i)) (inc! i)) (reverse ps))) procs gosh> ((ref procs 0)) 5 gosh> ((ref procs 1)) 5 gosh> ((ref procs 2)) 5
procsには手続きのリストが束縛されます。whileを使った場合、 全ての手続きは最初のletで導入される単一のiを束縛します。 したがって、どの手続きも呼ばれると、while終了後のiの値、5を返します。
さて、これがdoとwhileの違いが出た直接の理由なんですが、 そもそも最初の質問者の動機にたちかえると、「じゃあdoだとジェネレータ使えないの? 不便じゃん」って疑問が当然出てきますわな。
最初のジェネレータがdoで使えなかった理由は、ジェネレータの実装にあります。 もういちどオリジナルの実装を見てみます。
(define (make-generator proc) (define next #f) (lambda () (if (not next) (call/cc (lambda (break) (proc (lambda arg ;; <-- これがyieldの正体 (call/cc (lambda (cc) ;; <-- このccは「yieldの後」への継続 (set! next cc) (apply break arg))))) ;; <-- このbreakがポイント #f)) (next)))) (define (fib) (make-generator (lambda (yield) ;; <-- これがproc (let loop ((i 0) (j 1)) (yield i) (loop j (+ j i))))))
fibが返すジェネレータの動作を追ってみましょう。
最初に呼ばれた時:
2度目に呼ばれた時:
あれ、このbreakはいつ捕まえたものでしょう? そう、継続breakは 「最初にジェネレータが呼ばれた時の、ジェネレータから戻るところ」に 束縛されたままなんですね。だから、「2度目に呼ばれたg」から戻るのではなく、 「1度目に呼ばれたg」の方に戻っちゃう。
whileの場合、「1度目に呼ばれたg」に戻り続けても、iが破壊的に変更されているので いずれループを抜けます。しかしdoの場合は上の例でみたように、 「1度目の本体の環境」と「2度目の本体の環境」は別物で、1度目に戻るとiの値も1度目の 値のままなわけです。それが無限ループの理由です。
ジェネレータに入る度に、その時点でのジェネレータから戻る継続を 捕まえればいいんですが、うまいぐあいにふたつの継続をマネージするのは ちょっとトリッキーです。おもしろいパズルなのでやってみて下さい。
こうかな。cut-sea:2006/08/09 17:17:02 PDT
(define (make-generator proc) (define next #f) (define return #f) (lambda () (call/cc ;; break = generatorがcallされた後に相当する継続 (lambda (break) (set! return break) ;; 環境を書き換え (if (not next) (proc ;; yield (lambda arg ;; cc = yieldがcallされた後に相当する継続 (call/cc (lambda (cc) (set! next cc) ;; 環境を書き換え (apply return arg))))) ;; breakの後に待ち構えている継続をcall (next)))))) ;; yieldの後に待ち構えている継続をcall
び(2007/03/15 19:13:27 PDT): よさげに見えるのですが、with-*-to-port系の手続きと併用したときの挙動が何だか変です。
gosh> (define (hoge yield) (while #t #?=(current-output-port) (yield))) hoge gosh> (define g (make-generator hoge)) g gosh> (with-output-to-string g) #?="(stdin)":77:(current-output-port) #?- #<oport (output string port) 0x58b960> "" gosh> (with-output-to-string g) #?="(stdin)":77:(current-output-port) #?- #<oport (stdout) 0x99b40> "" gosh> (with-output-to-string g) #?="(stdin)":77:(current-output-port) #?- #<oport (stdout) 0x99b40> "" gosh>
何でこうなるのか、ソースを読んでも理解できず...
Shiro(2007/03/15 19:28:30 PDT): あれ、dynamic handlerのbefore thunkが 呼ばれてなさげ。Gaucheのバグかも。
び(2007/03/19 00:33:48 PDT): before thunkになっていなかったのでしてみました。これでいいのかな?
--- src/port.c 2 Mar 2007 07:39:14 -0000 1.137 +++ src/port.c 19 Mar 2007 07:31:15 -0000 @@ -1522,29 +1522,35 @@ ScmObj Scm_WithPort(ScmPort *port[], ScmObj thunk, int mask, int closep) { + ScmObj initializer; ScmObj finalizer; - struct with_port_packet *packet; + struct with_port_packet *packet_before; + struct with_port_packet *packet_after; int pcnt = 0; ScmVM *vm = Scm_VM(); - packet = SCM_NEW(struct with_port_packet); + packet_before = SCM_NEW(struct with_port_packet); + packet_after = SCM_NEW(struct with_port_packet); if (mask & SCM_PORT_CURIN) { - packet->origport[pcnt] = SCM_VM_CURRENT_INPUT_PORT(vm); - SCM_VM_CURRENT_INPUT_PORT(vm) = port[pcnt++]; + packet_before->origport[pcnt] = port[pcnt]; + packet_after->origport[pcnt++] = SCM_VM_CURRENT_INPUT_PORT(vm); } if (mask & SCM_PORT_CUROUT) { - packet->origport[pcnt] = SCM_VM_CURRENT_OUTPUT_PORT(vm); - SCM_VM_CURRENT_OUTPUT_PORT(vm) = port[pcnt++]; + packet_before->origport[pcnt] = port[pcnt]; + packet_after->origport[pcnt++] = SCM_VM_CURRENT_OUTPUT_PORT(vm); } if (mask & SCM_PORT_CURERR) { - packet->origport[pcnt] = SCM_VM_CURRENT_ERROR_PORT(vm); - SCM_VM_CURRENT_ERROR_PORT(vm) = port[pcnt++]; + packet_before->origport[pcnt] = port[pcnt]; + packet_after->origport[pcnt++] = SCM_VM_CURRENT_ERROR_PORT(vm); } - packet->mask = mask; - packet->closep = closep; - finalizer = Scm_MakeSubr(port_restorer, (void*)packet, + packet_before->mask = packet_after->mask = mask; + packet_before->closep = FALSE; + packet_after->closep = closep; + initializer = Scm_MakeSubr(port_restorer, (void*)packet_before, + 0, 0, SCM_FALSE); + finalizer = Scm_MakeSubr(port_restorer, (void*)packet_after, 0, 0, SCM_FALSE); - return Scm_VMDynamicWind(Scm_NullProc(), SCM_OBJ(thunk), finalizer); + return Scm_VMDynamicWind(initializer, SCM_OBJ(thunk), finalizer); } /*===============================================================
この例は意図通りに動いているようなのですが...
gosh> (define g (make-generator hoge)) g gosh> (with-output-to-string g) #?="(stdin)":22:(current-output-port) #?- #<oport (output string port) 0x595960> "" gosh> (with-output-to-string g) #?="(stdin)":22:(current-output-port) #?- #<oport (output string port) 0x595960> "" gosh> (with-output-to-string g) #?="(stdin)":22:(current-output-port) #?- #<oport (output string port) 0x595960> "" gosh>
び(2007/03/19 01:01:26 PDT): やっぱり変。
gosh> (define g (make-generator hoge)) g gosh> (g) #?="(stdin)":16:(current-output-port) #?- #<oport (stdout) 0x99b40> #<undef> gosh> (with-output-to-string g) #?="(stdin)":16:(current-output-port) #?- #<oport (stdout) 0x99b40> "" gosh> (with-output-to-string g) #?="(stdin)":16:(current-output-port) #?- #<oport (stdout) 0x99b40> "" gosh>
だめぽ...
び(2007/03/19 20:16:37 PDT): よく考えてみると、dynamic-windを使ってwith-*port系を実装している限り、これが正しい挙動のような気がしますね。問題は、じゃあ上記のジェネレータはどうあるべきか、ということなんですが、うーん、よくわからない...
び(2007/03/20 01:37:56 PDT): 上記のパッチは、with-{input-from|output-to}-port をdynamic-wind で実装しようとしたものだ。なので、dynamic-windを使って実験してみた。
gosh> (define (hoge yield) (while #t #?='hoge (yield))) hoge gosh> (define g (make-generator hoge)) g gosh> (define (foo n) (dynamic-wind (lambda () #?=(format "before: ~d" n)) (lambda () #?=(format "main-a: ~d" n) (g) #?=(format "main-b: ~d" n)) (lambda () #?=(format "after: ~d" n)))) foo gosh> (foo 1) #?="(stdin)":24:(format "before: ~d" n) #?- "before: 1" #?="(stdin)":26:(format "main-a: ~d" n) #?- "main-a: 1" #?="(stdin)":17:'hoge #?- hoge #?="(stdin)":28:(format "main-b: ~d" n) #?- "main-b: 1" #?="(stdin)":29:(format "after: ~d" n) #?- "after: 1" "main-b: 1" gosh> (foo 2) #?="(stdin)":24:(format "before: ~d" n) #?- "before: 2" #?="(stdin)":26:(format "main-a: ~d" n) #?- "main-a: 2" #?="(stdin)":29:(format "after: ~d" n) #?- "after: 2" #?="(stdin)":24:(format "before: ~d" n) #?- "before: 1" #?="(stdin)":17:'hoge #?- hoge #?="(stdin)":29:(format "after: ~d" n) #?- "after: 1" #?="(stdin)":24:(format "before: ~d" n) #?- "before: 2" #?="(stdin)":28:(format "main-b: ~d" n) #?- "main-b: 2" #?="(stdin)":29:(format "after: ~d" n) #?- "after: 2" "main-b: 2" gosh> (foo 3) #?="(stdin)":24:(format "before: ~d" n) #?- "before: 3" #?="(stdin)":26:(format "main-a: ~d" n) #?- "main-a: 3" #?="(stdin)":29:(format "after: ~d" n) #?- "after: 3" #?="(stdin)":24:(format "before: ~d" n) #?- "before: 1" #?="(stdin)":17:'hoge #?- hoge #?="(stdin)":29:(format "after: ~d" n) #?- "after: 1" #?="(stdin)":24:(format "before: ~d" n) #?- "before: 3" #?="(stdin)":28:(format "main-b: ~d" n) #?- "main-b: 3" #?="(stdin)":29:(format "after: ~d" n) #?- "after: 3" "main-b: 3" gosh>
なるほど納得。gは常に一番最初に呼び出した dynamic-wind のmain thunkの中の継続を 保存していることになっているわけだ。
Tags: 継続, dynamic-wind, generator, ジェネレータ