From dc8490ce92a5d069d486e55be4ff608c2daf06c0 Mon Sep 17 00:00:00 2001
From: Chris Hanson <org/chris-hanson/cph>
Date: Mon, 21 Oct 2019 22:12:36 -0700
Subject: [PATCH] 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.
---
 src/runtime/library-imports.scm               | 22 ++++++++++---------
 src/runtime/library-parser.scm                | 15 ++++++-------
 .../test-library-data/support-code.scm        | 15 -------------
 tests/runtime/test-library-parser.scm         | 12 +++++-----
 4 files changed, 25 insertions(+), 39 deletions(-)

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))
-- 
2.25.1