[Guile-commits] GNU Guile branch, wip-r6rs-libraries, updated. release_1-9-8-102-g977bb89

[Julian Graham]

This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "GNU Guile".

http://git.savannah.gnu.org/cgit/guile.git/commit/?id=977bb89c9462e24561ccd9c9e6600de8d15a4fb6

The branch, wip-r6rs-libraries has been updated
       via  977bb89c9462e24561ccd9c9e6600de8d15a4fb6 (commit)
       via  8cae6b07dfdb623eec557f68d6a8807c7ed5e04c (commit)
      from  e2861a55896fba3e06e86763eec850bad82b6584 (commit)

Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.

- Log -----------------------------------------------------------------
commit 977bb89c9462e24561ccd9c9e6600de8d15a4fb6
Author: Julian Graham <address@hidden>
Date:   Sat Apr 10 01:01:46 2010 -0400

    Fix incorrect export names in `(rnrs io simple)'.
    
    * module/rnrs/io/6/simple.scm: with-input-file => with-input-from-file,
      with-output-file => with-output-to-file.

commit 8cae6b07dfdb623eec557f68d6a8807c7ed5e04c
Author: Julian Graham <address@hidden>
Date:   Sat Apr 10 01:00:12 2010 -0400

    Make `(rnrs)' fully loadable by working around issue related to the
    hierarchical module namespace shadowing the namespace of imported
    bindings.
    
    * module/ice-9/r6rs-libraries.scm (library): Detect conflicts between
      re-exported binding names and hierarchical module prefixes and attempt
      to resolve them by doing a `module-add!' on a fully-qualified version of
      the re-exported binding.

-----------------------------------------------------------------------

Summary of changes:
 module/ice-9/r6rs-libraries.scm |  113 ++++++++++++++++++++++++++++++--------
 module/rnrs/io/6/simple.scm     |    4 +-
 2 files changed, 91 insertions(+), 26 deletions(-)

diff --git a/module/ice-9/r6rs-libraries.scm b/module/ice-9/r6rs-libraries.scm
index bc96859..ca4a011 100644
--- a/module/ice-9/r6rs-libraries.scm
+++ b/module/ice-9/r6rs-libraries.scm
@@ -48,32 +48,97 @@
               (set-module-uses! import-environment 
                                 (cdr (module-uses import-environment))))
 
-          (let f ((local-exports '()) (re-exports '()) (el exports))
-            (if (null? el)
-                #`(begin
-                    (define-module #,(datum->syntax stx name) 
-                      #:version #,version)
-                    #,@(datum->syntax stx import-exprs)
+          ;; The following code works around an issue in Guile module
+          ;; environments such that if an imported module shares a prefix of
+          ;; its name with the importing module, then the next element in the
+          ;; imported module's "hierarchical namespace" will shadow any
+          ;; imported bindings that have the same name.  For example, the
+          ;; `(rnrs)' module imports `(rnrs syntax-case)', which exports
+          ;; `syntax-case'.  This workaround attempts to detect cases in which
+          ;; this shadowing would occur and use a `local-ref' to a qualified
+          ;; binding - e.g., `(syntax-case syntax-case)'.
 
-                    (module-export! 
-                     (current-module)
-                     #,(datum->syntax stx (list 'quote local-exports)))
-                    (module-re-export! 
-                     (current-module)
-                     #,(datum->syntax stx (list 'quote re-exports)))
+          (let* ((unprefix-name
+                  (lambda (n)
+                    (if (and (> (length n) (length name))
+                             (equal? name (list-head n (length name))))
+                        (list-tail n (length name))
+                        n)))
+                                  
+                 (namespace-conflicts
+                  (letrec 
+                      ((find-conflicts 
+                        (lambda (names)
+                          (if (null? names) '()
+                              (let ((c (unprefix-name (car names))))
+                                (if (equal? c (car names))
+                                    (find-conflicts (cdr names))
+                                    (cons (car c) (find-conflicts 
+                                                   (cdr names)))))))))
+                    
+                    (find-conflicts
+                     (map module-name (module-uses import-environment)))))
 
-                    (eval-when (eval load compile)
-                      (if #,needs-purify
-                          (set-module-uses! 
-                           (current-module)
-                           (delq the-scm-module
-                                 (module-uses (current-module))))))
-                    #,@(datum->syntax stx body))
-                (let ((ce (car el)))
-                  (if (module-bound? import-environment
-                                     (if (pair? ce) (car ce) ce))
-                      (f local-exports (cons ce re-exports) (cdr el))
-                      (f (cons ce local-exports) re-exports (cdr el))))))))))))
+                 (qualify-symbol
+                  (lambda (symbol)
+                    (define (f interfaces)
+                      (cond ((null? interfaces) '())
+                            ((module-local-variable (car interfaces) symbol)
+                             (append (unprefix-name 
+                                      (module-name (car interfaces)))  
+                                     (list symbol)))
+                            (else (f (cdr interfaces)))))
+                    (f (module-uses import-environment)))))
+
+            (let f ((l '()) 
+                    (r '())
+                    (a '())
+                    (el exports))
+              (if (null? el)
+                  #`(begin
+                      (define-module #,(datum->syntax stx name) 
+                        #:version #,version)
+                      #,@(datum->syntax stx import-exprs)
+                      
+                      (module-export! 
+                       (current-module) #,(datum->syntax stx (list 'quote l)))
+                      (module-re-export! 
+                       (current-module) #,(datum->syntax stx (list 'quote r)))
+                      (for-each (lambda (sym-entry)
+                                  (module-add!
+                                   (current-module)
+                                   (car sym-entry)
+                                   (make-variable 
+                                    (local-ref (cdr sym-entry)))))
+                                #,(datum->syntax stx (list 'quote a)))
+
+                      (eval-when (eval load compile)
+                                 (if #,needs-purify
+                                     (set-module-uses! 
+                                      (current-module)
+                                      (delq the-scm-module
+                                            (module-uses (current-module))))))
+                      #,@(datum->syntax stx body))
+                  (let* ((ce (car el))
+                         (iname (if (pair? ce) (car ce) ce))
+                         (xname (if (pair? ce) (cdr ce) ce)))
+
+                    ;; If the internal name for the binding is in the list of
+                    ;; possible conflicts, a re-export of this binding will
+                    ;; fail.  Attempt to find the actual exported variable in 
+                    ;; the list of imports in order to create a qualified name;
+                    ;; if such a variable can't be found, we must not be
+                    ;; re-exporting it.  Assume it's a local export, which will
+                    ;; automatically shadow the module namespace binding.
+
+                    (if (memq iname namespace-conflicts)
+                        (let ((qs (qualify-symbol iname)))
+                          (if (null? qs)
+                              (f (cons ce l) r a (cdr el))
+                              (f l r (cons (cons xname qs) a) (cdr el))))
+                        (if (module-bound? import-environment iname)
+                            (f l (cons ce r) a (cdr el))
+                            (f (cons ce l) r a (cdr el))))))))))))))
     
 (define-syntax import
   (lambda (stx)
diff --git a/module/rnrs/io/6/simple.scm b/module/rnrs/io/6/simple.scm
index fab7da6..593414a 100644
--- a/module/rnrs/io/6/simple.scm
+++ b/module/rnrs/io/6/simple.scm
@@ -95,8 +95,8 @@
                        current-output-port
                        current-error-port
 
-                       with-input-file
-                       with-output-file
+                       with-input-from-file
+                       with-output-to-file
 
                        open-input-file
                        open-output-file


hooks/post-receive
-- 
GNU Guile