/[guile]/guile/guile-core/oop/goops.scm
ViewVC logotype

Diff of /guile/guile-core/oop/goops.scm

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.22 by mdj, Fri Mar 7 13:12:47 2003 UTC revision 1.23 by mdj, Mon Mar 10 23:17:27 2003 UTC
# Line 53  Line 53 
53  (define-module (oop goops)  (define-module (oop goops)
54    :export-syntax (define-class class    :export-syntax (define-class class
55                    define-generic define-accessor define-method                    define-generic define-accessor define-method
56                    define-extended-generic                    define-extended-generic define-extended-generics
57                    method)                    method)
58    :export (goops-version is-a?    :export (goops-version is-a?
59             ensure-metaclass ensure-metaclass-with-supers             ensure-metaclass ensure-metaclass-with-supers
# Line 97  Line 97 
97             primitive-generic-generic enable-primitive-generic!             primitive-generic-generic enable-primitive-generic!
98             method-procedure accessor-method-slot-definition             method-procedure accessor-method-slot-definition
99             slot-exists? make find-method get-keyword)             slot-exists? make find-method get-keyword)
100      :replace (<class> <operator-class> <entity-class> <entity>)
101    :re-export (class-of)  ;; from (guile)    :re-export (class-of)  ;; from (guile)
102    :no-backtrace)    :no-backtrace)
103    
# Line 383  Line 384 
384                 (goops-error "missing expression"))                 (goops-error "missing expression"))
385                (else                (else
386                 `(define ,name (make-extended-generic ,(caddr exp) ',name))))))))                 `(define ,name (make-extended-generic ,(caddr exp) ',name))))))))
387    (define define-extended-generics
388      (procedure->memoizing-macro
389        (lambda (exp env)
390          (let ((names (cadr exp))
391                (prefixes (get-keyword #:prefix (cddr exp) #f)))
392            (if prefixes
393                `(begin
394                   ,@(map (lambda (name)
395                            `(define-extended-generic ,name
396                               (list ,@(map (lambda (prefix)
397                                              (symbol-append prefix name))
398                                            prefixes))))
399                          names))
400                (goops-error "no prefixes supplied"))))))
401    
402  (define (make-generic . name)  (define (make-generic . name)
403    (let ((name (and (pair? name) (car name))))    (let ((name (and (pair? name) (car name))))

Legend:
Removed from v.1.22  
changed lines
  Added in v.1.23

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26