Внедрение мультиметодов CLOS и вспомогательных методов (совет)

В Common Lisp Object Standard (CLOS) встроены вспомогательные методы и multi-dispatch. Однако, как академическое упражнение, я хочу реализовать эти функции с нуля. В частности, я хочу получить советы:before,:after и:around и возможность многоадресной рассылки, специализирующуюся на нескольких аргументах. Я ищу понимание того, как продолжить проект. Существуют ли онлайн-материалы, в которых подробно рассматриваются такие реализации? Ниже часть этого проекта.

(in-package :closless)

(defvar *object*)

(defstruct class
  (direct-superclass *object*)
  (direct-slots '()))

(unless (boundp '*object*)
  (setf *object* (make-class :direct-superclass nil)))

(defun class-all-superclasses (class)
  (loop for c = class then (class-direct-superclass c)
        while c
        collect c))

(defun subclassp (class1 class2)
  (member class2 (class-all-superclasses class1)))

(defstruct object
  (class *object*)
  (slots (make-hash-table)))

(defun slot-value (object slot-name)
  (gethash slot-name (object-slots object)))

(defun (setf slot-value) (value object slot-name)
  (setf (gethash slot-name (object-slots object))
        value))

(defun instancep (object class)
  (subclassp (object-class object) class))

(defstruct generic-function
  (methods '()))

(defstruct method
  (specializer *object*)
  (function (error "No method function provided.")))

(defun find-method (gf specializer)
  (loop for method in (generic-function-methods gf)
        when (eql specializer (method-specializer method))
        return method))

(defun remove-method (gf method)
  (setf (generic-function-methods gf)
        (remove method (generic-function-methods gf))))

(defun add-method (gf method)
  (let ((old-method (find-method gf (method-specializer method))))
    (when old-method
      (remove-method gf old-method)))
  (push method (generic-function-methods gf)))

(defun compute-applicable-methods (gf receiver)
  (loop for method in (generic-function-methods gf)
        when (instancep receiver (method-specializer method))
        collect method))

(defun select-most-specific-method (methods)
  (loop with candidate = (first methods)
        for method in (rest methods)
        when (subclassp (method-specializer method)
                        (method-specializer candidate))
        do (setq candidate method)
        finally (return candidate)))

(defun call-generic-function (gf receiver &rest args)
  (let* ((applicable-methods (compute-applicable-methods gf receiver))
         (most-specific-method (select-most-specific-method applicable-methods)))
    (funcall (method-function most-specific-method)
             receiver args
             (remove most-specific-method applicable-methods))))

0 ответов

Другие вопросы по тегам