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

写経しつつ以下のように分解してみました。
(define-syntax swap!
(syntax-rules ()
((_ a b)
(let1 temp a
(set! a b)
(set! b temp)))))
(define-syntax my-fluid-let
(syntax-rules ()
((_ ((var val) ...) body ...)
(my-fluid-let-helper () ((var val) ...) body ...))))
(define-syntax my-fluid-let-helper
(syntax-rules ()
((_ (t ...)((var val) x ...) body ...)
(let1 temp val
(my-fluid-let-helper (t ... (temp var))(x ...) body ...)))
((_ ((temp var) ...)() body ...)
(dynamic-wind
(lambda ()
(swap! temp var) ...)
(lambda ()
body ...)
(lambda ()
(swap! temp var) ...)))))
(my-fluid-let ((a 100)(b 200))
(a+b))
;; 300
(a+b)
;; 3
view raw fluid-let1.scm hosted with ❤ by GitHub

上記の helper マクロを写経しているときに気づいたのですが、
(_ "temps" (t ...) ((v1 e1) x ...) b1 b2 ...)
     (let ((temp e1))
       (fluid-let "temps" ((temp e1 v1) t ...) (x ...) b1 b2 ...)))
この部分が素敵ですね！自分はこのテクニック（？）を知らなかったので、今まで以下のように書いていました。。
(define-syntax my-fluid-let-helper
(syntax-rules ()
((_ (t ...)((var val)) body ...)
(let1 temp val
(my-fluid-let-helper ((temp val var) t ...)() body ...)))
((_ (t ...)((var1 val1)(var2 val2) ...) body ...)
(let ((temp1 val1))
(my-fluid-let-helper ((temp1 val1 var1) t ...)((var2 val2) ...) body ...)))
((_ ((t val var) ...)() body ...)
(dynamic-wind
(lambda ()
(swap! t var) ...)
(lambda ()
body ...)
(lambda ()
(swap! t var) ...)))))
view raw fluid-let-bad-helper.scm hosted with ❤ by GitHub

ところで、文字列を使ったフラグ（？）によって、以下のように一つのマクロにまとめることができるわけです。
(define-syntax my-fluid-let
(syntax-rules ()
((_ ((var val) ...) body ...)
(my-fluid-let "temp" () ((var val) ...) body ...))
((_ "temp" (t ...)((var val) x ...) body ...)
(let1 temp val
(my-fluid-let-helper (t ... (temp var))(x ...) body ...)))
((_ "temp" ((temp var) ...)() body ...)
(let-syntax ((swap! (syntax-rules ()
((swap! a b)
(let1 tmp a
(set! a b)
(set! b tmp))))))
(dynamic-wind
(lambda ()
(swap! temp var) ...)
(lambda ()
body ...)
(lambda ()
(swap! temp var) ...))))))
(a+b)
;; 3
(my-fluid-let ((a 100)(b 200))
(a+b))
;; 300
(a+b)
;; 3
view raw fluid-let3.scm hosted with ❤ by GitHub

でも、こういう風に書けたらもっとわかりやすい気がします。でも、確かダメなんですよね。。(... ...)とかドット対記法だと良いんでしたっけ？（その辺はまた今度・・・）
(define-syntax my-fluid-let
(syntax-rules ()
((_ ((var val) ...) body ...)
(let-syntax
((swap! (syntax-rules ()
((swap! a b)
(let1 temp a
(set! a b)
(set! b temp))))))
(letrec-syntax
((helper (syntax-rules ()
((helper (t ...)((var val) x ...) body ...)
(let1 temp val
(helper (t ... (temp var))(x ...) body ...)))
((helper ((temp var) ...)() body ...)
(dynamic-wind
(lambda ()
(swap! temp var) ...)
(lambda ()
body ...)
(lambda ()
(swap! temp var) ...))))))
(helper () ((var val) ...) body ...))))))
view raw fluid-let2.scm hosted with ❤ by GitHub



参考


;; 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
written by time:
labels : , ,

0 件のコメント:

コメントを投稿

登録: コメントの投稿 (Atom)