diff options
author | Mikael Djurfeldt <djurfeldt@nada.kth.se> | 2003-03-10 23:18:05 +0000 |
---|---|---|
committer | Mikael Djurfeldt <djurfeldt@nada.kth.se> | 2003-03-10 23:18:05 +0000 |
commit | f595ccfefc8461eb49e1a02c8974bc4e2575a502 (patch) | |
tree | 63f1263164db911da30f9a70f708bb3948e7dfcc /oop/goops.scm | |
parent | dbd6bd2910d5f49f97c0b53ce681b9fc448171b5 (diff) | |
download | guile-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.scm | 17 |
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)))) |