Multiple dispatch explanation from CLOS - ZhenyaKh/object-model GitHub Wiki
Для задания очередного конкретного метода мульти-метода m пользователь может писать так:
(def-method m [(:A1 obj1) (:A2 obj2) ... (:A_n obj_n) & args] ...body_here...)
Мульти-метод, также называемый generic function, - это метод с множественной диспетчеризацией. Теперь в таблице виртуальных функций мульти-метода m в качестве ключа хранится не один класс, а list из классов. Вот пример такой таблицы для мульти-метода m:
{'(:A1 :A2) fn[] (...),
'(:A1 :B2) fn[] (...),
'(:A2 :B1) fn[] (...),
'(:B1 :B2) fn[] (...),
'(:A1) fn[] ] (...),
'(:B1) fn[] (...),
'(:A1 :A2 ... :A_n) fn[] (...)
... и т.д. ... }
Из таблицы видно, что один и тот же метод m может использоваться как для множественной диспетчеризации:
например '(:A1 :A2) fn[] (...), '(:A1 :B2) fn[] (...), '(:A2 :B1) fn[] (...), '(:B1 :B2) fn[] (...) - это диспетчеризация по двум параметрам,
так и для одиночной: '(:A1) fn[] (...), '(:B1) fn[] (...).
То есть, свобода неограниченная. Метод m может диспетчеризоваться по одному, двум, трём, ... n параметрам в одной и той же программе. Всё это хранится в общей таблице виртуальных функций дженерика m.
Теперь нам остаётся реализовать perform-effective-command для множественной диспетчеризации. Я обнаружила не очень приятную вещь - сильно всё усложняющую. Дело в том, что для мульти-методов тоже можно вызывать "(call-next-method)". И там тогда совсем всё сложно получается.
Если, например, у нас есть иерархия A1 <- B1 <- C1 и иерархия A2 <- B2 <- C2, и есть мульти-метод (назовём его ride) типа (ride obj1 obj2), где obj1 - это объект некоторого класса из первой иерархии, а obj2 - это объект некоторого класса из второй иерархии, то пользователь может задать (3 * 3)=9 методов ride:
(ride A1, A2), (ride A1, B2), (ride A1, C2),
(ride B1, A2), (ride B1, B2), (ride B1, C2),
(ride C1, A2), (ride C1, B2), (ride C1, C2).
Нужно заметить, что порядок иерархий классов как аргументов мульти-метода имеет значение:
То есть, я могу плюс к уже имеющимся девяти методам ride добавить ещё девять:
(ride A2, A1), (ride A2, B1), (ride A2, C1),
(ride B2, A1), (ride B2, B1), (ride B2, C1),
(ride C2, A1), (ride C2, B1), (ride C2, C1).
И всё это будет работать в одной и той же программе и опять же храниться в одной и той же таблице виртуальных функций метода ride.
Я для примера создала мульти-метод ride на Common Lisp в файле c.cl, который прикрепляю ниже. Можно прямо запустить интерпретатор коммон лиспа sbcl и скопировать в него содержимое либо запустить с помощью команды (load "c.cl").
(defclass vehicle () ())
(defclass flying-vehicle (vehicle) ())
(defclass plane-vehicle (flying-vehicle) ())
(defclass driver () ())
(defclass human-driver (driver) ())
(defclass pilot-driver (human-driver) ())
(defgeneric ride (dr vh))
(defmethod ride ((dr driver) (vh vehicle))
(format t "DRIVER & VEHICLE~%"))
(defmethod ride ((dr driver) (vh flying-vehicle ))
(format t "DRIVER & FLYING-VEHICLE~%")
(call-next-method))
(defmethod ride ((dr driver) (vh plane-vehicle))
(format t "DRIVER & PLANE-VEHICLE~%")
(call-next-method))
(defmethod ride ((dr human-driver) (vh vehicle))
(format t "HUMAN-DRIVER & VEHICLE~%")
(call-next-method))
(defmethod ride ((dr pilot-driver) (vh vehicle))
(format t "PILOT-DRIVER & VEHICLE~%")
(call-next-method))
(defmethod ride ((dr human-driver) (vh flying-vehicle))
(format t "HUMAN-DRIVER & FLYING-VEHICLE~%")
(call-next-method))
(defmethod ride ((dr human-driver) (vh plane-vehicle))
(format t "HUMAN-DRIVER & PLANE-VEHICLE~%")
(call-next-method))
(defmethod ride ((dr pilot-driver) (vh flying-vehicle))
(format t "PILOT-DRIVER & FLYING-VEHICLE~%")
(call-next-method))
(defmethod ride ((dr pilot-driver) (vh plane-vehicle))
(format t "PILOT-DRIVER & PLANE-VEHICLE~%")
(call-next-method))
;;; let's check:
(defparameter pirx (make-instance 'pilot-driver))
(defparameter il-86 (make-instance 'plane-vehicle))
(ride pirx il-86)
-----------------------END--OF--FILE----------------------------
Вывод последней строки "(ride pirx il-86)" этого файла будет:
"PILOT-DRIVER & PLANE-VEHICLE
PILOT-DRIVER & FLYING-VEHICLE
PILOT-DRIVER & VEHICLE
HUMAN-DRIVER & PLANE-VEHICLE
HUMAN-DRIVER & FLYING-VEHICLE
HUMAN-DRIVER & VEHICLE
DRIVER & PLANE-VEHICLE
DRIVER & FLYING-VEHICLE
DRIVER & VEHICLE
NIL"
В данном случае у нас есть две иерархии:
DRIVER <- HUMAN-DRIVER <- PILOT-DRIVER
и
VEHICLE <- FLYING-VEHICLE <- PLANE-VEHICLE.
Напоследок, вот ещё один файл c_romb.cl, важный для понимания. После него идут пояснения.
(defclass vehicle () ())
(defclass fairy-vehicle (vehicle) ())
(defclass plane-vehicle (vehicle) ())
(defclass fairy-plane-vehicle (fairy-vehicle plane-vehicle) ())
(defclass driver () ())
(defclass pilot-driver (driver) ())
(defclass fairy-driver (driver) ())
(defclass fairy-pilot-driver (fairy-driver pilot-driver) ())
(defgeneric ride (dr vh))
;;1
(defmethod ride ((dr driver) (vh vehicle))
(format t "DRIVER & VEHICLE~%"))
;;2
(defmethod ride ((dr driver) (vh fairy-vehicle))
(format t "DRIVER & FAIRY-VEHICLE~%")
(call-next-method))
;;3
(defmethod ride ((dr driver) (vh plane-vehicle))
(format t "DRIVER & PLANE-VEHICLE~%")
(call-next-method))
;;4
(defmethod ride ((dr driver) (vh fairy-plane-vehicle))
(format t "DRIVER & FAIRY-PLANE-VEHICLE~%")
(call-next-method))
;;5
(defmethod ride ((dr pilot-driver) (vh vehicle))
(format t "PILOT-DRIVER & VEHICLE~%")
(call-next-method))
;;6
(defmethod ride ((dr pilot-driver) (vh fairy-vehicle ))
(format t "PILOT-DRIVER & FAIRY-VEHICLE~%")
(call-next-method))
;;7
(defmethod ride ((dr pilot-driver) (vh plane-vehicle))
(format t "PILOT-DRIVER & PLANE-VEHICLE~%")
(call-next-method))
;;8
(defmethod ride ((dr pilot-driver) (vh fairy-plane-vehicle))
(format t "PILOT-DRIVER & FAIRY-PLANE-VEHICLE~%")
(call-next-method))
;;9
(defmethod ride ((dr fairy-driver) (vh vehicle))
(format t "FAIRY-DRIVER & VEHICLE~%")
(call-next-method))
;;10
(defmethod ride ((dr fairy-driver) (vh fairy-vehicle ))
(format t "FAIRY-DRIVER & FAIRY-VEHICLE~%")
(call-next-method))
;;11
(defmethod ride ((dr fairy-driver) (vh plane-vehicle))
(format t "FAIRY-DRIVER & PLANE-VEHICLE~%")
(call-next-method))
;;12
(defmethod ride ((dr fairy-driver) (vh fairy-plane-vehicle))
(format t "FAIRY-DRIVER & FAIRY-PLANE-VEHICLE~%")
(call-next-method))
;;13
(defmethod ride ((dr fairy-pilot-driver) (vh vehicle))
(format t "FAIRY-PILOT-DRIVER & VEHICLE~%")
(call-next-method))
;;14
(defmethod ride ((dr fairy-pilot-driver) (vh fairy-vehicle ))
(format t "FAIRY-PILOT-DRIVER & FAIRY-VEHICLE~%")
(call-next-method))
;;15
(defmethod ride ((dr fairy-pilot-driver) (vh plane-vehicle))
(format t "FAIRY-PILOT-DRIVER & PLANE-VEHICLE~%")
(call-next-method))
;;16
(defmethod ride ((dr fairy-pilot-driver) (vh fairy-plane-vehicle))
(format t "FAIRY-PILOT-DRIVER & FAIRY-PLANE-VEHICLE~%")
(call-next-method))
;;; let's check:
(defparameter fairy-pirx (make-instance 'fairy-pilot-driver))
(defparameter fairy-il-86 (make-instance 'fairy-plane-vehicle))
(ride fairy-pirx fairy-il-86)
------------------------------------END--OF--FILE------------------------------
Здесь имеем две иерархии - каждая с ромбовидным наследованием.
Первая иерархия:
driver
fairy-driver pilot-driver
fairy-pilot-driver
То есть, fairy-driver и pilot-driver каждый наследуется от driver. А fairy-pilot-driver наследуется ромбовидно от fairy-driver и pilot-driver.
Вторая иерархия:
Fairy-vehicle и plane-vehicle наследуются от vehicle. А от них обоих наследует fairy-plane-vehicle. Тоже ромбовидное наследование. Так вот, при вызове:
"(defparameter fairy-pirx (make-instance 'fairy-pilot-driver))
(defparameter fairy-il-86 (make-instance 'fairy-plane-vehicle))
(ride fairy-pirx fairy-il-86)",
мы получим:
"FAIRY-PILOT-DRIVER & FAIRY-PLANE-VEHICLE
FAIRY-PILOT-DRIVER & FAIRY-VEHICLE
FAIRY-PILOT-DRIVER & PLANE-VEHICLE
FAIRY-PILOT-DRIVER & VEHICLE
FAIRY-DRIVER & FAIRY-PLANE-VEHICLE
FAIRY-DRIVER & FAIRY-VEHICLE
FAIRY-DRIVER & PLANE-VEHICLE
FAIRY-DRIVER & VEHICLE
PILOT-DRIVER & FAIRY-PLANE-VEHICLE
PILOT-DRIVER & FAIRY-VEHICLE
PILOT-DRIVER & PLANE-VEHICLE
PILOT-DRIVER & VEHICLE
DRIVER & FAIRY-PLANE-VEHICLE
DRIVER & FAIRY-VEHICLE
DRIVER & PLANE-VEHICLE
DRIVER & VEHICLE
NIL"
То есть, и здесь всё отрабатывает по полной программе.
Ещё, нам понадобился пример для диспетчеризации по трём параметрам (файл "c_triple_dispatch.cl"):
(defclass A1 () ())
(defclass B1 (A1) ())
(defclass A2 () ())
(defclass B2 (A2) ())
(defclass A3 () ())
(defclass B3 (A3) ())
(defgeneric ride (obj1 obj2 obj3))
(defmethod ride ((obj1 A1) (obj2 A2) (obj3 A3))
(format t "A1 & A2 & A3~%"))
(defmethod ride ((obj1 A1) (obj2 A2) (obj3 B3))
(format t "A1 & A2 & B3~%")
(call-next-method))
(defmethod ride ((obj1 A1) (obj2 B2) (obj3 A3))
(format t "A1 & B2 & A3~%")
(call-next-method))
(defmethod ride ((obj1 A1) (obj2 B2) (obj3 B3))
(format t "A1 & B2 & B3~%")
(call-next-method))
(defmethod ride ((obj1 B1) (obj2 A2) (obj3 A3))
(format t "B1 & A2 & A3~%")
(call-next-method))
(defmethod ride ((obj1 B1) (obj2 A2) (obj3 B3))
(format t "B1 & A2 & B3~%")
(call-next-method))
(defmethod ride ((obj1 B1) (obj2 B2) (obj3 A3))
(format t "B1 & B2 & A3~%")
(call-next-method))
(defmethod ride ((obj1 B1) (obj2 B2) (obj3 B3))
(format t "B1 & B2 & B3~%")
(call-next-method))
;;; let's check:
(defparameter inst1 (make-instance 'B1))
(defparameter inst2 (make-instance 'B2))
(defparameter inst3 (make-instance 'B3))
(ride inst1 inst2 inst3)
------------------------------------END--OF--FILE------------------------------
Вот что выводит команда (ride inst1 inst2 inst3):
"B1 & B2 & B3
B1 & B2 & A3
B1 & A2 & B3
B1 & A2 & A3
A1 & B2 & B3
A1 & B2 & A3
A1 & A2 & B3
A1 & A2 & A3
NIL"