無名関数をなんらかの方法で選別したい - lisp-cookbook-ja/common-lisp GitHub Wiki

MOP

無名の総称関数に名前を付ける方法

ANSI標準ではありませんが、MOPの定義によれば総称関数には、 $$mop generic-function-name を使って名前を付けることができますので、これを利用して選別することができるでしょう。

MOPの互換性のため[CLiki:Closer to MOP](//www.cliki.net/Closer to MOP)を利用しています。

(defparameter *objs*
  (list (annotated-function "x" () 0)
        (annotated-function "q" () 1)
        (annotated-function "r" () 2)
        (annotated-function "i" () 3)
        (annotated-function "a" (a b c) (list a b c))
        (annotated-function "e" () 4)
        (annotated-function "l" () 5)
        (annotated-function "h" () 6)
        (annotated-function "b" () 7)
        (annotated-function "a" (a b c) (* a b c))
        (annotated-function "l" () 9)
        (lambda (x) "foo")
        #'list
        1 2 3 4
        '(foo)))


(mapcar #'apply 
        (remove-if-not (lambda (x)
                         (and (typep x 'standard-generic-function)
                              (string= "a" (c2mop:generic-function-name x))) )
                       *objs*)
        '((1 2 3) (1 2 3) (1 2 3)))
;=>  ((1 2 3) 6)

annotated-functionの定義例

(defmacro annotated-function (annot (&rest args) &body body)
  (flet ((make-specializers-form ()
           (let ((pos (position-if (lambda (x)
                                     (member x lambda-list-keywords))
                                   args)))
             `(list ,@(mapcar (constantly '(find-class t))
                              (subseq args 0 pos))))))
    (let ((gf (gensym "gf-"))
          (meth (gensym "meth-"))
          (margs (gensym "args-"))
          (ignore (gensym "ignore-")))
      `(let* ((,gf (make-instance 'standard-generic-function))
              (,meth (make-instance 'standard-method
                                    :function (lambda (,margs ,ignore)
                                                (declare (ignore ,ignore))
                                                (apply (lambda (,@args) ,@body) ,margs))
                                    :lambda-list ',args
                                    :specializers ,(make-specializers-form))))
         (add-method ,gf ,meth)
         (setf (c2mop:generic-function-name ,gf) ,annot)
         ,gf))))

マクロ展開

(LET* ((#:|gf-11467| (MAKE-INSTANCE 'STANDARD-GENERIC-FUNCTION))
       (#:|meth-11468|
        (MAKE-INSTANCE 'STANDARD-METHOD :FUNCTION
                       (LAMBDA (#:|args-11469| #:|ignore-11470|)
                         (DECLARE (IGNORE #:|ignore-11470|))
                         (APPLY (LAMBDA () 8) #:|args-11469|))
                       :LAMBDA-LIST 'NIL :SPECIALIZERS (LIST))))
  (ADD-METHOD #:|gf-11467| #:|meth-11468|)
  (SETF (SB-MOP:GENERIC-FUNCTION-NAME #:|gf-11467|) "foo")
  #:|gf-11467|)

ドキュメンテーション文字列を使う場合

ドキュメンテーション文字列は、処理系依存かつ、処理系が任意の理由で捨てることができますので、ドキュメンテーション文字列が常にあることを期待することはできませんが、無名関数もドキュメンテーション文字列を持つことができますので、この文字列を documentation で取得/利用することにより選別できなくもありません。もちろんできないかもしれませんので、できなくても問題ない場合には使えるかもしれません

(他の方法募集)

(defparameter *funs*
  (list (lambda () "d" 90) (lambda () "v" 39) 
        (lambda () "z" 92) (lambda () "b" 10)
        (lambda () "f" 31) (lambda () "h" 23)
        (lambda () "p" 95) (lambda () "k" 22)
        (lambda () "i" 51) (lambda () "z" 66)
        (lambda () "r" 80) (lambda () "a" 68)
        (lambda () "b" 35) (lambda () "t" 95)
        (lambda () "q" 30) (lambda () "v" 66)
        (lambda () "q" 58) (lambda () "g" 65)
        (lambda () "l" 48) (lambda () "e" 89)
        #'list))

;;; "a"というドキュメントが付いている無名関数を選ぶ
(mapcar #'funcall
        (remove-if-not (lambda (x)
                         (string= "a" (documentation x 'function)) )
                       *funs*))
;=>  (68)