“JRM’s Syntax-rules Primer for the Merely Eccentric” メモ(その1)

sreverse マクロまで読んだのでそこまで復習で、メモっていきます。

こちらの筆者は、混乱のもとになるから、マクロ名を書くのが好み、とのことです。まだ混乱するくらいの量を書いたことがないので、今のところ _ にした方が楽な気がするけれど、という感触です。

You may find macros written using the token “_” rather than repeating the name of the macro:

I personally find this to be confusing and would rather duplicate the macro name.

(define-syntax nth-value
  (syntax-rules ()
    ((nth-value n value-producing-form)
     (call-with-values
       (lambda () value-producing-form)
       (lambda all-values
         (list-ref all-values n))))))

(define-syntax nth-value
  (syntax-rules ()
    ((_ n values-producing-form)
     (call-with-values
       (lambda () values-producing-form)
       (lambda all-values
         (list-ref all-values n))))))

*** Macro `rest args’ get bound to a list of forms, so remember to `unlist’ them at some point.

*** Implicit Begin idiom

N-ary macro 、これが"だいたい"動いてしまってやっかいなことになることがあります、と。マクロあるあるなのかな。正しく動くやつが上、やっかいな形になるのが下。

(define-syntax when
  (syntax-rules ()
    ((when condition . body)
     (if condition (begin . body) #f))))

(define-syntax when
  (syntax-rules ()
    ((when condition . body)
     (if condition (begin body) #f))))

下の例だと、展開形は (begin ((body …)) の形になってしまうこともあり、まず (body …) の部分が評価されて、更にその結果を関数呼び出しに試みるので、 (body …) のコードが評価されてから、関数として評価できない、というエラーが起こる。 (body …) が評価されていることと、その後にエラーが起きるため何が悪かったのかわかりにくく、 (when …) の後にエラーが起こったのものと誤解してしまいやすい、ということらしいです。こうすれば回避できる、という一般的な解答は無いので気を付けましょう、という。

これふわっと、例えば unlist と呼んでいるのですけれども、 unquote-splicing とはここでは呼ばないんですよね。 (begin . body)`(begin ,@(body …)) のように見えます、と言ってしまえばわかり良いように思うのだけれども。

更に一歩進めて、最低一つは必ずフォームがあって欲しい場合がよくあるけれど、そんな時に。

The pattern should end in “FORM . FORMS)” to ensure a minimum of one subform.

(define-syntax when
  (syntax-rules ()
    ((when condition form . forms)
     (if condition (begin form . forms) #f))))

少なくとも一つは form が無い場合、パターンにマッチしないのでエラーになります。成程。


‘Accidental’ matching

一見正しそうに見えるパターンだけれども、シンボルは何にでもマッチする、ということを忘れるとおかしなことになるケースがあるので気を付けましょう、というやつです。

;; このパターンは一見、的確なように見える。ただこれだけだとマズい…
(my-named-let name (binding . more-bindings) . body)

;; 以下の一見それっぽいコードで意図と違うことが起きることが解る
(my-named-let ((x 22)
               (y "computing square root"))
  (display y)
  (display (sqrt x)))

シンボルは何にでもマッチするのでこれを防ぐようにするには?ということで示されるのが以下。

(define-syntax my-named-let
  (syntax-rules ()
    ((my-named-let () . ignore)
     (syntax-error "NAME must not be the empty list."))
    ((my-named-let (car . cdr) . ignore)
     (syntax-error "NAME must be a symbol." (car . cdr)))
    ((my-named-let name bindings form . forms) ;; implicit begin
     (let name bindings form . forms))))

空リストと、 (car . cdr) と陽にペアのパターンを指定しています、 Accidental matching を防ぐ。成程、固いマクロを書くむつかしさですかね。


Recursive expansion

*** Introduce associated code fragments in a single expansion step.

*** Introduce duplicated, but unassociated fragments in different expansion steps.

Common Lisp の multiple-value-setq のようなマクロを作ってみましょう、というもの。

それはそうと“Too Many Daves”だけれども、こちらの書評がとても助かる。

さて本題。

;; これが
(multiple-value-set! (a b c) (values 1 2 3))

;; こう展開されるのを目指します
(call-with-values
  (lambda () (values 1 2 3))
  (lambda (tmp1 tmp2 tmp3)
    (set! a tmp1)
    (set! b tmp2)
    (set! c tmp3)))

第一弾、まだまだまずい形なのだけれども。 emit-cwv-form が最終的にコードに落とし込みます。

(define-syntax multiple-value-set!
  (syntax-rules ()
    ((_ vars values-form)
     (gen-tmps-and-sets () () vars values-form))))

(define-syntax emit-cwv-form
  (syntax-rules ()
    ((_ tmps assignments values-form)
     (call-with-values
       (lambda () values-form)
       (lambda tmps . assignments)))))

(define-syntax gen-tmps-and-sets
  (syntax-rules ()
    ((_ tmps sets () values-form)
     (emit-cwv-form tmps sets values-form))
    ((_ tmps sets (var . vars) values-form)
     (gen-tmps-and-sets (tmp . tmps)
                        ((set! var tmp) . sets)
                        vars
                        values-form))))

(let ((a #f) (b #f) (c #f))
  (multiple-value-set! (a b c) (values 1 2 3))
  (list a b c))
;;=> (3 2 1)
(multiple-value-set! (a b c) (values 1 2 3))
;;->
;; (call-with-values
;;   (lambda () (values 1 2 3))
;;   (lambda (tmp tmp tmp)
;;     (set! c tmp)
;;     (set! b tmp)
;;     (set! a tmp)))

gen-tmps-and-set のパラメータにそれぞれ tmp(set! var tmp) をコンスしてゆきます。ここで (var . vars) の部分が空になったら emit-cwv-form が呼ばれます。

マクロ展開後のフォームが unwrap-syntax してある結果、 tmp が三つあるように見えますが、 lambda 式に現れる tmpset! に表れる tmp とは、同じ展開ステップで作られたシンタックスオブジェクトは同じものを指し、違う展開ステップで作られたものと異なる、ということが説明されます。ステップ毎に 1,2… と勝手に名前を付けるとすると、展開形は以下のような具合になると考えられます:

(multiple-value-set! (a b c) (values 1 2 3))
;;->
;; (call-with-values
;;   (lambda () (values 1 2 3))
;;   (lambda (tmp3 tmp2 tmp1)
;;     (set! c tmp3)
;;     (set! b tmp2)
;;     (set! a tmp1)))

第二弾。これは第一弾の展開形をふわっと受けての話だと思うのだけれども。実行するとエラーとなるものです。

(define-syntax multiple-value-set!
  (syntax-rules ()
    ((_ vars values-form)
     (gen-tmps vars () vars values-form))))

(define-syntax gen-tmps
  (syntax-rules ()
    ((_ () tmps sets values-form)
     (gen-sets tmps sets () values-form))
    ((_ (var . vars) tmps sets values-form)
     (gen-tmps vars (tmp . tmps) sets values-form))))

(define-syntax gen-sets
  (syntax-rules ()
    ((_ tmps () sets values-form)
     (emit-cwv-form tmps sets values-form))
    ((_ tmps (var . vars) sets values-form)
     (gen-sets tmps vars ((set! var tmp) . sets) values-form))))

(let ((a #f) (b #f) (c #f))
  (multiple-value-set! (a b c) (values 1 2 3))
  (list a b c))
;;!> *** ERROR: unbound variable: #<identifier user#tmp.2002300>
(multiple-value-set! (a b c) (values 1 2 3))
;;->
;; (call-with-values
;;   (lambda () (values 1 2 3))
;;   (lambda (tmp tmp tmp)
;;     (set! c tmp)
;;     (set! b tmp)
;;     (set! a tmp)))

gen-sets の中で、 ((set! var tmp) ...) としているけれども、この tmpunbound だということだと考えられます。 tmp が現れるのは、 gen-tmpsgen-sets なので、それぞれ別モノになるのがわかります。特に gen-set の中で tmp が出てくるのだけれども、卒直に言うと、何の脈絡もなく急に tmp が出てきたような感じがあります。展開形を見ると確かに、 (set! c tmp) のようになるので適切かのように考えても無理は無い、ということかもしれないけれども、この展開形に出てくる tmp は全て異なるシンタックスオブジェクトになってしまいます、と。

第三弾。一旦 tmp のリストを作ってそのリストを分解して set! 用のリストを作ると意図通りの動作となります。

(define-syntax multiple-value-set!
  (syntax-rules ()
    ((_ vars values-form)
     (gen-tmps vars () vars values-form))))

(define-syntax gen-tmps
  (syntax-rules ()
    ((_ () tmps sets values-form)
     (gen-sets tmps tmps sets () values-form))
    ((_ (var . vars) tmps sets values-form)
     (gen-tmps vars (tmp . tmps) sets values-form))))

(define-syntax gen-sets
  (syntax-rules ()
    ((_ tmps0 _ () sets values-form)
     (emit-cwv-form tmps0 sets values-form))
    ((_ tmps0 (tmp . tmps) (var . vars) sets values-form)
     (gen-sets tmps0 tmps vars ((set! var tmp) . sets) values-form))))

(let ((a #f) (b #f) (c #f))
  (multiple-value-set! (a b c) (values 1 2 3))
  (list a b c))
;;=> (1 2 3)
(multiple-value-set! (a b c) (values 1 2 3))
;;->
;; (call-with-values
;;   (lambda () (values 1 2 3))
;;   (lambda (tmp tmp tmp)
;;     (set! c tmp)
;;     (set! b tmp)
;;     (set! a tmp)))