mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-01 12:20:26 +02:00
Code Activity

Avoid mutating arguments to resolve-interface

Browse source 
* module/ice-9/boot-9.scm (resolve-interface): This function used to
  mutate the #:hide argument, which results in terrorism if the value is
  a literal.
This commit is contained in:
Andy Wingo 2019-09-27 22:01:53 +02:00
parent 28318cba9c
commit 3be16199ab
1 changed files with 28 additions and 23 deletions
Download patch file Download diff file Expand all files Collapse all files

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

@ -2814,32 +2814,37 @@ error if selected binding does not exist in the used module."
(custom-i (make-module 31))) (custom-i (make-module 31)))
(set-module-kind! custom-i 'custom-interface) (set-module-kind! custom-i 'custom-interface)
(set-module-name! custom-i name) (set-module-name! custom-i name)
;; XXX - should use a lazy binder so that changes to the
;; used module are picked up automatically.
(for-each (lambda (bspec)
(let* ((direct? (symbol? bspec))
(orig (if direct? bspec (car bspec)))
(seen (if direct? bspec (cdr bspec)))
(var (or (module-local-variable public-i orig)
(error
;; fixme: format manually for now
(simple-format
#f "no binding `~A' in module ~A"
orig name)))))
(if (memq orig hide)
(set! hide (delq! orig hide))
(module-add! custom-i
(renamer seen)
var))))
selection)
;; Check that we are not hiding bindings which don't exist ;; Check that we are not hiding bindings which don't exist
(for-each (lambda (binding) (for-each (lambda (binding)
(if (not (module-local-variable public-i binding)) (unless (module-local-variable public-i binding)
(error (error
(simple-format (simple-format
#f "no binding `~A' to hide in module ~A" #f "no binding `~A' to hide in module ~A"
binding name)))) binding name))))
hide) hide)
(define (maybe-export! src dst var)
(unless (memq src hide)
(module-add! custom-i (renamer dst) var)))
(cond
(select
(for-each
(lambda (bspec)
(let* ((direct? (symbol? bspec))
(orig (if direct? bspec (car bspec)))
(seen (if direct? bspec (cdr bspec)))
(var (module-local-variable public-i orig)))
(unless var
(scm-error 'unbound-variable "resolve-interface"
"no binding `~A' in module ~A" (list orig name)
#f))
(maybe-export! orig seen var)))
select))
(else
;; FIXME: Use a lazy binder so that changes to the used
;; module are picked up automatically.
(module-for-each (lambda (sym var)
(maybe-export! sym sym var))
public-i)))
custom-i)))) custom-i))))
(define (symbol-prefix-proc prefix) (define (symbol-prefix-proc prefix)