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 33da1e5888025cf2c8f8fcb22b15fd91c0199e33..b5970fb61630b350e308a8fe9439169f889efd4c 100644 (file)
--- 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 5a9d9941e170b8fdc455dfef2bc7ee9ea11b47a0..5fcca76c992956a50e72566b20e1c6eb71b95d4d 100644 (file)
--- 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 7591761154784881195c436c8e54d08dd284be72..8a1ac920f755fa064a6f4f73039f61392c600c20 100644 (file)
--- 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 d50127a28b220596dd9046598cb2eff19b04e4b8..a557621a0a453191838cbac52b260f4783e9291f 100644 (file)
--- 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))