r6rs `import' accepts multiple clauses

[bpt/guile.git] / module / ice-9 / r6rs-libraries.scm

diff --git a/module/ice-9/r6rs-libraries.scm b/module/ice-9/r6rs-libraries.scm
index 14c89d0..482f826 100644 (file)
--- a/module/ice-9/r6rs-libraries.scm
+++ b/module/ice-9/r6rs-libraries.scm
@@ -161,8 +161,14 @@
        (and-map identifier? #'(name name* ...))
        (call-with-values
            (lambda ()
-             (compute-exports (map resolve-r6rs-interface #'(ispec ...))
-                              #'(espec ...)))
+             (compute-exports 
+              (map (lambda (im)
+                     (syntax-case im (for)
+                       ((for import-set import-level ...)
+                        (resolve-r6rs-interface #'import-set))
+                       (import-set (resolve-r6rs-interface #'import-set))))
+                   #'(ispec ...))
+              #'(espec ...)))
          (lambda (exports re-exports)
            (with-syntax (((e ...) exports)
                          ((r ...) re-exports))
@@ -173,6 +179,7 @@
              ;; welcome!
              #'(begin
                  (define-module (name name* ...)
+                   #:pure
                    #:version (version ...))
                  (import ispec)
                  ...
@@ -183,13 +190,19 @@
     
 (define-syntax import
   (lambda (stx)
-    (syntax-case stx (for)
-      ((_ (for import-set import-level ...))
-       #'(import import-set))
-      ((_ import-set)
-       #'(eval-when (eval load compile)
-           (let ((iface (resolve-r6rs-interface 'import-set)))
-             (call-with-deferred-observers
-              (lambda ()
-                (module-use-interfaces! (current-module) (list iface))))
+    (define (strip-for import-set)
+      (syntax-case import-set (for)
+        ((for import-set import-level ...)
+         #'import-set)
+        (import-set
+         #'import-set)))
+    (syntax-case stx ()
+      ((_ import-set ...)
+       (with-syntax (((library-reference ...) (map strip-for #'(import-set ...))))
+         #'(eval-when (eval load compile expand)
+             (let ((iface (resolve-r6rs-interface 'library-reference)))
+               (call-with-deferred-observers
+                 (lambda ()
+                   (module-use-interfaces! (current-module) (list iface)))))
+             ...
              (if #f #f)))))))