summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorAndy Wingo <wingo@pobox.com>2019-09-27 22:01:53 +0200
committerAndy Wingo <wingo@pobox.com>2019-09-27 22:57:38 +0200
commit3be16199ab2cc4bf0ff96fa7a39145e0f28fb1ac (patch)
tree8491ef5e2d71e05d88ec336ac3a4acc9f83dbe49
parent28318cba9c24aaeb22b12a0bcd7050496cd1a3c0 (diff)
downloadguile-3be16199ab2cc4bf0ff96fa7a39145e0f28fb1ac.tar.gz
Avoid mutating arguments to resolve-interface
* 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.
-rw-r--r--module/ice-9/boot-9.scm51
1 files changed, 28 insertions, 23 deletions
diff --git a/module/ice-9/boot-9.scm b/module/ice-9/boot-9.scm
index adabbbbd6..05cddacf1 100644
--- a/module/ice-9/boot-9.scm
+++ b/module/ice-9/boot-9.scm
@@ -2814,32 +2814,37 @@ error if selected binding does not exist in the used module."
(custom-i (make-module 31)))
(set-module-kind! custom-i 'custom-interface)
(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
(for-each (lambda (binding)
- (if (not (module-local-variable public-i binding))
- (error
- (simple-format
- #f "no binding `~A' to hide in module ~A"
- binding name))))
+ (unless (module-local-variable public-i binding)
+ (error
+ (simple-format
+ #f "no binding `~A' to hide in module ~A"
+ binding name))))
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))))
(define (symbol-prefix-proc prefix)