;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; $Id: roos.scm,v 1.38.2.7 2006/01/02 21:03:31 HansOesterholt Exp $ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; $Log: roos.scm,v $ ; Revision 1.38.2.7 2006/01/02 21:03:31 HansOesterholt ; no message ; ; Revision 1.38.2.6 2005/12/30 00:25:17 HansOesterholt ; - ROOS Manual is OK now. ; - Next. Deliver a PLaNET Package? ; ; Revision 1.38.2.5 2005/12/28 22:55:03 HansOesterholt ; Made roos ready for PLT distribution ; ; Revision 1.38.2.4 2005/11/22 22:41:46 HansOesterholt ; Added a 'roos-dispatch' procedure to be able to ; dispatch functions as symbols, i.e. ; ; (roos-dispatch object 'function a1 ...) ; ; instead of ; ; (-> object function a1 ..) ; ; Revision 1.38.2.3 2005/11/06 17:35:09 HansOesterholt ; ROOS has been fully reprogrammed for mzscheme.\nA new type "#roos" has been made,\nand the main administrative functions have been recoded in C,\nwhich makes ROOS a lot faster. ; ; Revision 1.38.2.2 2005/11/06 11:21:24 HansOesterholt ; *** empty log message *** ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (module roos mzscheme (require "c-roos.scm") (define (displayp . args) (define (f l) (if (null? l) (newline) (begin (display (car l)) (f (cdr l))))) (f args)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;=head1 ROOS implementation ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;=head2 Info ; ;S<C<Author(s):>> Hans Oesterholt-Dijkema (hansatelementalprogrammingdotorgextension).E<lb> ;S<C<Copyright:>> (c) 2004/2005.E<lb> ;S<C<License :>> LGPL ;S<C<File :>> roos.scm $Revision: 1.38.2.7 $; ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;=head2 Error handling ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; ;The internal function C<%roos-raise> raises an error situation, if ;possible, within the scheme variant, or else, displays an ;error to the current output port. ; ;=verbatim scm,8 (define (%roos-raise . args) (let ((msg (apply string-append args))) (error msg) )) ;=verbatim ; ;The %roos-invalid function will raise an error, after an object ;has been invalidated by roos-cleanup, or (-> obj roos-cleanup) ; ;=verbatim scm,8 (define (%roos-invalid . args) (%roos-raise "This object has been invalided")) ;=verbatim ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;=head2 Storage ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; ;This section implements storage facilities for ROOS. ;The implementation differs for different scheme dialects. ;For performance reasons, a hash is being used if possible. ;In all other cases, a list implementation of the storage ;is used. ; ;The storage interface stores (item, value) pairs in a ;container, which can be a hash or a list, depending ;on the scheme variant. ; ;To create a container, the internal function C<%roos-make-container> ;is defined. ; ;=verbatim scm,8 (define-syntax %roos-make-container (syntax-rules () ((_) (make-hash-table)))) ;=verbatim ; ;To put (item value) pairs in a container, the C<%roos-put-container> ;function has been defined. ; ;=verbatim scm,8 (define-syntax %roos-put-container (syntax-rules () ((_ C item value) (hash-table-put! C item value)))) ;=verbatim ; ;A specialized function has been created to register ;functions for classes. These functions are registered ;with a type indicator (e.g. private or public). ; ;=verbatim scm,8 (define-syntax %roos-register-item (syntax-rules () ((_ L type item value) (%roos-put-container L item (cons type value))))) ;=verbatim ; ;With the assoc function, the registed items can be ;retreived. ; ;=verbatim scm,8 (define-syntax %roos-assoc (syntax-rules () ((%roos-assoc %m %members) (hash-table-get %members %m (lambda () #f))))) ;=verbatim end ; ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;=head2 Registering class definitions ; ;To register class definitions, a global container is ;defined. In this container, all class definitions ;are registered. ; ;I<This makes it undesirable to register classes locally ;within a closure (unless locally within a class definition) ;because they are referenced forever, and therefore will ;make those closures live forever>. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; ;=verbatim scm,8 (define %roos-class-definitions (%roos-make-container)) (define %roos-class-symbols (%roos-make-container)) (define (%roos-is-class? class) (let ((c (%roos-assoc class %roos-class-definitions))) (eq? c class))) (define-syntax %roos-get-class-symbol (syntax-rules () ((_ class) (%roos-assoc class %roos-class-symbols)))) (define (%do-roos-register-class class classname) (begin (%roos-put-container %roos-class-definitions class class) (%roos-put-container %roos-class-symbols class classname))) (define-syntax %roos-register-class (syntax-rules () ((_ class) (%do-roos-register-class class 'class)))) (define-syntax %roos-register-class-name1 (syntax-rules () ((_ (%name . %arguments1)) (%roos-register-class %name)) ((_ (%name %arg1 . %arg2)) (%roos-register-class %name)) ((_ (%name args ...)) (%roos-register-class %name)) ((_ (%name)) (%roos-register-class %name)))) (define-syntax %roos-register-class-name (syntax-rules () ((_ %def) (%roos-register-class-name1 %def)) ((_ %def . %no) (%roos-register-class-name1 %def)))) (define-syntax %roos-get-class-name1 (syntax-rules () ((_ (%name . %arguments1)) '%name) ((_ (%name %arg1 . %arg2)) '%name) ((_ (%name args ...)) '%name) ((_ (%name)) '%name))) (define-syntax %roos-get-class-name (syntax-rules () ((_ %def) (%roos-get-class-name1 %def)) ((_ %def . %no) (%roos-get-class-name1 %def)))) ;=verbatim ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;=head2 Object administration and utility functions ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; ;Functions are provided to find members, propagate the 'self' ;notice upward to super classes and do function application. ; ;With the C<%roos-find-member-in-supers> function, a function or ;member variable can be found in an instantiated object. ; ;=verbatim scm,8 (define (%roos-find-member-in-supers %supers %get-mem) (define (%find %supers) (if (null? %supers) 'roos-not-found (let ((%member (((cadar %supers) '%find-member) %get-mem))) (if (eq? %member 'roos-not-found) (%find (cdr %supers)) %member)))) (%find %supers)) (define %roos-find-member-in-proxies %roos-find-member-in-supers) ;=verbatim ; ;With the C<%roos-propagate-this> function, propagation of ;the notice of 'self' is provided to super classes. ;This function interacts with a function provided within ;the class self. ; ;=verbatim scm,8 (define (%roos-propagate-this %supers %this) (for-each (lambda (%super) (begin (((cadr %super) '%propagate-this) %this) (((cadr %super) '%set-this) %this))) %supers)) ;=verbatim ; ;The C<%roos-apply> function is used to do function ;application. However it only applies a function, if ;it's not a private one. ; ;=verbatim scm,8 (define (%roos-apply %mem . %args) (let* ((%type (car %mem)) (%func-or-var (cdr %mem))) (if (eq? %type 'private) 'roos-private (cond ((procedure? %func-or-var) (apply %func-or-var %args)) (else 'roos-unexpected))))) ;=verbatim ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;=head2 Macros for class definitions ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; ;Internal macros for defining (parts of) a class are defined ;below. ; ;The C<%roos-def> macro wraps defines for functions and ;variables. ; ;=verbatim scm,8 (define-syntax %roos-def (syntax-rules () ((_ (define (function . arguments1) body ...)) (define (function . arguments1) body ...)) ((_ (define (function arguments1 . arguments2) body ...)) (define (function arguments1 . arguments2) body ...)) ((_ (define (function arguments ...) body ...)) (define (function arguments ...) body ...)) ((_ (define (function argument) body ...)) (define (function argument) body ...)) ((_ (define variable argument)) (define variable argument)))) (define-syntax %roos-body (syntax-rules () ((_) (%roos-body #t)) ((_ body ...) (begin body ...)))) ;=verbatim ; ;The C<%roos-register> macro registers the with C<%roos-def> ;defined functions in a given container. ; ;=verbatim scm,8 (define-syntax %roos-register (syntax-rules () ((%roos-register L type (define (function . arguments1) body ...)) (c-roos-add-member L type 'function function)) ((%roos-register L type (define (function arguments1 . arguments2) body ...)) (c-roos-add-member L type 'function function)) ((%roos-register L type (define (function arguments ...) body ...)) (c-roos-add-member L type 'function function)) ((%roos-register L type (define (function argument) body ...)) (c-roos-add-member L type 'function function)) ((%roos-register L type (define variable argument)) (c-roos-add-member L type 'variable (lambda args (if (not (null? args)) (set! variable (car args))) variable))))) (define-syntax %roos-register-member (syntax-rules () ((_ a1 ...) (c-roos-add-member a1 ...)))) ;=verbatim ; ;The C<%roos-class> macro is used to define a class. This macro ;is quite complex. It defines a procedure that returns a closure. ; ;The returned closure has a number of internal procedures to ;handle administrative tasks (like propagating and setting 'this', ;finding member functions in the class inheritance, calling ;member functions, etc.). ; ;The macro defines a number of containers and lists to keep ;member functions and super classes. ; ;The provided definitions in the 'this', 'supers', 'private', ;'public', 'constructor', 'explicit-cleanup' and 'body' ;parts of the C<%roos-class> are used ;to construct a closure definition that can be used to construct ;objects of the class to be defined. ; ;Because the 'this' part can optionally contain extra variable ;declarations, the whole thing becomes a complex closure. ; ;The order of construction is as follows: supers are constructed ;first in order of appearance. After that the construction part ;(the body) of defined class is executed. ; ;Macro definition: ; ;=verbatim scm,8 (define-syntax %roos-define-class (syntax-rules () ((_ (%class-definition . %declarations) body) (define %class-definition body)))) (define-syntax %roos-declarations (syntax-rules () ((_ (a) (body)) body) ((_ (a . (p1 ...)) . (body)) (let* (p1 ...) body)))) (define-syntax %roos-class (syntax-rules () ((%roos-class ((this %class-definition ...) (supers %class-instance1 ...) (%private %private-memberdef1 ...) (%public %memberdef1 ...) (%constructor %body ...) (%explicit-cleanup %clbody ...))) ;=verbatim ; ;The class definition consists of two parts. The definition ;of a new procedure with which new objects can be constructed, ;and the registration of the defined class. ; ;=verbatim scm,8 (begin ;=verbatim ; ;The class definition follows. The '*this' closure will ;eventually be returned. ; ;=verbatim scm,8 (%roos-define-class (%class-definition ...) (%roos-declarations (%class-definition ...) (letrec ((*this ;=verbatim ; ;Define containers and needed administrative variables ; ;=verbatim scm,8 (let* ((this #f) (supers #f) (%cobj (c-roos-new (%roos-get-class-name %class-definition ...) (lambda (t) (set! this t)) (list %class-instance1 ...)))) ;=verbatim ; ;Define administrative procedures needed for objects. ; ;=verbatim scm,8 (define (roos-cleanup) (let ((R (%roos-body %clbody ...))) (c-roos-supers-for-each %cobj (lambda (obj) (-> obj roos-cleanup))) (c-roos-invalidate %cobj) R)) (define (roos-add-proxy proxy-obj) (c-roos-add-proxy %cobj proxy-obj) this) ;=verbatim ; ;Define private members, public members and the constructor (using the body). ; ;=verbatim scm,8 (%roos-def %private-memberdef1) ... (%roos-def %memberdef1) ... (%roos-def (define (%construct) (%roos-body %body ...))) ; (define (%this) this) ; (define (%supers) supers) ;=verbatim ; ;register some administrative members that must be called from the outside ;of an object. ; ;=verbatim scm,8 (%roos-register-member %cobj 'public 'roos-cleanup roos-cleanup) (%roos-register-member %cobj 'public 'roos-add-proxy roos-add-proxy) ;=verbatim ; ;register private, public members and constructor in the %members structure. ; ;=verbatim scm,8 (%roos-register %cobj 'private %private-memberdef1) ... (%roos-register %cobj 'public %memberdef1) ... (%roos-register %cobj 'public (define (%construct) (%roos-body %body ...))) ; (%roos-register %cobj 'public (define (%this) this)) ; (%roos-register %cobj 'public (define (%supers) supers)) ;=verbatim ; ;Set the 'supers' variable (later the 'this' variable will be set), to ;be able to call supers. ; ;=verbatim scm,8 (set! supers (c-roos-new-super %cobj)) ;=verbatim ; ;The C<%call-member> function is returned to handle object calls. ; ;=verbatim scm,8 %cobj))) ;=verbatim ; ;'*this' is now defined, now handle some instantiation administration. ;Set the 'this' variable, propagate the 'this' variable to the super ;classes and call the constructor of the class. ; ;=verbatim scm,8 (let ((%object *this)) (c-roos-set-this %object %object) (c-roos-call-member %object '%construct) ;=verbatim ; ;Return the pair C<('roos-this *this)>. The object has been instantiated. ; ;=verbatim scm,8 %object) ))) ;=verbatim ; ;Now the class has been defined. Register the class in the class register. ; ;=verbatim scm,8 (%roos-register-class-name %class-definition ...))))) ;=verbatim ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;=head2 The interface macro for class definitions ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; ;C<r-class> defines the interface macro for class definitions. ;It's simply a wrapper around %roos-class. Does nothing ;interesting, but making C<explicit-cleanup> optional. ; ;=verbatim scm,8 (define-syntax def-class (syntax-rules () ((_ (this %this ...) (supers super1 ...) (private private1 ...) (public public1 ...) (constructor c1 ...)) (def-class (this %this ...) (supers super1 ...) (private private1 ...) (public public1 ...) (constructor c1 ...) (explicit-cleanup #t))) ((_ (this %this ...) (supers super1 ...) (private private1 ...) (public public1 ...) (constructor c1 ...) (explicit-cleanup cln1 ...)) (%roos-class ((this %this ...) (supers super1 ...) (private private1 ...) (public public1 ...) (constructor c1 ...) (explicit-cleanup cln1 ...)))))) ;=verbatim ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;=head2 Predicates ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; ;C<object?> is an object predicate. It simply checks if ;an object is a list. If so, it checks wether the car of ;the object is C<'roos-this> or C<'roos-supers> and if ;the cadr of the object is a procedure. If so, it assumes ;that the list is indeed an instance of a roos class. ; ;I<Note that all roos objects are also lists. For each ;roos object (list? object) -> #t>. As redefinition of ;scheme primitives not always yields expected results, ;no attempt is made to redefine the C<list?> primitive, ;to exclude a variable that is an object from being a list. ; ;=verbatim scm,8 ;=verbatim ; ;The C<class?> predicate checks if an object is part ;of the registered classes. It's simply a call to the ;earlier defined C<%roos-is-class?> procedure. ; ;=verbatim scm,8 (define (class? obj) (%roos-is-class? obj)) ;=verbatim ; ;The C<class=?> predicate checks if an object 'obj' is of ;the class given by 'class', where 'class' is a symbol. ;Calling this function on any 'this' variable within an ;object, will yield true for all the classes, of which ;'obj' is made of, see also the C<class> function. ; ;=verbatim scm,8 (define (class=? obj class) (let ((s (if (class? class) (%roos-get-class-symbol class) (if (procedure? class) '%roos-no-class-def class)))) (c-roos-class-is obj s))) ;=verbatim ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;=head2 Meta information ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; ;The C<class> function gets all classes, an object 'obj' ;is made of. ; ;=verbatim scm,8 (define (class obj) (if (object? obj) (c-roos-class obj) #f)) ;=verbatim ; ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;=head2 Calling members ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; ;C<-E<gt>> calls a member of an object. Note: member ;variables are wrapped in a special function. See the ;C<%roos-register> macro earlier. Suppose a class has ;a public member variable 'm', with value 10, then ;this member variable ;is accessible as follows using '-E<gt>': ; ;=over 1 ; ;C<(display (-E<gt> object m)) =E<gt> 10)> ; ;C<(-E<gt> object m (+ (-E<gt> object m) 5)) =E<gt> 15> ; ;=back ; ;=verbatim scm,8 (define-syntax -> (syntax-rules () ((_ obj f) (c-roos-call-member obj 'f)) ((_ obj f a1 ...) (c-roos-call-member obj 'f a1 ...)))) (define-syntax ->> (syntax-rules () ((_ obj f) (c-roos-get-member obj 'f)))) (define (roos-dispatch obj f . args) (apply c-roos-call-member (cons obj (cons f args)))) ;=verbatim ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;=head2 Calling members via generic macros ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; ;Here a very simple generic "function" interface is ;given. Simply define a class member as generic, ;possibly renaming it at the outside, and call ;it on any object for which C<object?> returns true. ; ;It will translate the call C<(f object arg1 arg2 ...)> ;into C<(-> object f arg1 arg2 ...)>. ; ;=verbatim scm,8 (define-syntax %roos-generic-intern (syntax-rules () ((_ object f) (-> object f)) ((_ object f (a1 ...)) (-> object f a1 ...)))) (define-syntax def-generic (syntax-rules () ((_ generic-function) (def-generic generic-function generic-function)) ((_ generic-function object-function) (define-syntax generic-function (syntax-rules () ((_ object) (%roos-generic-intern object object-function)) ((_ object . arguments) (%roos-generic-intern object object-function arguments))))))) ;=verbatim ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;=head2 Roos cleanup ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; ;C<roos-cleanup> or C<-E<lt>> can be used to call the default ;C<explicit-cleanup> member that can be used to cleanup an object explicitly. ;After roos-cleanup is called, an object is invalidated. ;See also L<Using ROOS|Manual and examples of ROOS>. ;You can test on an invalid object using C<roos-invalid?>. ; ;=verbatim scm,8 (define (roos-cleanup obj) (-> obj roos-cleanup)) (define-syntax -< (syntax-rules () ((-< obj) (roos-cleanup obj)))) (define (roos-invalid? obj) (not (c-roos-valid? obj))) ;=verbatim ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;=head2 Roos add proxy ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; ;A ROOS object can be a proxy for an other object. This is ;not the same as superclassing. It adds all public methods ;of the object to proxy for to the current object, but calls ;them in the object to proxy for. ; ;=verbatim scm,8 (define (roos-add-proxy obj obj-to-proxy-for) (-> obj roos-add-proxy obj-to-proxy-for)) ;=verbatim ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;=head2 Roos Named Arguments ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; ;C<named-argument> or C<=E<gt>> are there to process argument ;lists with named arguments. ; ;=verbatim scm,8 (define-syntax named-argument (syntax-rules () ((_ name arglist) (named-argument name arglist #f)) ((_ name arglist default-value) (let ((a (memq name arglist))) (if (eq? a #f) default-value (if (null? (cdr a)) '%roos-exists (cadr a))))))) (define-syntax => (syntax-rules () ((_ a b) (named-argument a b)) ((_ a b c) (named-argument a b c)))) ;=verbatim ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;=head2 Roos version ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;=verbatim scm,8 (define (roos-version) (string->number "1.00")) ;=verbatim ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;=head2 Exported interface ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; ;The exported interface consists of macros: ;C<def-class>, C<def-generic>, C<class?>, C<object?>, ;C<named-argument>, C<=E<gt>> ;and C<-E<gt>>. A couple of functions are exported: ;C<roos-version>, C<object?>, C<class?>, C<class=?>, ;C<roos-cleanup> and C<class>. ; ;=cut ; (define-syntax add-member ; (syntax-rules () ; ((_ class this supers member-name function) ; (let ((prev-class class)) ; (let ((newclass (lambda args ; (let ((obj (apply prev-class args))) ; (c-roos-add-member obj ; 'public ; 'member-name ; (lambda args ; (let ((this (-> obj %this)) ; (supers (-> obj %supers))) ; (apply function args)))) ; obj)))) ; (set! class newclass) ; (%roos-register-class class)))))) (provide def-class def-generic class? object? class=? class -> ->> roos-cleanup -< roos-invalid? => named-argument roos-add-proxy roos-version roos-id roos-dispatch ; add-member ))