Allow overlap of imports provided that the imported values are eqv?.

diff --git a/src/runtime/library-imports.scm b/src/runtime/library-imports.scm
index a7fd1528c02d93e14d7141f2f5ae0234307716e6..7f81143d59a51fb09336ba1d29a5e1752c6a35f9 100644 (file)
--- a/src/runtime/library-imports.scm
+++ b/src/runtime/library-imports.scm
@@ -35,17 +35,11 @@ USA.
         ((registered-library name db) 'has? 'exports))))
 
 (define (expand-parsed-imports imports db)
-  (let ((converted-sets
-        (map (lambda (import)
-               (expand-parsed-import import db))
-             imports)))
-    (let ((intersections (find-intersections converted-sets)))
-      (if (pair? intersections)
-         (error "Import sets intersect:"
-                (unconvert-intersections intersections
-                                         converted-sets
-                                         imports))))
-    (reduce-right append! '() converted-sets)))
+  (reduce-right append!
+               '()
+               (map (lambda (import)
+                      (expand-parsed-import import db))
+                    imports)))
 
 (define-automatic-property 'imports '(parsed-imports db)
   (lambda (imports db)
@@ -54,30 +48,6 @@ USA.
           imports))
   expand-parsed-imports)
 
-(define (find-intersections converted-sets)
-  (if (pair? converted-sets)
-      (let* ((links1 (car converted-sets))
-            (names1 (map library-import-to links1)))
-       (append (filter-map (lambda (links2)
-                             (and (intersecting-names?
-                                   names1
-                                   (map library-import-to links2))
-                                  (list links1 links2)))
-                           (cdr converted-sets))
-               (find-intersections (cdr converted-sets))))
-      '()))
-
-(define (intersecting-names? names1 names2)
-  (pair? (lset-intersection eq? names1 names2)))
-
-(define (unconvert-intersections intersections converted-sets imported-sets)
-  (let ((alist (map cons converted-sets imported-sets)))
-    (map (lambda (intersection)
-          (map (lambda (converted-set)
-                 (cdr (assq converted-set alist)))
-               intersection))
-        intersections)))
-\f
 ;;; Returns a list of library-import elements.
 (define (expand-parsed-import import-set db)
   (let ((converted-set

diff --git a/src/runtime/library-loader.scm b/src/runtime/library-loader.scm
index 61b76fe03b437de8dbba8dca39d21299640f3e42..26c8a7eeb9f2f5b80c0c0e9abbccd15f59329a56 100644 (file)
--- a/src/runtime/library-loader.scm
+++ b/src/runtime/library-loader.scm
@@ -89,7 +89,8 @@ USA.
 
 (define (make-environment-from-imports imports db)
   (let ((env
-        (make-root-top-level-environment (map library-import-to imports))))
+        (make-root-top-level-environment
+         (delete-duplicates (map library-import-to imports) eq?))))
     (for-each (lambda (import)
                (let ((value
                       ((library-exporter
@@ -98,25 +99,40 @@ USA.
                          db))
                        (library-import-from import)))
                      (name (library-import-to import)))
-                 (cond ((macro-reference-trap? value)
-                        (environment-define-macro
-                         env name
-                         (macro-reference-trap-transformer value)))
-                       ((unassigned-reference-trap? value)
-                        ;; nothing to do
-                        )
-                       (else
-                        (environment-define env name value)))))
+                 (if (or (not (environment-bound? env name))
+                         (let ((value* (environment-safe-lookup env name)))
+                           (and (not (values-equivalent? value value*))
+                                (or (unassigned-reference-trap? value*)
+                                    (error "Conflicting imports:"
+                                           name value* value)))))
+                     (cond ((macro-reference-trap? value)
+                            (environment-define-macro
+                             env name
+                             (macro-reference-trap-transformer value)))
+                           ((unassigned-reference-trap? value)
+                            ;; nothing to do
+                            )
+                           (else
+                            (environment-define env name value))))))
              imports)
     env))
 
+(define (values-equivalent? v1 v2)
+  (cond ((unassigned-reference-trap? v1)
+        (unassigned-reference-trap? v2))
+       ((macro-reference-trap? v1)
+        (and (macro-reference-trap? v2)
+             (eqv? (macro-reference-trap-transformer v1)
+                   (macro-reference-trap-transformer v2))))
+       (else (eqv? v1 v2))))
+
 (define-automatic-property 'imports-environment '(imports db)
   (lambda (imports db)
     (every (lambda (import)
             (import-environment-available? import db))
           imports))
   make-environment-from-imports)
-
+\f
 (define (environment . import-sets)
   (let ((parsed (map parse-import-set import-sets))
        (db host-library-db))