symbol-macrolet 内外での macrolet 問題

xyzzy lisp symbol-macrolet

symbol-macrolet と macrolet

symbol-macrolet 内で定義された symbol-macro は、macrolet で定義された local-macro の

  • 展開時に変数として参照される symbol
  • 展開後に変数として参照される symbol

の両方を symbol-macro として展開する。

手順

  1. macrolet の local-macro 定義内に現れる symbol-macro を展開
  2. macrolet の body 部分に現れる local-macro 呼び出しを展開
  3. result(2) に現れる symbol-macro を展開

現時点での問題

symbol-macrolet の内外で多重に macrolet している場合、正しい local-macro の展開形を得る方法がない（わからない）

symbol-macrolet と macroexpand

;;; 準備: global な macro
(defmacro foo () :global-foo)
=> foo

;;; macroexpand は global な macro を展開できる
(macroexpand '(foo))
=> :global-foo


;;; macroexpand は呼び出された環境を無視する
(macrolet ((foo () :local-foo))
  (macroexpand '(foo)))
=> :global-foo

;;; その場の環境を得る macro
(defmacro env (&environment env) env)
=> env

;;; 呼び出された環境を適用するにはこーする
(macrolet ((foo () :local-foo))
  (macroexpand '(foo) (env)))
=> :local-foo

;;; これは macrolet がネストしてても機能する
(macrolet ((foo () :outer-foo))
  (macrolet ((foo () :inner-foo))
    (macroexpand '(foo) (env))))
=> :inner-foo

材料/道具として使えるもの

outer-env
symbol-macrolet の外側で macrolet によって定義された local-macros を含む environment-object。
  • symbol-macrolet の引数として &environment で得られる
inner-env
symbol-macrolet の内側で macrolet によって定義される local-macros を含む environment-object。
defs
symbol-macrolet の内側で macrolet によって定義される local-macros の定義。
  • macrolet 呼び出しの form から自分で集める。
    • 個々の macrolet form の cadr。つまりこんなの-> ((foo () :local-foo) ...)
    • ネストした場合は内側を前に継ぎ足す: (cons inner-defs defs)
macroexpand
form と environment-object を与えると、展開形を返してくれる。
macrolet
上手く defs を埋め込む/ネストさせることで、macroexpand に渡す environment-object を作り出せる。

作戦

  • global: global 環境下での展開形を得る
  • outer: outer-env 下での展開形を得る
  • inner: defs からinner-env を作って、inner-env 下での展開形を得る

こいつらを比較して、異なった展開形になった場合はどっかの local な macro が適用されるとゆーこと。

inner/outer が global と equal だったら、そこに適用すべき local macro は含まれてない。

defs -> environment-object

(macrolet ,@def
  (macrolet ((env (&environment env) env))
    (env)))

てことをすればいい。必要ならネストさせて。

(defun defs->env (defs &optional form)
  (cond ((null defs) (eval form))
        ((null form)
         (let ((env (gensym)))
           (defs->env defs `(macrolet ((,env (&environment ,env) ,env))
                              (,env)))))
        (t (defs->env (cdr defs) `(macrolet ,(car defs) ,form)))))
=> defs->env

;;; 手動再帰の図
(defs->env '(((inner-foo () :inner-foo))
             ((outer-foo () :outer-foo))))

-> (defs->env '(((inner-foo () :inner-foo))
                (((outer-foo () :outer-foo))))
              '(macrolet ((#1=#:Gxxx (&environment #1#) #1#)) (#1#)))

-> (defs->env '(((outer-foo () :outer-foo)))
              '(macrolet ((inner-foo () :inner-foo))
                 (macrolet ((#1=#:Gxxx (&environment #1#) #1#))
                   (#1#))))

-> (defs->env '()
              '(macrolet ((outer-foo () :outer-foo))
                 (macrolet ((inner-foo () :inner-foo))
                   (macrolet ((#1=#:Gxxx (&environment #1#) #1#))
                     (#1#)))))

-> (eval `(macrolet ((outer-foo () :outer-foo))
            (macrolet ((inner-foo () :inner-foo))
              (macrolet ((#1=#:Gxxx (&environment #1#) #1#))
                (#1#)))))

=> #<environment-object xxxxxxx>

;;; 確認
(setq e (defs->env '(((foo () :local-foo)))))
=> #<environment-object 98374644>

(macroexpand '(foo) e)
=> :local-foo ;おｋ

(setq e (defs->env '(((foo () :inner-foo))
                     ((foo () :outer-foo)
                      (bar () :outer-bar)))))
=> #<environment-object 98374620>

(macroexpand '(foo) e)
=> :inner-foo ;おｋ
(macroexpand '(bar) e)
=> :outer-bar ;おｋｐｋ

作戦実行

(defun macroexpand* (form &key defs env)
  (let ((global (macroexpand form))
        (outer (macroexpand form env))
        (inner (macroexpand form (defs->env defs))))
    (or (find-if (lambda (expansion)
                   (not (equal expansion global)))
          (list inner outer))
        global)))
=> macroexpand*

(setq outer (defs->env '(((foo () :outer)
                          (bar () :outer)
                          (baz () :outer)))))
=> #<environment-object 98374644>

(setq inner '(((foo () :inner))))
=> (((foo nil :inner)))

(macroexpand* '(foo) :defs inner :env outer)
=> :inner ;おｋ

(macroexpand* '(bar) :defs inner :env outer)
=> :outer ;おｋｐｋ