1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-02 18:26:20 +02:00

* boot-9.scm (duplicate-handlers): Make sure the merge-generics

and merge-accessors handlers are available also before (oop goops)
has been loaded.  This is so that people can put them as default
handlers without worrying about availability.
This commit is contained in:
Mikael Djurfeldt 2003-03-12 19:27:15 +00:00
parent c9fa174805
commit 65bed4aa84
2 changed files with 31 additions and 21 deletions

View file

@ -1,5 +1,10 @@
2003-03-12 Mikael Djurfeldt <djurfeldt@nada.kth.se> 2003-03-12 Mikael Djurfeldt <djurfeldt@nada.kth.se>
* boot-9.scm (duplicate-handlers): Make sure the merge-generics
and merge-accessors handlers are available also before (oop goops)
has been loaded. This is so that people can put them as default
handlers without worrying about availability.
* slib.scm (logical:ipow-by-squaring): Removed. * slib.scm (logical:ipow-by-squaring): Removed.
* boot-9.scm (ipow-by-squaring): Removed. * boot-9.scm (ipow-by-squaring): Removed.

View file

@ -2843,14 +2843,14 @@
(module-name int2)) (module-name int2))
#f)) #f))
(define (warn module name int1 val1 int2 val2 var val) (define (warn module name int1 val1 int2 val2 var val)
(format #t (format #t
"WARNING: ~A: `~A' imported from both ~A and ~A\n" "WARNING: ~A: `~A' imported from both ~A and ~A\n"
(module-name module) (module-name module)
name name
(module-name int1) (module-name int1)
(module-name int2)) (module-name int2))
#f) #f)
(define (replace module name int1 val1 int2 val2 var val) (define (replace module name int1 val1 int2 val2 var val)
(let ((old (or (and var (object-property var 'replace) var) (let ((old (or (and var (object-property var 'replace) var)
@ -2863,22 +2863,25 @@
(and (object-property new 'replace) (and (object-property new 'replace)
new)))) new))))
(define (warn-override-core module name int1 val1 int2 val2 var val) (define (warn-override-core module name int1 val1 int2 val2 var val)
(and (eq? int1 the-scm-module) (and (eq? int1 the-scm-module)
(begin (begin
(format #t (format #t
"WARNING: ~A: imported module ~A overrides core binding `~A'\n" "WARNING: ~A: imported module ~A overrides core binding `~A'\n"
(module-name module) (module-name module)
(module-name int2) (module-name int2)
name) name)
(module-local-variable int2 name)))) (module-local-variable int2 name))))
(define (first module name int1 val1 int2 val2 var val) (define (first module name int1 val1 int2 val2 var val)
(or var (module-local-variable int1 name))) (or var (module-local-variable int1 name)))
(define (last module name int1 val1 int2 val2 var val) (define (last module name int1 val1 int2 val2 var val)
(module-local-variable int2 name)) (module-local-variable int2 name))
(define (noop module name int1 val1 int2 val2 var val)
#f)
(set-module-name! m 'duplicate-handlers) (set-module-name! m 'duplicate-handlers)
(set-module-kind! m 'interface) (set-module-kind! m 'interface)
(module-define! m 'check check) (module-define! m 'check check)
@ -2887,6 +2890,8 @@
(module-define! m 'warn-override-core warn-override-core) (module-define! m 'warn-override-core warn-override-core)
(module-define! m 'first first) (module-define! m 'first first)
(module-define! m 'last last) (module-define! m 'last last)
(module-define! m 'merge-generics noop)
(module-define! m 'merge-accessors noop)
m)) m))
(define (lookup-duplicates-handlers handler-names) (define (lookup-duplicates-handlers handler-names)