From: Chris Hanson <org/chris-hanson/cph>
Date: Tue, 22 Oct 2019 05:12:36 +0000 (-0700)
Subject: Don't rewrite library imports after parsing them.
X-Git-Tag: mit-scheme-pucked-10.1.20~11^2~28
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=dc8490ce92a5d069d486e55be4ff608c2daf06c0;p=mit-scheme.git

Don't rewrite library imports after parsing them.

It's more convenient to have the retain their syntax, so that they can be used
by programs using reflective access to the libraries.
---

diff --git a/src/runtime/library-imports.scm b/src/runtime/library-imports.scm
index 33da1e588..b5970fb61 100644
--- a/src/runtime/library-imports.scm
+++ b/src/runtime/library-imports.scm
@@ -53,14 +53,6 @@ USA.
   (let ((converted-set
 	 (let loop ((import-set import-set) (filter (lambda (name) name)))
 	   (case (car import-set)
-	     ((library)
-	      (let ((name (cadr import-set)))
-		(filter-map (lambda (export)
-			      (let* ((to (library-export-to export))
-				     (filtered (filter to)))
-				(and filtered
-				     (make-library-import name to filtered))))
-			    ((registered-library name db) 'get 'exports))))
 	     ((only)
 	      (loop (cadr import-set)
 		    (let ((names (cddr import-set)))
@@ -85,10 +77,20 @@ USA.
 			(filter
 			 (let ((p (assq name renames)))
 			   (if p
-			       (cdr p)
+			       (cadr p)
 			       name)))))))
 	     (else
-	      (error "Unrecognized import set:" import-set))))))
+	      (if (not (library-name? import-set))
+		  (error "Unrecognized import set:" import-set))
+	      (filter-map (lambda (export)
+			    (let* ((to (library-export-to export))
+				   (filtered (filter to)))
+			      (and filtered
+				   (make-library-import import-set
+							to
+							filtered))))
+			  ((registered-library import-set db)
+			   'get 'exports)))))))
     (if (duplicate-names? (map library-import-to converted-set))
 	(error "Import set has duplicate names:" import-set))
     converted-set))
diff --git a/src/runtime/library-parser.scm b/src/runtime/library-parser.scm
index 5a9d9941e..5fcca76c9 100644
--- a/src/runtime/library-parser.scm
+++ b/src/runtime/library-parser.scm
@@ -219,8 +219,7 @@ USA.
 
 (define import-set-parser
   (object-parser
-   (alt (encapsulate (lambda (library-name) (list 'library library-name))
-          (match-if library-name?))
+   (alt (match-if library-name?)
         (encapsulate list
           (alt (list (alt (match only) (match except))
                      (object import-set-parser)
@@ -230,7 +229,7 @@ USA.
                      (match-if symbol?))
                (list (match rename)
                      (object import-set-parser)
-                     (* (encapsulate cons
+                     (* (encapsulate list
                           (list (match-if symbol?)
                                 (match-if symbol?)))))))
         (sexp (parsing-error "import set")))))
@@ -311,13 +310,13 @@ USA.
          lose)))
 
 (define (parsed-import-library import)
-  (case (car import)
-    ((library) (cadr import))
-    ((only except prefix rename) (parsed-import-library (cadr import)))
-    (else (error "Unrecognized import:" import))))
+  (if (memq (car import) '(only except prefix rename))
+      (parsed-import-library (cadr import))
+      import))
 
 (define (library-name? object)
-  (and (list? object)
+  (and (pair? object)
+       (list? (cdr object))
        (every (lambda (elt)
 		(or (interned-symbol? elt)
 		    (exact-nonnegative-integer? elt)))
diff --git a/tests/runtime/test-library-data/support-code.scm b/tests/runtime/test-library-data/support-code.scm
index 759176115..8a1ac920f 100644
--- a/tests/runtime/test-library-data/support-code.scm
+++ b/tests/runtime/test-library-data/support-code.scm
@@ -35,21 +35,6 @@ USA.
 (define-comparator library-export=? 'library-export=?)
 (define-comparator library-import=? 'library-import=?)
 
-(define (convert-import import)
-  (case (car import)
-    ((only except prefix)
-     `(,(car import)
-       ,(convert-import (cadr import))
-       ,@(cddr import)))
-    ((rename)
-     `(,(car import)
-       ,(convert-import (cadr import))
-       ,@(map (lambda (p)
-		(cons (car p) (cadr p)))
-	      (cddr import))))
-    (else
-     `(library ,import))))
-
 (define (convert-export export)
   (if (symbol? export)
       (make-library-export export)
diff --git a/tests/runtime/test-library-parser.scm b/tests/runtime/test-library-parser.scm
index d50127a28..a557621a0 100644
--- a/tests/runtime/test-library-parser.scm
+++ b/tests/runtime/test-library-parser.scm
@@ -51,7 +51,7 @@ USA.
 		    '(foo bar))
       (assert-lset= equal?
 		    (library-parsed-imports library)
-		    (map convert-import ex1-imports))
+		    ex1-imports)
       (assert-lset= library-export=?
 		    (library-exports library)
 		    (map convert-export ex1-exports))
@@ -68,7 +68,7 @@ USA.
 		    '(foo bar))
       (assert-lset= equal?
 		    (library-parsed-imports library)
-		    (map convert-import (append ex1-imports ex2-extra-imports)))
+		    (append ex1-imports ex2-extra-imports))
       (assert-lset= library-export=?
 		    (library-exports library)
 		    (map convert-export (append ex1-exports ex2-extra-exports)))
@@ -105,10 +105,10 @@ USA.
 			(example life))))
       (let ((program (r7rs-source-program source)))
 	(assert-equal (library-parsed-imports program)
-		      '((library (scheme base))
-			(only (library (example life)) life)
-			(rename (prefix (library (example grid)) grid-)
-				(grid-make . make-grid))))
+		      '((scheme base)
+			(only (example life) life)
+			(rename (prefix (example grid) grid-)
+				(grid-make make-grid))))
 	(assert-equal (library-parsed-contents program)
 		      '((begin
 			  (define grid (make-grid 24 24))