Dynamic Inheritance in STklos

From: David Fox <fox_at_graphics.cs.nyu.edu>
Date: 25 Sep 1996 22:28:42 -0400

I've implemented something I'm calling Dynamic Inheritance in STklos
(it seems to resemble something called that, but I haven't found a
clear enough description to be sure.) What I'm referring to is
creating an object which you can dynamically assign a parent
*instance* to at the time it is constructed.

This is useful to me, because I want to create "filters" - think of
placing this filter over a bunch of objects and now you have a new set
of objects of a class derived from the class of the corresponding old
object. I don't want to allocate completely new objects, because I
want any changes to be reflected in the old objects after the derived
objects go away, and it would waste time and space to do so.

I found out you can change an objects direct-super list and re-compute
its class precedence list, effectively changing its type. I came up
with the following "define-filter" macro which is similar to define-class:

(define-macro (define-filter name supers slots . options)
  `(begin
     (define-class ,name ()
       ,(append
         (list '(super :init-keyword :super))
         slots
         (map (lambda (slot)
                `(,(car slot)
                  :allocation :virtual
                  :slot-ref
                  (lambda (self)
                    (slot-ref (slot-ref self 'super) ',(car slot)))
                  :slot-set!
                  (lambda (self v)
                    (slot-set! (slot-ref self 'super) ',(car slot) v))))
              (slot-ref (eval (car supers)) 'slots))
         ))
     (slot-set! ,name 'direct-supers (list ,(car supers)))
     (slot-set! ,name 'cpl (compute-cpl ,name))

     ; Create an initializer that initializes the super slot and does
     ; *not* call next-method, so that the constructors for the
     ; ``pseudo'' base classes are not invoked on the already
     ; constructed object.

     (define-method initialize ((self ,name) args)
       (slot-set! self 'super (get-keyword :super args)))
     ))

Ok, what's happening is I build a new slot list with virtual slots
to get at all the super class slots. I also add a "super" slot to
hold the super class instance. Then I change the object's base
class and recompute its cpl.

As an example, consider a simple point class:

(define-class <point> ()
  ((x :init-keyword :x :accessor x)
   (y :init-keyword :y :accessor y)))

Lets create a class that filters {\tt <point>} which adds a slot to
store a third coordinate:

(define-filter <3d-point> (<point>)
  ((z :init-keyword :z :accessor z)))

(define p (make <point> :x 3. :y 4.))
(define p3 (make <3d-point> :super p :z 5.))

After executing the above code, we can look at the description of dp
and see it does indeed have the slots of p. Furthermore, if we change
a slot of p the corresponding slot of p3 changes as well:

STk> (describe p3)
#[<3d-point> 8044120] is an instance of class <3d-point>
Slots are:
     z = 5.0
     super = #[<point> 8044b88]
     x = 3.0
     y = 4.0
#f
STk> (slot-set! p 'x 1.)
#[undefined]
STk> (describe p3)
#[<3d-point> 8044120] is an instance of class <3d-point>
Slots are:
     z = 5.0
     super = #[<point> 8044b88]
     x = 1.0
     y = 4.0
#f
STk>

The difficulty comes in the initializer. Here I define an initializer
which is fine for classes that don't need to define their own. You
can't call (next-method) because you'll invoke the real super class
constructor on an object that has already been constructed. Thus,
the :initforms don't work. If you define your own initializer you
have to initialize the super slot explicitly, as above, and you
have to initialize the object slots there too.

Sorry to ramble on so, I hope it makes some sense. I guess these are
minor drawbacks, but if anyone has any thoughts about a better way to
do this, please let me know. (Erick?)
-- 
David Fox	   http://found.cs.nyu.edu/fox		xoF divaD
NYU Media Research Lab   fox_at_cs.nyu.edu    baL hcraeseR aideM UYN
Received on Thu Sep 26 1996 - 04:28:08 CEST

This archive was generated by hypermail 2.3.0 : Mon Jul 21 2014 - 19:38:59 CEST