compute-effective-slot-definition の第三引数がリストであることの理由

どうして compute-effective-slot-definition の第三引数が direct-slot-definition ではなく direct-slot-definition のリストなんだろう？ と不思議に思っていた。リストだとディスパッチできないじゃないか、って。

Elephant のソースにこんなコメントを見つけた。

    ;; Effective slots are indexed only if the most recent slot definition
    ;; is indexed.  NOTE: Need to think more about inherited indexed slots

なるほど、継承関係で同じスロット名が複数あったときのためにリストなんだ。

(defclass a ()
  ((s1 :initarg :s1 :initform "a" :accessor s1)))

(defclass b ()
  ((s1 :initarg :s1 :initform "b" :accessor s1)))

(defmethod sb-mop:compute-effective-slot-definition :before
  ((class standard-class)
   slot-name
   direct-slot-definitions)
  (print "%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%")
  (mapc #'describe direct-slot-definitions)
  (print "~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~"))

(defclass c (b a)
  ())

(make-instance 'c)

#|
"%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%"
#<SB-MOP:STANDARD-DIRECT-SLOT-DEFINITION S1>
  [standard-object]

Slots with :INSTANCE allocation:
  NAME                  = S1
  INITFORM              = "b"
  INITFUNCTION          = #<FUNCTION (LAMBDA ()) {1004B24749}>
  READERS               = (S1)
  WRITERS               = ((SETF S1))
  INITARGS              = (:S1)
  %TYPE                 = T
  %TYPE-CHECK-FUNCTION  = NIL
  %DOCUMENTATION        = NIL
  %CLASS                = #<STANDARD-CLASS B>
  ALLOCATION            = :INSTANCE
  ALLOCATION-CLASS      = NIL
#<SB-MOP:STANDARD-DIRECT-SLOT-DEFINITION S1>
  [standard-object]

Slots with :INSTANCE allocation:
  NAME                  = S1
  INITFORM              = "a"
  INITFUNCTION          = #<FUNCTION (LAMBDA ()) {1004B18B99}>
  READERS               = (S1)
  WRITERS               = ((SETF S1))
  INITARGS              = (:S1)
  %TYPE                 = T
  %TYPE-CHECK-FUNCTION  = NIL
  %DOCUMENTATION        = NIL
  %CLASS                = #<STANDARD-CLASS A>
  ALLOCATION            = :INSTANCE
  ALLOCATION-CLASS      = NIL

"~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~"
|#

リストであることの理由は納得できたけど、どうにもスロットのクラスによってディスパッチしにくいことについては、納得いかない。

manardb でも苦肉のスペシャル変数で回避しているようだし。どうにかならないものでしょうか。

(defvar *mop-hack-effective-slot-definition-class* nil) ;; as compute-effective-slot-definition-initargs is not available portably

といいつつも、manardb でやっているように、なんとか回避できる手段があるところが Common Lisp のいいところだよね。