lisp: как создать временную специализацию метода в области видимости - PullRequest
Новая
       48

lisp: как создать временную специализацию метода в области видимости

6 голосов
/ 27 апреля 2011

In Common lisp: переопределить существующую функцию в области видимости? OP запросил что-то подобное.Но я хочу создать специализированный метод, а не функцию.По сути, предположим, что метод определен так: 

defmethod my-meth ((objA classA) (objB classB)) (...)

Что я хотел бы сделать (псевдокод): 

(labels ((my-meth ((objA classA) (objB (eql some-object)))))
   do stuff calling my-meth with the object...)

Реальное использование заключается в том, что я хочу создать временную средугде setf slot-value-using-class будет специализироваться на eql, существенно создавая определенный объект по требованию перехвата записи его слота.(Цель состоит в том, чтобы зарегистрировать где-нибудь старые и новые значения слотов, а затем вызвать следующий метод.) Я не хочу создавать метакласс, потому что я могу хотеть перехватывать уже созданные экземпляры стандартных объектов.

Конечно, я попробовал это, и это не сработало (потому что, как вы DEFMETHOD в LABELS?), Но я хотел, чтобы некоторые более опытные люди убедились, что это не выполнимо таким способоми / или предложить подходящий способ.

Комментарии?

РЕДАКТИРОВАТЬ:

Даниэль и Терье предоставляют отличные ссылки для расширения моих знаний в сторону возможностей, но я хочу подтолкнуть егонемного больше о поиске более ванильного подхода, прежде чем идти туда.Я пытался создать метод add при входе в среду, который будет специализироваться на eql, и выполнить метод remove при выходе.Я еще не закончил.Если кто-то играл с ними, комментарии были бы хорошими.Будет держать поток в актуальном состоянии.

РЕДАКТИРОВАТЬ 2: Я близок к тому, чтобы сделать это со сценарием добавления метода, но есть проблема.Вот что я попробовал: 

    (defun inject-slot-write-interceptor (object fun)
    (let* ((gf (fdefinition '(setf sb-mop:slot-value-using-class)))
            (mc (sb-mop:generic-function-method-class gf))
            (mc-instance (make-instance (class-name mc) 
                            :qualifiers '(:after)
                            :specializers (list (find-class 't)
                                                (find-class 'SB-PCL::STD-CLASS)
                                                (sb-mop::intern-eql-specializer object) 
                                                (find-class 'SB-MOP:STANDARD-EFFECTIVE-SLOT-DEFINITION))
                           :lambda-list '(new-value class object slot)
                           :function (compile nil (lambda (new-value class object slot) (funcall fun new-value class object slot))))))
         (add-method gf mc-instance)
         (defun remove-slot-write-interceptor ()
            (remove-method gf mc-instance))
       ))

(defun my-test (object slot-name data)
     (let ((test-data "No results yet") 
           (gf (fdefinition '(setf sb-mop::slot-value-using-class))))
       (labels ((show-applicable-methods () (format t "~%Applicable methods: ~a" (length (sb-mop:compute-applicable-methods gf (list data (class-of object) object (slot-def-from-name (class-of object) slot-name)))))))
            (format t "~%Starting test: ~a" test-data)
            (show-applicable-methods)
            (format t "~%Injecting interceptor.")
            (inject-slot-write-interceptor object (compile nil (lambda (a b c d) (setf test-data "SUCCESS !!!!!!!"))))
            (show-applicable-methods)
            (format t "~%About to write slot.")
            (setf (slot-value object slot-name) data)
            (format t "~%Wrote slot: ~a" test-data)
            (remove-slot-write-interceptor)
            (format t "~%Removed interceptor.")
            (show-applicable-methods)
       )))

Вызов (my-test) с некоторым слотом объекта и данными в качестве аргументов приводит к: 

Starting test: No results yet 
Applicable methods: 1 
Injecting interceptor. 
Applicable methods: 2 
About to write slot.     
Wrote slot: No results yet  <----- Expecting SUCCESS here....
Removed interceptor. 
Applicable methods: 1

Так что я застрял здесь.Специализация работает, так как применимые методы теперь включают eql-special: after, но, к сожалению, кажется, что он не вызывается.Может ли кто-нибудь помочь, чтобы я мог покончить с этим и перестроить его в симпатичный маленький служебный макрос?

Ответы [ 2 ]

5 голосов
/ 27 апреля 2011

Нет, вы не можете определить динамический экстент или лексически ограниченный специализированный метод в Common Lisp.

Аспектно-ориентированное программирование может использоваться в качестве подхода для решения основной проблемы. См. Также Контекстно-ориентированное программирование .

ContextL - библиотека, предоставляющая ориентированные на контекст / контекст расширения для Common Lisp / CLOS.

Облегченная альтернатива - использовать специальную / динамическую переменную, чтобы указать, когда метод должен вести запись: 

(defparameter *logging* NIL "Bind to a true value to activate logging")

(defmethod my-meth :around ((objA classA) (objB (eql some-object)))
  (prog2 
   (when *logging*
     (logging "Enter my-meth"))
   (call-next-method)
   (when *logging*
     (logging "Exit my-meth"))))

(let ((*logging* T))
   (do stuff calling my-meth with the object...))

Обратите внимание, что метод: around будет вызываться и тогда, когда ведение журнала отключено.

3 голосов
/ 27 апреля 2011

Похоже, что когда-то для Common Lisp предлагались специальные формы generic-flet и generic-labels, но они были удалены из окончательных спецификаций, потому что считалось, что они редко поддерживаются реализациями и плохо спроектированы. См. Issue GENERIC-FLET-POORLY-DESIGNED Writeup в HyperSpec. Интересно читать дискуссии, почему люди думают, что лексические методы менее полезны, чем лексически ограниченные функции.

Итак, без них я не думаю, что есть способ создать метод с лексической областью, хотя я не играл с ContextL, с которым Терье связался в другом ответе, поэтому возможно, что он предоставит то, что вам нужно.

...