Code Aquarium

minazoko's blog -*- 水底のブログ -*-

もう一度、関数の引数をlexical-letするマクロ

昨日の「関数の引数をlexical-letするマクロ」が中途半端だったので、拡張してみた。
組み込みdefunと, clモジュールのdefun*のそれぞれに対応したものを作成。ヘルプで見たときにdocstringの位置が明示されるように、引数の調整もしました。

(require 'cl)

(defmacro --impl-defun-lx
  (form name args docstr body keywords)
  (multiple-value-bind (docstr body)
      (cond ((null docstr) (values nil nil))
            ((stringp docstr) (values docstr body))
            (t (values nil (cons docstr body))))
    (let* ((--pred (lambda (x) (memq x keywords)))
           (--make-binding
            (lambda (a)
              (cond ((not (listp a)) `((,a ,a)))
                    ((> 3 (length a)) (let ((a (car a)))
                                        `((,a ,a))))
                    (t (let ((a (car a)) (b (caddr a)))
                         `((,a ,a) (,b ,b)))))))
           (--lx-bindings (mapcan --make-binding
                                  (remove-if --pred args)))
           (--body (cond ((null body) nil)
                         ((null --lx-bindings) body)
                         (t `((lexical-let ,--lx-bindings
                                ,@body))))))
      (append  `(,form ,name ,args)
               (when docstr `(,docstr))
               --body))))

(defmacro defun-lx (name args &optional docstr &rest body)
  "define static lexical scope args function by `defun'. "
  `(--impl-defun-lx
    defun ,name ,args ,docstr ,body (&optional &rest)))

(defmacro defun*-lx (name args &optional docstr &rest body)
  "define static lexical scope args function by `defun*'"
  `(--impl-defun-lx
    defun* ,name ,args ,docstr ,body
    (&optional &rest &key &allow-other-keys &aux &body)))

◆何が嬉しいのか(追記 2012/12/12)

defunやdefun*でクロージャーを作るとき、たとえば次のコード。

(setq x 1000 y 500)

(defun* make-counter (x &optional (y 1))
  (lambda () (prog1 x (setq x (+ x y)))))

(let ((a (make-counter 1))     ;初期値1 増加量は規定(=1)のカウンタ
      (b (make-counter 1 10))) ;初期値1 増加量10のカウンタ
  (mapcar 'funcall (list a a a b b b)))

;;=> (1000 1500 2000 2500 3000 3500) ;期待通りにならない。

a, b はfuncallの度にカウントアップする互いに独立したカウンタのつもりなのですが期待通りにいきません。defun*の引数が動的スコープのためカウンタが参照するx,yはmake-counterの仮引数ではなくグローバルなx,yであることが原因です。
そこでdefun*の代わりに今回作ったdefun*-lxを使うとグローバルではなく、クロージャー毎に独立した局所変数を参照するようになります。

(setq x 1000 y 500)

(defun*-lx make-counter (x &optional (y 1))
  (lambda () (prog1 x (setq x (+ x y)))))

(let ((a (make-counter 1))
      (b (make-counter 1 10)))
  (mapcar 'funcall (list a a a b b b)))

;;=> (1 2 3 1 11 21)  ;; 期待通り!

◆注意

レキシカルになるのはあくまでも関数の引数だけだという点に注意しください。
関数内の自由変数がすべて静的レキシカルスコープになるわけではありません。