guile-commits
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[Guile-commits] 04/09: Avoid mutating arguments to resolve-interface


From: Andy Wingo
Subject: [Guile-commits] 04/09: Avoid mutating arguments to resolve-interface
Date: Fri, 27 Sep 2019 17:15:54 -0400 (EDT)

wingo pushed a commit to branch master
in repository guile.

commit 3be16199ab2cc4bf0ff96fa7a39145e0f28fb1ac
Author: Andy Wingo <address@hidden>
Date:   Fri Sep 27 22:01:53 2019 +0200

    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.
---
 module/ice-9/boot-9.scm | 51 +++++++++++++++++++++++++++----------------------
 1 file changed, 28 insertions(+), 23 deletions(-)

diff --git a/module/ice-9/boot-9.scm b/module/ice-9/boot-9.scm
index adabbbb..05cddac 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)



reply via email to

[Prev in Thread] Current Thread [Next in Thread]