From 2fb2a47fdfc74108437e444c4d61e8ca604536c7 Mon Sep 17 00:00:00 2001
From: Chris Hanson <org/chris-hanson/cph>
Date: Wed, 24 Oct 2018 21:26:11 -0700
Subject: [PATCH] Allow overlap of imports provided that the imported values
 are eqv?.

---
 src/runtime/library-imports.scm | 40 +++++----------------------------
 src/runtime/library-loader.scm  | 38 ++++++++++++++++++++++---------
 2 files changed, 32 insertions(+), 46 deletions(-)

diff --git a/src/runtime/library-imports.scm b/src/runtime/library-imports.scm
index a7fd1528c..7f81143d5 100644
--- 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)))
-
 ;;; 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 61b76fe03..26c8a7eeb 100644
--- 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)
-
+
 (define (environment . import-sets)
   (let ((parsed (map parse-import-set import-sets))
 	(db host-library-db))
-- 
2.25.1