mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-20 11:40:18 +02:00
Code Activity

Declare module exports before loading imports

Browse source 
* 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.
This commit is contained in:
Andy Wingo 2017-02-28 11:31:52 +01:00
parent 9e28a12121
commit 631e9901d8
2 changed files with 74 additions and 40 deletions
Download patch file Download diff file Expand all files Collapse all files

73
module/ice-9/boot-9.scm
View file

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

41
test-suite/tests/modules.test
View file

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