[Guile-commits] 01/01: Declare module exports before loading imports

[Andy Wingo]

wingo pushed a commit to branch master
in repository guile.

commit 631e9901d84ba59ffcb21de95dbb6c9215b642c7
Author: Andy Wingo <address@hidden>
Date:   Tue Feb 28 11:31:52 2017 +0100

    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       | 73 +++++++++++++++++++------------------------
 test-suite/tests/modules.test | 41 ++++++++++++++++++++++++
 2 files changed, 74 insertions(+), 40 deletions(-)

diff --git a/module/ice-9/boot-9.scm b/module/ice-9/boot-9.scm
index 229d917..b480e3d 100644
--- a/module/ice-9/boot-9.scm
+++ b/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
-       (lambda ()
-         (unless (list-of valid-export? exports)
-           (error "expected exports to be a list of symbols or symbol pairs"))
-         (unless (list-of valid-export? replacements)
-           (error "expected replacements to be a list of symbols or symbol 
pairs"))
-         (unless (list-of valid-export? re-exports)
-           (error "expected re-exports to be a list of symbols or symbol 
pairs"))
-         (unless (null? imports)
-           (module-use-interfaces! module imports))
-         (module-export! module exports)
-         (module-replace! module replacements)
-         (module-re-export! module re-exports)
-         ;; FIXME: Avoid use of `apply'.
-         (apply module-autoload! module autoloads)
-         (let ((duplicates (or duplicates
-                               ;; Avoid stompling a previously installed
-                               ;; duplicates handlers if possible.
-                               (and (not (module-duplicates-handlers module))
-                                    ;; Note: If you change this default,
-                                    ;; change it also in
-                                    ;; `default-duplicate-binding-procedures'.
-                                    '(replace warn-override-core warn last)))))
-           (when duplicates
-             (let ((handlers (lookup-duplicates-handlers duplicates)))
-               (set-module-duplicates-handlers! module handlers)))))))
+    (call-with-deferred-observers
+     (lambda ()
+       (unless (list-of valid-import? imports)
+         (error "expected imports to be a list of import specifications"))
+       (unless (list-of valid-export? exports)
+         (error "expected exports to be a list of symbols or symbol pairs"))
+       (unless (list-of valid-export? replacements)
+         (error "expected replacements to be a list of symbols or symbol 
pairs"))
+       (unless (list-of valid-export? re-exports)
+         (error "expected re-exports to be a list of symbols or symbol pairs"))
+       (module-export! module exports)
+       (module-replace! module replacements)
+       (unless (null? imports)
+         (let ((imports (map (lambda (import-spec)
+                               (apply resolve-interface import-spec))
+                             imports)))
+           (module-use-interfaces! module imports)))
+       (module-re-export! module re-exports)
+       ;; FIXME: Avoid use of `apply'.
+       (apply module-autoload! module autoloads)
+       (let ((duplicates (or duplicates
+                             ;; Avoid stompling a previously installed
+                             ;; duplicates handlers if possible.
+                             (and (not (module-duplicates-handlers module))
+                                  ;; Note: If you change this default,
+                                  ;; change it also in
+                                  ;; `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))
diff --git a/test-suite/tests/modules.test b/test-suite/tests/modules.test
index 5e08ac9..d99b961 100644
--- a/test-suite/tests/modules.test
+++ b/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)))))