dynamic-wind 色々試してみた

仕様書に書いてあるコトを色々試験してみる事に。まず仕様書にある例をスクリプトにしてみた。

#!/usr/bin/gosh

(define (main args)
  (print (myfunc)))


(define myfunc
  (lambda ()
    (let ((path '())
	  (c #f))
      (let ((add (lambda (s)
		   (set! path (cons s path)))))
	(dynamic-wind
	    (lambda () (add '1))
	    (lambda ()
	      (add (call-with-current-continuation
		    (lambda (c0)
		      (set! c c0)
		      '2))))
	    (lambda () (add '3)))
	(if (< (length path) 4)
	    (c '-1)
	    (reverse path))))))

実行してみたら以下なカンジ。

$ ./test.scm
(1 2 3 1 -1 3)
$

これは before な thunk が強制実行なケースですな。
続いて dynamic-wind をネストさせてみます。

#!/usr/bin/gosh

(define (main args)
  (print (myfunc)))


(define myfunc
  (lambda ()
    (let ((path '())
	  (c #f))
      (let ((add (lambda (s)
		   (set! path (cons s path)))))
	(dynamic-wind
	    (lambda () (add '1))
	    (lambda ()
	      (dynamic-wind
		  (lambda () (add '4))
		  (lambda ()
		    (add (call-with-current-continuation
			  (lambda (c0)
			    (set! c c0)
			    '5))))
		  (lambda () (add '6))))
	    (lambda () (add '3)))
	(if (< (length path) 6)
	    (c '-1)
	    (reverse path))))))

で、これを実行させてみたら出力が以下。

$ ./test2.scm
(1 4 5 6 3 1 4 -1 6 3)
$

ええと、これは before が外側から呼ばれてるケースになります。試しに after で継続を捕まえてナニしてみたのが以下。

#!/usr/bin/gosh

(define (main args)
  (print (myfunc)))


(define myfunc
  (lambda ()
    (let ((path '())
	  (c #f))
      (let ((add (lambda (s)
		   (set! path (cons s path)))))
	(dynamic-wind
	    (lambda () (add '1))
	    (lambda ()
	      (dynamic-wind
		  (lambda () (add '4))
		  (lambda () (add '5))
		  (lambda () 
		    (add (call/cc
			  (lambda (c0)
			    (set! c c0)
			    '6))))))
	    (lambda () (add '3)))
	(if (< (length path) 6)
	    (c '-1)
	    (reverse path))))))

これだと以下になりました。

$ ./test3.scm 
(1 4 5 6 3 1 -1 3)
$

これは一つめの dynamic-wind の thunk で、な扱いなので上記になるのか。ここまでは簡単だったんですが、微妙なのが

dynamic-wind の 2 つ目の呼び出しが thunk への呼び出しの動的範囲内で発生することによって、2 つの dynamic-wind の起動双方から after を呼び出すような継続が起動された場合

というナニ。以下なカンジ。

#!/usr/bin/gosh

(define (main args)
  (print (myfunc)))

(define myfunc
  (lambda ()
    (call/cc (lambda (q)
	       (let ((path '()))
		 (let ((add (lambda (s)
			      (set! path (cons s path)))))
		   (dynamic-wind
		       (lambda () (add '1))
		       (lambda ()
			 (dynamic-wind
			     (lambda () (add '4))
			     (lambda () (q (reverse path)))
;;			     (lambda () (add '6))))
			     (lambda () (print 6))))
;;		       (lambda () (add '3)))
		       (lambda () (print 3)))
		   (if (< (length path) 6)
		       (c '-1)
		       (reverse path))))))))

最初、は dynamic-wind なネストの記述が以下でした。

		   (dynamic-wind
		       (lambda () (add '1))
		       (lambda ()
			 (dynamic-wind
			     (lambda () (add '4))
			     (lambda () (q (reverse path)))
			     (lambda () (add '6))))
		       (lambda () (add '3)))

で、実行するも

$ ./test4.scm
(1 4)
$

みたいなカンジ。どっちの after も起動されてないじゃん、と言いつつ print にしたのが上記で実行したら以下な出力。

$ ./test4.scm
6
3
(1 4)
$

むむ。print は出力されるのか。よく分からんので両方同時にやっちゃえ、が以下。

#!/usr/bin/gosh

(define (main args)
  (print (myfunc)))

(define myfunc
  (lambda ()
    (call/cc (lambda (q)
	       (let ((path '()))
		 (let ((add (lambda (s)
			      (set! path (cons s path)))))
		   (dynamic-wind
		       (lambda () (add '1))
		       (lambda ()
			 (dynamic-wind
			     (lambda () (add '4))
			     (lambda () (q (reverse path)))
			     (lambda () 
			       (add '6)
			       (print 6))))
		       (lambda () 
			 (add '3)
			 (print 3)))
		   (if (< (length path) 6)
		       (c '-1)
		       (reverse path))))))))

これを実行しても出力は同じ。

$ ./test5.scm 
6
3
(1 4)
$

おそらくは after が実行された後に継続が起動、なのだな、と類推。上記を材料にソースを睨んでみる GW 終盤ッス。