summaryrefslogtreecommitdiff
path: root/oop/goops.scm
diff options
context:
space:
mode:
authorMikael Djurfeldt <djurfeldt@nada.kth.se>2003-03-10 23:18:05 +0000
committerMikael Djurfeldt <djurfeldt@nada.kth.se>2003-03-10 23:18:05 +0000
commitf595ccfefc8461eb49e1a02c8974bc4e2575a502 (patch)
tree63f1263164db911da30f9a70f708bb3948e7dfcc /oop/goops.scm
parentdbd6bd2910d5f49f97c0b53ce681b9fc448171b5 (diff)
downloadguile-f595ccfefc8461eb49e1a02c8974bc4e2575a502.tar.gz
* srfi-1.scm (iota map for-each map-in-order list-index member
delete delete! assoc): Marked as replacements. * goops.scm (define-extended-generics): New syntax. (<class> <operator-class> <entity-class> <entity>): Marked as replacements. * boot-9.scm (module-override!, make-mutable-parameter, lookup-duplicates-handlers, default-module-duplicates-handler): New functions. (process-duplicates): Don't call duplicates handlers for duplicate bindings of the same variable. (process-define-module): Process #:replace. (compile-interface-spec, resolve-interface): Process #:prefix. * format.scm (format): Marked as replacement. * threads.scm (future, future-ref): Marked as replacements.
Diffstat (limited to 'oop/goops.scm')
-rw-r--r--oop/goops.scm17
1 files changed, 16 insertions, 1 deletions
diff --git a/oop/goops.scm b/oop/goops.scm
index 71f0dae33..a840eb699 100644
--- a/oop/goops.scm
+++ b/oop/goops.scm
@@ -53,7 +53,7 @@
(define-module (oop goops)
:export-syntax (define-class class
define-generic define-accessor define-method
- define-extended-generic
+ define-extended-generic define-extended-generics
method)
:export (goops-version is-a?
ensure-metaclass ensure-metaclass-with-supers
@@ -97,6 +97,7 @@
primitive-generic-generic enable-primitive-generic!
method-procedure accessor-method-slot-definition
slot-exists? make find-method get-keyword)
+ :replace (<class> <operator-class> <entity-class> <entity>)
:re-export (class-of) ;; from (guile)
:no-backtrace)
@@ -383,6 +384,20 @@
(goops-error "missing expression"))
(else
`(define ,name (make-extended-generic ,(caddr exp) ',name))))))))
+(define define-extended-generics
+ (procedure->memoizing-macro
+ (lambda (exp env)
+ (let ((names (cadr exp))
+ (prefixes (get-keyword #:prefix (cddr exp) #f)))
+ (if prefixes
+ `(begin
+ ,@(map (lambda (name)
+ `(define-extended-generic ,name
+ (list ,@(map (lambda (prefix)
+ (symbol-append prefix name))
+ prefixes))))
+ names))
+ (goops-error "no prefixes supplied"))))))
(define (make-generic . name)
(let ((name (and (pair? name) (car name))))