=============================================================================
	      CLOVERS-Style Delegation in CLOS            Ver.0.1
 =============================================================================

Preface
-------

The following presumes familiarity with CLOS and some familiarity with the
terms CLASS-INHERITANCE and DELEGATION (a.k.a. INSTANCE-INHERITANCE).

Intro
-----

 Delegation differs from class-inheritance in that in a delegation system we
have ``slot-inheritance'' in addition to the normal method inheritance and
slot-initarg/initform/etc inheritance.  By that, I mean shadowed direct slots
are accessible by chasing down the delegation chain.

 For instance if PERSONs and STUDENTs both have direct NICKNAME slots and
STUDENT delegates to (thus is a subclass of) PERSON, then we can ask an
instance of a STUDENT for NICKNAME and get the STUDENT NICKNAME but we should
also have some means of accessessing the STUDENT's shadowed PERSON NICKNAME as
well.

Sample Scenario
---------------

 To provide us a concrete scenario on which to base our correspondence,
consider:

---------------------------------------------------------------------------
;;
;; Delegate meta-class (slightly simplified from the example code on Zermatt
;;                      ...here I've used DELEGATE where there I say CLOVER
;;                      because here I avoid raising issues of COERCE+/-)

(defclass delegate-class  (standard-class) ())

(defclass delegate-object ()
  (;; Each delegate-object will maintain a list of instances to which it
   ;; delegates. These are called the direct delegates. They will be sorted
   ;; by class according to the DIRECT-SUPERCLASSES of the instantiated
   ;; delegate-object. There most be exactly one delegate for each direct-
   ;; superclass.
   (direct-delegates         :accessor direct-delegates :initarg :delegates-to)

   ;; Also, each delegate maintains a list of *all* delegates (reflex-trans closure)
   ;; it has, stable sorted by class wrt the CLASS-PRECEDENCE-LIST of the
   ;; instantiated delegate-object
   (delegate-precedence-list :accessor delegates*))
  (:metaclass delegate-class))

;; Grumble....

(defmethod validate-superclass ((class-prototype delegate-class )
	                        (superclass      standard-class )) t)
(defmethod validate-superclass ((class-prototype delegate-object)
	                        (superclass      delegate-class )) t)

;; STUDENT          |
;;   :stud-id       |----\
;;   :nickname      |     \
;;                         |--->  PERSON
;; TROLL            |     /         :name
;;   :stench-factor |----/          :nickname
;;   :nickname      |

(defclass person (delegate-object)
  ((name     :accessor name     :initarg :name)
   (nickname :accessor nickname :initarg :nickname))
  (:metaclass delegate-class))


(defclass student (person)
  ((id-num   :accessor stud-id  :initarg :stud-id )
   (nickname :accessor nickname :initarg :nickname))
  (:metaclass delegate-class))


(defclass troll (person)
  ((stench-factor :accessor stench   :initarg :stench)
   (nickname      :accessor nickname :initarg :nickname :initform 'hairy))
  (:default-initargs :stench 10)
  (:metaclass delegate-class))


(defclass studtroll (student troll) ()
  (:metaclass delegate-class))

(defclass trollstud (troll student) ()
  (:metaclass delegate-class))

;; The action starts here...

(setq       persy (make-instance 'person    :name     'persy))

(setq studn-persy (make-instance 'student   :nickname 'persy-stud
	                                    :delegates-to persy))

(setq troll-persy (make-instance 'troll     :delegates-to persy))

(setq    st-persy (make-instance 'studtroll :nickname 'stroll-persy
                                            :delegates-to (list studn-persy
	                                                        troll-persy)))

(setq    ts-persy (make-instance 'trollstud :delegates-to (list troll-persy
							        studn-persy)))


(setq studn-bruno (make-instance 'student   :nickname 'bruno))
(setq    ts-bruno (make-instance 'trollstud :nickname 'ts-bruno
	                                    :delegates-to (list troll-persy
								studn-bruno)))

(slot-boundp studn-bruno 'name) ;; ==> NIL (no delegates provided for bruno say
                                ;;          we generate fresh instances for him)

(setf (slot-value studn-bruno 'name) 'brunowsky)

(find-slot-value ts-bruno 'nickname
   #'(lambda (obj) (eq (class-of obj) (find-class 'student))))  ;; ==> BRUNO

---------------------------------------------------------------------------

Implementation Strategy
-----------------------

 Now how do we implement this? My strategy is to automagically get all the
ducky method/slot-initarg/initform/accessor/etc mechanism from vanilla CLOS,
including the structuring of the class-precedence-list. I intend to built atop
this in as consistent a manner as possible so, for example, the ordering of
DELEGATES* of a delegate object will follow the class-precedence-list.

 What prevents what I have shown so far from being a working hack is: how do
we access a shadowed slot? How do I make an indirect slot share its storage
cell with (i.e., be EQ to) the corresponding slot of the delegate to which it
delegates?

 My initial approach was to try to arrange for only the direct slots to be
allocated when an instance of a delegate-object is instantiated while still
inheriting the default accessor methods of the superclass as well as its
slot-definition meta-objects (to do initarg/initform hacking). Alas, I could
find no way to tell ALLOCATE-INSTANCE to allocate space for only the directs.

 To continue, I specialize SLOT-VALUE-USING-CLASS so that an attempt to access
an indirect slot of a delegate-object would defer to the first object in
DELEGATES* which has the desired slot as a direct slot.  Similarly for
SLOT-BOUNDP,etc.  If we desire to access other than the first such delegate, we
use a generalized SLOT-VALUE-USING-CLASS,etc to take an optional predicate to
return true at the first desired instance found.  This enables access to
shadowed slots.  Of course, the new optional arg is incongruent with the system
default definition of SLOT-VALUE-USING-CLASS so I had to name this generalized
function FIND-SLOT-...

 Of course, this would be tiresome to travel the DELEGATES* list with each
access to an indirect slot (or predicated shadow access) so some degree of
hashing/caching/memoization would be in order. Currently, since the indirect
slots are allocated anyway, I arrange for them to contain a chain of the
relevant delegates in the same order they appear within DELEGATES*. Since
direct slots can shadow indirect slots, I also arrange for direct slots to
actually contain a chain of relevant delegates, the first of which is the
present object. Rhetorical question: But if the direct slot is made to contain
a chain of relevant objects, where is the intended *value* for that direct slot?
Well, OK, the chain is actually a chain of STORAGE-CELLs where a storage cell
contains a VALUE and an OBJECT (e.g., could be a cons cell w/ value in CAR and
object in CDR).

 The magic is that if I teach SLOT-VALUE/SLOT-BOUND-P/SLOT-MAKUNBOUND/etc about
this arrangement of DELEGATE-OBJECTs, then everything else in CLOS comes for
free, like slot-definition meta-objects for initarg inheritance, all the method
inheritance, accessor/reader/writer generation, class-precedence-list ordering
on superclasses, re-initialize-instance, and lots o' user transparent
optimizations.

 The only catch is teaching SHARED-INITIALIZE that after it has done what it
thinks it needs to do to make a DELEGATE-OBJECT, it needs to handle the
:DELEGATES-TO initarg and fill in the DELEGATES* slot then arrange to grovel
the slots to contain chains of STORAGE-CELLs as described above. This is not
much work [the code is publically readable in ZERMATT.LCS.MIT.EDU
>ZIGGY>CLOVERS>CLOVERS.LISP.??? where ??? is the latest version number and on
RICE-CHEX.AI.MIT.EDU:/home/jj/ziggy/Clovers/clovers.lisp.???] 

A Fly in the Ointment
---------------------

 So, where am I stuck now?  Currently, I am being scrod by the automatically
generated :accessor/:reader/:writer methods on classes of instance
DELEGATE-CLASS.  The automatically generated methods apparently have in-line
coded the standard system SLOT-VALUE[-USING-CLASS] (as the CLOS X3J13 88-002R
warns it can) so that they return chains of STORAGE-CELLs (after all, that's
what's *really* in those slots) rather than the value of the first cell in the
chain (like I thought I taught SLOT-VALUE-USING-CLASS to do [See code]).  Of
course, I can just always avoid using the automatically generated accessors in
my code (and document that this feature is not supported in my delegation
implementation), but I can't help thinking there is something easy I can do
without resorting to ferreting out the generated accessors and manually
replacing them in the SHARED-INITIALIZE after method with hand re-assembled
methods.

 Am I missing something subtle or is my CLOS implementation taking illegal
license--- in view of my having taught it about specialized
SLOT-VALUE-USING-CLASS stuff, I would expect it to in-line my specialized
methods--- or do I need some hook into the implementation to specialize how
these reader and writer methods are generated?  I am trying to restrict myself
to using only mechanisms alluded to in X3J13 88-003 and Part II of AMOP (like
ADD-METHOD, but not ADD-READER-METHOD) so my code will be portable.

Meta-Meta Hubba-Hubba: Why not just do things Gregor's way?
-----------------------------------------------------------

So, am I on the wrong track or has what I've done been reasonable?  I am still
trying to see how the meta-code meta-suggestions meta-Gregor meta-sent me might
bail me out of this situation (namely, using GET-INVOCATOR hacks and the GET-QUA
hack).  I don't understand how the QUA/GET-QUA code fits into the scheme of
things (what is ``q u a'' abbreviating here?).  It would be lovely to pull this
off with MOP hacks, but my brain is still too muddled to see how.  I'll keep
you all posted.

 --ziggy