dmbcs/guile
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

* boot-9.scm (process-define-module): Handle #:duplicates.

Browse source 
(module-use-interfaces! process-duplicates): New functions.
(duplicate-handlers): Dictionary of duplicate handlers.
(module-symbol-local-binding, module-symbol-binding): Bugfix.

* goops.scm (equal?): Define default method.
(merge-generics): Provide for merging of generic functions
imported into a module under the same name.
This commit is contained in:
Mikael Djurfeldt 2003-03-07 13:12:47 +00:00
commit 7b07e5efb6
5 changed files with 281 additions and 16 deletions
Download patch file Download diff file Expand all files Collapse all files

76
NEWS
View file

@ -1,5 +1,5 @@
Guile NEWS --- history of user-visible changes.
Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002 Free Software Foundation, Inc.
Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003 Free Software Foundation, Inc.
See the end for copying conditions.
Please send Guile bug reports to bug-guile@gnu.org.
@ -61,6 +61,80 @@ debugging evaluator gives better error messages.
* Changes to Scheme functions and syntax
** Checking for duplicate bindings in module system
The module system now can check for duplicate imported bindings.
The syntax to enable this feature is:
(define-module (foo)
:use-module (bar)
:use-module (baz)
:duplicates check)
This will report an error if both (bar) and (baz) exports a binding
with the same name.
The syntax for the :duplicates option is:
:duplicates HANDLER-NAME | (HANDLER1-NAME HANDLER2-NAME ...)
Specifying multiple handlers is useful since some handlers (such as
merge-generics) can defer conflict resolution to others.
Currently available duplicates handlers are:
check report an error for bindings with a common name
first select the first encountered binding (override)
last select the last encountered binding (override)
merge-generics merge generic functions with a common name
into an <extended-generic>
** Merging generic functions
It is sometimes tempting to use GOOPS accessors with short names.
For example, it is tempting to use the name `x' for the x-coordinate
in vector packages.
Assume that we work with a graphical package which needs to use two
independent vector packages for 2D and 3D vectors respectively. If
both packages export `x' we will encounter a name collision.
This can now be resolved with the duplicates handler `merge-generics'
which merges all generic functions with a common name:
(define-module (math 2D-vectors)
:use-module (oop goops)
:export (x y ...))
(define-module (math 3D-vectors)
:use-module (oop goops)
:export (x y z ...))
(define-module (my-module)
:use-module (math 2D-vectors)
:use-module (math 3D-vectors)
:duplicates merge-generics)
x in (my-module) will now share methods with x in both imported
modules.
The detailed rule for method visibility is this:
Let's call the imported generic functions the "ancestor functions".
x in (my-module) is, in turn, a "descendant function" of the imported
functions. For any generic function gf, the applicable methods are
selected from the union of the methods of the descendant functions,
the methods of gf and the methods of the ancestor functions.
This implies that x in (math 2D-vectors) can see the methods of x in
(my-module) and vice versa, while x in (math 2D-vectors) doesn't see
the methods of x in (math 3D-vectors), thus preserving modularity.
If duplicates checking is desired in the above example, the following
form of the :duplicates option can be used instead:
:duplicates (merge-generics check)
** New function: effective-version
Returns the "effective" version number. This is just the normal full

9
ice-9/ChangeLog
View file

@ -1,3 +1,12 @@
2003-03-07 Mikael Djurfeldt <djurfeldt@nada.kth.se>
These changes enables checking for duplicate imported bindings.
* boot-9.scm (process-define-module): Handle #:duplicates.
(module-use-interfaces! process-duplicates): New functions.
(duplicate-handlers): Dictionary of duplicate handlers.
(module-symbol-local-binding, module-symbol-binding): Bugfix.
2003-03-04 Mikael Djurfeldt <djurfeldt@nada.kth.se>
* session.scm (apropos): Use hash-for-each instead of

166
ice-9/boot-9.scm
View file

@ -1233,7 +1233,7 @@
;;
(define (module-symbol-local-binding m v . opt-val)
(let ((var (module-local-variable m v)))
(if var
(if (and var (variable-bound? var))
(variable-ref var)
(if (not (null? opt-val))
(car opt-val)
@ -1248,7 +1248,7 @@
;;
(define (module-symbol-binding m v . opt-val)
(let ((var (module-variable m v)))
(if var
(if (and var (variable-bound? var))
(variable-ref var)
(if (not (null? opt-val))
(car opt-val)
@ -1447,6 +1447,34 @@
(cons interface (delq! interface (module-uses module))))
(module-modified module))
;; MODULE-USE-INTERFACES! module interfaces
;;
;; Same as MODULE-USE! but add multiple interfaces and check for duplicates
;;
(define (module-use-interfaces! module interfaces)
(let* ((duplicates-info (module-duplicates-info module))
(duplicates-handlers? (car duplicates-info))
(uses (module-uses module)))
;; remove duplicates-interface
(set! uses (delq! (cdr duplicates-info) uses))
;; remove interfaces to be added
(for-each (lambda (interface)
(set! uses (delq! interface uses)))
interfaces)
;; add interfaces to use list
(set-module-uses! module uses)
(for-each (lambda (interface)
(and duplicates-handlers?
;; perform duplicate checking
(process-duplicates module interface))
(set! uses (cons interface uses))
(set-module-uses! module uses))
interfaces)
;; add duplicates interface
(if (cdr duplicates-info)
(set-module-uses! module (cons (cdr duplicates-info) uses)))
(module-modified module)))
;;; {Recursive Namespaces}
;;;
@ -1534,11 +1562,16 @@
(module-ref m '%module-public-interface #f))
(define (set-module-public-interface! m i)
(module-define! m '%module-public-interface i))
(define (module-duplicates-info m)
(or (module-ref m '%module-duplicates-info #f) (cons #f #f)))
(define (set-module-duplicates-info! m i)
(module-define! m '%module-duplicates-info i))
(define (set-system-module! m s)
(set-procedure-property! (module-eval-closure m) 'system-module s))
(define the-root-module (make-root-module))
(define the-scm-module (make-scm-module))
(set-module-public-interface! the-root-module the-scm-module)
(set-module-duplicates-info! the-root-module (cons #f #f))
(set-module-name! the-root-module '(guile))
(set-module-name! the-scm-module '(guile))
(set-module-kind! the-scm-module 'interface)
@ -1567,10 +1600,12 @@
(let ((interface (make-module 31)))
(set-module-name! interface (module-name module))
(set-module-kind! interface 'interface)
(set-module-public-interface! module interface))))
(set-module-public-interface! module interface)
(set-module-duplicates-info! module (cons #f #f)))))
(if (and (not (memq the-scm-module (module-uses module)))
(not (eq? module the-root-module)))
(set-module-uses! module (append (module-uses module) (list the-scm-module)))))
(set-module-uses! module
(append (module-uses module) (list the-scm-module)))))
;; NOTE: This binding is used in libguile/modules.c.
;;
@ -1708,9 +1743,7 @@
(re-exports '()))
(if (null? kws)
(begin
(for-each (lambda (interface)
(module-use! module interface))
(reverse reversed-interfaces))
(module-use-interfaces! module (reverse reversed-interfaces))
(module-export! module exports)
(module-re-export! module re-exports))
(case (car kws)
@ -1748,6 +1781,19 @@
((#:pure)
(purify-module! module)
(loop (cdr kws) reversed-interfaces exports re-exports))
((#:duplicates)
(if (not (pair? (cdr kws)))
(unrecognized kws))
(set-car! (module-duplicates-info module)
(map (lambda (handler-name)
(or (module-symbol-local-binding
duplicate-handlers handler-name #f)
(error "invalid duplicate handler name:"
handler-name)))
(if (list? (cadr kws))
(cadr kws)
(list (cadr kws)))))
(loop (cddr kws) reversed-interfaces exports re-exports))
((#:export #:export-syntax)
(or (pair? (cdr kws))
(unrecognized kws))
@ -2549,12 +2595,11 @@
;; to change scm_c_use_module as well.
(define (process-use-modules module-interface-args)
(for-each (lambda (mif-args)
(let ((mod-iface (apply resolve-interface mif-args)))
(or mod-iface
(error "no such module" mif-args))
(module-use! (current-module) mod-iface)))
module-interface-args))
(module-use-interfaces! (current-module)
(map (lambda (mif-args)
(or (apply resolve-interface mif-args)
(error "no such module" mif-args)))
module-interface-args)))
(defmacro use-modules modules
`(eval-case
@ -2562,7 +2607,8 @@
(process-use-modules
(list ,@(map (lambda (m)
`(list ,@(compile-interface-spec m)))
modules))))
modules)))
*unspecified*)
(else
(error "use-modules can only be used at the top level"))))
@ -2664,6 +2710,98 @@
(define load load-module)
;;; {Handling of duplicate imported bindings}
;;;
;; Duplicate handlers take the following arguments:
;;
;; module importing module
;; name conflicting name
;; int1 old interface where name occurs
;; val1 value of binding in old interface
;; int2 new interface where name occurs
;; val2 value of binding in new interface
;; var previous resolution or #f
;; val value of previous resolution
;;
;; A duplicate handler can take three alternative actions:
;;
;; 1. return #f => leave responsibility to next handler
;; 2. exit with an error
;; 3. return a variable resolving the conflict
;;
(define duplicate-handlers
(let ((m (make-module 7)))
(set-module-name! m 'duplicate-handlers)
(set-module-kind! m 'interface)
(module-define! m 'check
(lambda (module name int1 val1 int2 val2 var val)
(scm-error 'misc-error
#f
"module ~A: duplicate binding ~A imported from ~A and ~A"
(list (module-name module)
name
(module-name int1)
(module-name int2))
#f)))
(module-define! m 'first
(lambda (module name int1 val1 int2 val2 var val)
(or var (module-local-variable int1 name))))
(module-define! m 'last
(lambda (module name int1 val1 int2 val2 var val)
(module-local-variable int2 name)))
m))
(define (make-duplicates-interface)
(let ((m (make-module)))
(set-module-kind! m 'interface)
(set-module-name! m 'duplicates)
m))
(define (module-symbol-interface module sym)
(or-map (lambda (interface)
(module-search (lambda (interface sym)
(and (module-local-variable interface sym)
interface))
interface
sym))
(module-uses module)))
(define (process-duplicates module interface)
(let* ((duplicates-info (module-duplicates-info module))
(handlers (car duplicates-info))
(d-interface (cdr duplicates-info)))
(module-for-each
(lambda (name var)
(let ((prev-interface (module-symbol-interface module name)))
(if prev-interface
(begin
(if (not d-interface)
(begin
(set! d-interface (make-duplicates-interface))
(set-cdr! duplicates-info d-interface)))
(let* ((var (module-local-variable d-interface name))
(val (and var (variable-bound? var) (variable-ref var))))
(let loop ((handlers handlers))
(cond ((null? handlers))
(((car handlers)
module
name
prev-interface
(module-symbol-local-binding prev-interface name #f)
interface
(module-symbol-local-binding interface name #f)
var
val)
=>
(lambda (var)
(module-add! d-interface name var)))
(else
(loop (cdr handlers))))))))))
interface)))
;;; {`cond-expand' for SRFI-0 support.}

4
oop/ChangeLog
View file

@ -1,6 +1,8 @@
2003-03-06 Mikael Djurfeldt <djurfeldt@nada.kth.se>
2003-03-07 Mikael Djurfeldt <djurfeldt@nada.kth.se>
* goops.scm (equal?): Define default method.
(merge-generics): Provide for merging of generic functions
imported into a module under the same name.
2003-01-18 Mikael Djurfeldt <djurfeldt@nada.kth.se>

42
oop/goops.scm
View file

@ -819,6 +819,48 @@
(define-method (display o file)
(write-object o file))
;;;
;;; Handling of duplicate bindings in the module system
;;;
(define-method (merge-generics (module <module>)
(name <symbol>)
(int1 <module>)
(val1 <top>)
(int2 <module>)
(val2 <top>)
(var <top>)
(val <top>))
#f)
(define-method (merge-generics (module <module>)
(name <symbol>)
(int1 <module>)
(val1 <generic>)
(int2 <module>)
(val2 <generic>)
(var <top>)
(val <boolean>))
(make-variable (make-extended-generic (list val2 val1) name)))
(define-method (merge-generics (module <module>)
(name <symbol>)
(int1 <module>)
(val1 <generic>)
(int2 <module>)
(val2 <generic>)
(var <top>)
(gf <extended-generic>))
(slot-set! gf
'extends
(cons val2 (delq! val2 (slot-ref gf 'extends))))
(slot-set! val2
'extended-by
(cons gf (delq! gf (slot-ref val2 'extended-by))))
var)
(module-define! duplicate-handlers 'merge-generics merge-generics)
;;;
;;; slot access
;;;