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 |
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 |
|
|
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)))) |