mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-16 00:30:21 +02:00
Code Activity

* srfi-1.scm (iota map for-each map-in-order list-index member

Browse source 
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.
This commit is contained in:
Mikael Djurfeldt 2003-03-10 23:18:05 +00:00
parent dbd6bd2910
commit f595ccfefc
9 changed files with 285 additions and 105 deletions
Download patch file Download diff file Expand all files Collapse all files

6
oop/ChangeLog
View file

@ -1,3 +1,9 @@
2003-03-11 Mikael Djurfeldt <djurfeldt@nada.kth.se>
* goops.scm (define-extended-generics): New syntax.
(<class> <operator-class> <entity-class> <entity>): Marked as
replacements.
2003-03-07 Mikael Djurfeldt <djurfeldt@nada.kth.se>
* goops.scm (equal?): Define default method.

17
oop/goops.scm
View file

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