fluid-let は srfi にもあります。gauche などでは組み込みで用意されています。驚いたのは dynamic-wind が使われているところ。例えば body で脱出された場合などを考慮しているんですよね、きっと。なるほど~。
こういう動きです。
;; fluid-let ;; example (define-values (a b)(values 1 2)) (define (a+b) (+ a b)) (a+b) ;; 3 (fluid-let ((a 100)(b 200)) (a+b)) ;; 300 ;; fluid-let expand image (let ((tempa a)(tempb b)) (dynamic-wind (lambda () (set! a 100)(set! b 200)) (lambda () (a+b)) (lambda () (set! a tempa)(set! b tempb)))) ;; 300 (a+b) ;; 3独習 Scheme 三週間 Teach Yourself Scheme in Fixnum Days に伝統的なマクロを用いた例が載っています。
fluid-let は syntax-rules では書けないかと思っていました。が、書けるようです。
当初、カンニングせずに自分で考えてみようと思いましたが、syntax-rules 内で一時的な変数を用意する方法がわかりませんでした。。そこで早速カンニングして写経してみました。
当然ですが、srfi のコードは美しいですねぇ・・・。
;; SRFI 15: Syntax for dynamic scoping - http://srfi.schemers.org/srfi-15/srfi-15.html (define-syntax fluid-let (syntax-rules () ((_ ((v1 e1) ...) b1 b2 ...) (fluid-let "temps" () ((v1 e1) ...) b1 b2 ...)) ((_ "temps" (t ...) ((v1 e1) x ...) b1 b2 ...) (let ((temp e1)) (fluid-let "temps" ((temp e1 v1) t ...) (x ...) b1 b2 ...))) ((_ "temps" ((t e v) ...) () b1 b2 ...) (let-syntax ((swap! (syntax-rules () ((swap! a b) (let ((tmp a)) (set! a b) (set! b tmp)))))) (dynamic-wind (lambda () (swap! t v) ...) (lambda () b1 b2 ...) (lambda () (swap! t v) ...))))))
写経しつつ以下のように分解してみました。
上記の helper マクロを写経しているときに気づいたのですが、
(_ "temps" (t ...) ((v1 e1) x ...) b1 b2 ...) (let ((temp e1)) (fluid-let "temps" ((temp e1 v1) t ...) (x ...) b1 b2 ...)))この部分が素敵ですね!自分はこのテクニック(?)を知らなかったので、今まで以下のように書いていました。。
ところで、文字列を使ったフラグ(?)によって、以下のように一つのマクロにまとめることができるわけです。
でも、こういう風に書けたらもっとわかりやすい気がします。でも、確かダメなんですよね。。(... ...)とかドット対記法だと良いんでしたっけ?(その辺はまた今度・・・)
参考
;; SRFI 15: Syntax for dynamic scoping - http://srfi.schemers.org/srfi-15/srfi-15.html (define-syntax fluid-let (syntax-rules () ((_ ((v1 e1) ...) b1 b2 ...) (fluid-let "temps" () ((v1 e1) ...) b1 b2 ...)) ((_ "temps" (t ...) ((v1 e1) x ...) b1 b2 ...) (let ((temp e1)) (fluid-let "temps" ((temp e1 v1) t ...) (x ...) b1 b2 ...))) ((_ "temps" ((t e v) ...) () b1 b2 ...) (let-syntax ((swap! (syntax-rules () ((swap! a b) (let ((tmp a)) (set! a b) (set! b tmp)))))) (dynamic-wind (lambda () (swap! t v) ...) (lambda () b1 b2 ...) (lambda () (swap! t v) ...))))))
;; Identifier Syntax - http://permalink.gmane.org/gmane.lisp.scheme.reports.wg1/148 (define-syntax fluid-let (syntax-rules () ((fluid-let ("step") bind ((var val) . rest) body ...) (fluid-let ("step") ((var old new val) . bind) rest body ...)) ((fluid-let ("step") ((var old new val) ...) () body ...) (let ((old var) ... (new val) ...) (dynamic-wind (lambda () (set! var new) ...) (lambda () body ...) (lambda () (set! var old) ...)))) ((fluid-let ((var val) ...) body ...) (fluid-let ("step") () ((var val) ...) body ...))))
;; http://www-pu.informatik.uni-tuebingen.de/users/knauel/sw/fffi/easyffi.scm (define-syntax fluid-let (syntax-rules () ((fluid-let ((var1 expr1) (var2 expr2)) body ...) (let ((old-var1 var1) (old-var2 var2)) (set! var1 expr1) (set! var2 expr2) (let ((res ((lambda () body ...)))) (set! var1 old-var1) (set! var2 old-var2) res))) ((fluid-let ((var1 expr1)) body ...) (let ((old-var1 var1)) (set! var1 expr1) (let ((res ((lambda () body ...)))) (set! var1 old-var1) res)))))
;; Control Operations - http://www.scheme.com/tspl4/control.html (define-syntax fluid-let (syntax-rules () [(_ ((x e)) b1 b2 ...) (let ([y e]) (let ([swap (lambda () (let ([t x]) (set! x y) (set! y t)))]) (dynamic-wind swap (lambda () b1 b2 ...) swap)))]))
0 件のコメント:
コメントを投稿