Declare module exports before loading imports

* module/ice-9/boot-9.scm (define-module*): Process module imports after
  module exports.  Allows for an additional kind of circular module
  imports (see https://bugs.gnu.org/15540).
* test-suite/tests/modules.test ("circular imports"): Add test.

module/ice-9/boot-9.scm

@@ -2859,24 +2859,13 @@ written into the port is returned."
   (define (list-of pred l)
     (or (null? l)
         (and (pair? l) (pred (car l)) (list-of pred (cdr l)))))
+  (define (valid-import? x)
+    (list? x))
   (define (valid-export? x)
     (or (symbol? x) (and (pair? x) (symbol? (car x)) (symbol? (cdr x)))))
   (define (valid-autoload? x)
     (and (pair? x) (list-of symbol? (car x)) (list-of symbol? (cdr x))))
   
-  (define (resolve-imports imports)
-    (define (resolve-import import-spec)
-      (if (list? import-spec)
-          (apply resolve-interface import-spec)
-          (error "unexpected use-module specification" import-spec)))
-    (let lp ((imports imports) (out '()))
-      (cond
-       ((null? imports) (reverse! out))
-       ((pair? imports)
-        (lp (cdr imports)
-            (cons (resolve-import (car imports)) out)))
-       (else (error "unexpected tail of imports list" imports)))))
-
   ;; We could add a #:no-check arg, set by the define-module macro, if
   ;; these checks are taking too much time.
   ;;
@@ -2891,33 +2880,37 @@ written into the port is returned."
         (error "expected list of integers for version"))
       (set-module-version! module version)
       (set-module-version! (module-public-interface module) version))
-    (let ((imports (resolve-imports imports)))
+    (call-with-deferred-observers
-      (call-with-deferred-observers
+     (lambda ()
-       (lambda ()
+       (unless (list-of valid-import? imports)
-         (unless (list-of valid-export? exports)
+         (error "expected imports to be a list of import specifications"))
-           (error "expected exports to be a list of symbols or symbol pairs"))
+       (unless (list-of valid-export? exports)
-         (unless (list-of valid-export? replacements)
+         (error "expected exports to be a list of symbols or symbol pairs"))
-           (error "expected replacements to be a list of symbols or symbol pairs"))
+       (unless (list-of valid-export? replacements)
-         (unless (list-of valid-export? re-exports)
+         (error "expected replacements to be a list of symbols or symbol pairs"))
-           (error "expected re-exports to be a list of symbols or symbol pairs"))
+       (unless (list-of valid-export? re-exports)
-         (unless (null? imports)
+         (error "expected re-exports to be a list of symbols or symbol pairs"))
-           (module-use-interfaces! module imports))
+       (module-export! module exports)
-         (module-export! module exports)
+       (module-replace! module replacements)
-         (module-replace! module replacements)
+       (unless (null? imports)
-         (module-re-export! module re-exports)
+         (let ((imports (map (lambda (import-spec)
-         ;; FIXME: Avoid use of `apply'.
+                               (apply resolve-interface import-spec))
-         (apply module-autoload! module autoloads)
+                             imports)))
-         (let ((duplicates (or duplicates
+           (module-use-interfaces! module imports)))
-                               ;; Avoid stompling a previously installed
+       (module-re-export! module re-exports)
-                               ;; duplicates handlers if possible.
+       ;; FIXME: Avoid use of `apply'.
-                               (and (not (module-duplicates-handlers module))
+       (apply module-autoload! module autoloads)
-                                    ;; Note: If you change this default,
+       (let ((duplicates (or duplicates
-                                    ;; change it also in
+                             ;; Avoid stompling a previously installed
-                                    ;; `default-duplicate-binding-procedures'.
+                             ;; duplicates handlers if possible.
-                                    '(replace warn-override-core warn last)))))
+                             (and (not (module-duplicates-handlers module))
-           (when duplicates
+                                  ;; Note: If you change this default,
-             (let ((handlers (lookup-duplicates-handlers duplicates)))
+                                  ;; change it also in
-               (set-module-duplicates-handlers! module handlers)))))))
+                                  ;; `default-duplicate-binding-procedures'.
+                                  '(replace warn-override-core warn last)))))
+         (when duplicates
+           (let ((handlers (lookup-duplicates-handlers duplicates)))
+             (set-module-duplicates-handlers! module handlers))))))
 
     (when transformer
       (unless (and (pair? transformer) (list-of symbol? transformer))

test-suite/tests/modules.test

@@ -422,3 +422,44 @@
 
   (pass-if "version-matches? against less specified version"
     (not (version-matches? '(1 2 3) '(1 2)))))
+
+
+(with-test-prefix "circular imports"
+  (pass-if-equal "#:select" 1
+    (begin
+      (eval
+       '(begin
+          (define-module (test-circular-imports))
+          (define (init-module-a)
+            (eval '(begin
+                     (define-module (test-circular-imports a)
+                       #:use-module (test-circular-imports b)
+                       #:export (from-a))
+                     (define from-a 1))
+                  (current-module)))
+          (define (init-module-b)
+            (eval '(begin
+                     (define-module (test-circular-imports b)
+                       #:use-module ((test-circular-imports a)
+                                     #:select (from-a))
+                       #:export (from-b))
+                     (define from-b 2))
+                  (current-module)))
+          (define (submodule-binder mod name)
+            (let ((m (make-module 31)))
+              (set-module-kind! m 'directory)
+              (set-module-name! m (append (module-name mod) (list name)))
+              (module-define-submodule! mod name m)
+              (case name
+                ((a) (init-module-a))
+                ((b) (init-module-b))
+                ((c) #t)
+                (else (error "unreachable")))
+              m))
+          (set-module-submodule-binder! (current-module) submodule-binder))
+       (current-module))
+      (eval '(begin
+               (define-module (test-circular-imports c))
+               (use-modules (test-circular-imports a))
+               from-a)
+            (current-module)))))