2010/08/12

syntax-rules: fluid-let

fluid-let は dynamic scope をエミュレートするようなマクロです。

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)))]))

The Scheme Programming Language, 4th Edition

0 件のコメント:

コメントを投稿