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

Static default for define-module #:duplicates

Browse source 
* module/ice-9/boot-9.scm (define-module*): Leaving off #:duplicates
  defaults to installing the duplicate binding handlers specified in the
  manual, not the value of some other dynamic parameter.
  (default-duplicate-binding-procedures):
  (default-duplicate-binding-handler): Instead of closing over a
  separate fluid, close over the handlers of the current module.  That
  way when a user does (default-duplicate-binding-handler ...) in a
  script, then it applies to the right module.
This commit is contained in:
Andy Wingo 2016-06-23 17:24:22 +02:00
parent 04d87db927
commit 3df22933b6
1 changed files with 38 additions and 29 deletions
Download patch file Download diff file Expand all files Collapse all files

57
module/ice-9/boot-9.scm
View file

@ -2827,9 +2827,9 @@ written into the port is returned."
;; sure to update "modules.c" as well. ;; sure to update "modules.c" as well.
(define* (define-module* name (define* (define-module* name
#:key filename pure version (duplicates #f) #:key filename pure version (imports '()) (exports '())
(imports '()) (exports '()) (replacements '()) (replacements '()) (re-exports '()) (autoloads '())
(re-exports '()) (autoloads '()) transformer) (duplicates #f) transformer)
(define (list-of pred l) (define (list-of pred l)
(or (null? l) (or (null? l)
(and (pair? l) (pred (car l)) (list-of pred (cdr l))))) (and (pair? l) (pred (car l)) (list-of pred (cdr l)))))
@ -2856,16 +2856,15 @@ written into the port is returned."
;; ;;
(let ((module (resolve-module name #f))) (let ((module (resolve-module name #f)))
(beautify-user-module! module) (beautify-user-module! module)
(if filename (when filename
(set-module-filename! module filename)) (set-module-filename! module filename))
(if pure (when pure
(purify-module! module)) (purify-module! module))
(if version (when version
(begin (unless (list-of integer? version)
(if (not (list-of integer? version))
(error "expected list of integers for version")) (error "expected list of integers for version"))
(set-module-version! module version) (set-module-version! module version)
(set-module-version! (module-public-interface module) version))) (set-module-version! (module-public-interface module) version))
(let ((imports (resolve-imports imports))) (let ((imports (resolve-imports imports)))
(call-with-deferred-observers (call-with-deferred-observers
(lambda () (lambda ()
@ -2882,16 +2881,17 @@ written into the port is returned."
(module-re-export! module re-exports) (module-re-export! module re-exports)
;; FIXME: Avoid use of `apply'. ;; FIXME: Avoid use of `apply'.
(apply module-autoload! module autoloads) (apply module-autoload! module autoloads)
;; Capture the value of `default-duplicate-binding-procedures' (let ((duplicates (or duplicates
;; that is current when the module is defined, unless the user ;; Avoid stompling a previously installed
;; specfies a #:duplicates set explicitly. Otherwise if we ;; duplicates handlers if possible.
;; leave it unset, we would delegate the duplicates-handling (and (not (module-duplicates-handlers module))
;; behavior to whatever default the user has set at whatever ;; Note: If you change this default,
;; time in the future we first use an imported binding. ;; change it also in
(let ((handlers (if duplicates ;; `default-duplicate-binding-procedures'.
(lookup-duplicates-handlers duplicates) '(replace warn-override-core warn last)))))
(default-duplicate-binding-procedures)))) (when duplicates
(set-module-duplicates-handlers! module handlers))))) (let ((handlers (lookup-duplicates-handlers duplicates)))
(set-module-duplicates-handlers! module handlers)))))))
(when transformer (when transformer
(unless (and (pair? transformer) (list-of symbol? transformer)) (unless (and (pair? transformer) (list-of symbol? transformer))
@ -3632,14 +3632,23 @@ but it fails to load."
(list handler-names))))) (list handler-names)))))
(define default-duplicate-binding-procedures (define default-duplicate-binding-procedures
(make-mutable-parameter #f)) (case-lambda
(()
(or (module-duplicates-handlers (current-module))
;; Note: If you change this default, change it also in
;; `define-module*'.
(lookup-duplicates-handlers
'(replace warn-override-core warn last))))
((procs)
(set-module-duplicates-handlers! (current-module) procs))))
(define default-duplicate-binding-handler (define default-duplicate-binding-handler
(make-mutable-parameter '(replace warn-override-core warn last) (case-lambda
(lambda (handler-names) (()
(map procedure-name (default-duplicate-binding-procedures)))
((handlers)
(default-duplicate-binding-procedures (default-duplicate-binding-procedures
(lookup-duplicates-handlers handler-names)) (lookup-duplicates-handlers handlers)))))
handler-names)))