Some time back I posted a macro that builds a class that implements
delegation rather than conventional inheritance. I don't know if
anyone is using it, but I've just made a small improvement that
improves the handling of initialization. The only restriction now is
that if you define your own initialize method for such a class,
instead of calling (next-method) you must call (%initialize-object
self args). Here is the new version of the define-filtered macro:
(If anyone is using this I'd *love* to hear about it. But I know
you're not...)
----------- Cut Here ------------------
; delegation.scm
; Copyright (c) 1996,1997 - David Fox.
(define-macro (define-filtered 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))
(define-method initialize ((self ,name) args)
(%initialize-object self args))))
(provide "delegation")
------------ Cut Here -----------------
Here is an example of its use:
------------ Cut Here -----------------
(require "delegation")
(define-class <point> ()
((x :init-keyword :x :accessor x)
(y :init-keyword :y :accessor y)))
(define-filtered <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.))
(slot-set! p 'x 1.)
(format (current-output-port) "p3.x = ~s (should be 1.)\n" (slot-ref p3 'x))
------------ Cut Here -----------------
--
David Fox http://www.cat.nyu.edu/fox xoF divaD
NYU Media Research Lab fox_at_cat.nyu.edu baL hcraeseR aideM UYN
Received on Mon Jan 06 1997 - 15:44:15 CET