2010年10月15日金曜日

動的束縛なlabels

fletやlabelsはlexical bindingなので、定義した関数の名前は字面上現れる位置でないと利用できません。

>(defun hoge ()
(print 3))
>(defun fuga ()
(hoge))

>(fuga)
3

>(labels
((hoge ()
(print 10)))
(fuga))
3

変数ならばdeclareでspecial変数だと宣言すれば良いけれど、関数の場合どうすれば良いか分からなかったのでマクロを書いてみました。

(defun generic-function-p (x)
#+SBCL (sb-pcl::generic-function-p x)
#-SBCL nil)

(defmacro dynamic-labels
((&rest definitions) &body body)
(let ((olds (mapcar #'(lambda (x)
(declare (ignore x))
(gensym))
definitions)))
`(let ,(mapcar
#'(lambda (sym def)
`(,sym ,(and (fboundp (car def)) (symbol-function (car def)))))
olds
definitions)
,@(mapcar
#'(lambda (def)
`(,(if (generic-function-p (car def))
`cl:defmethod
`cl:defun)
,@def))
definitions)
(unwind-protect
(progn
,@body)
,@(mapcar
#'(lambda (old def)
`(if ,old
(setf (symbol-function ',(car def))
,old)
(fmakunbound ',(car def))))
olds
definitions)))))

以下実行例。再定義時に警告が出るかもしれない。

>(dynamic-labels
((hoge () (print 10)))
(fuga))
10

0 件のコメント:

コメントを投稿