mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-05-20 19:50:24 +02:00
rnrs modules #:replace as appropriate
* module/ice-9/boot-9.scm (export!): New syntax, as export is to module-export!, export! is to module-replace!. I thought that taking up the name `replace' would be presumptuous, hence the name mismatch. * module/ice-9/r6rs-libraries.scm (library): Calculate not only re-exports, but replacements as well.
This commit is contained in:
parent
73b03e98a7
commit
1052739b74
2 changed files with 33 additions and 13 deletions
|
@ -3036,6 +3036,14 @@ module '(ice-9 q) '(make-q q-length))}."
|
||||||
(lambda ()
|
(lambda ()
|
||||||
(module-re-export! (current-module) '(name ...))))))))
|
(module-re-export! (current-module) '(name ...))))))))
|
||||||
|
|
||||||
|
(define-syntax export!
|
||||||
|
(syntax-rules ()
|
||||||
|
((_ name ...)
|
||||||
|
(eval-when (eval load compile expand)
|
||||||
|
(call-with-deferred-observers
|
||||||
|
(lambda ()
|
||||||
|
(module-replace! (current-module) '(name ...))))))))
|
||||||
|
|
||||||
(define-syntax export-syntax
|
(define-syntax export-syntax
|
||||||
(syntax-rules ()
|
(syntax-rules ()
|
||||||
((_ name ...)
|
((_ name ...)
|
||||||
|
|
|
@ -121,26 +121,36 @@
|
||||||
(define (compute-exports ifaces specs)
|
(define (compute-exports ifaces specs)
|
||||||
(define (re-export? sym)
|
(define (re-export? sym)
|
||||||
(or-map (lambda (iface) (module-local-variable iface sym)) ifaces))
|
(or-map (lambda (iface) (module-local-variable iface sym)) ifaces))
|
||||||
|
(define (replace? sym)
|
||||||
|
(module-local-variable the-scm-module sym))
|
||||||
|
|
||||||
(let lp ((specs specs) (e '()) (r '()))
|
(let lp ((specs specs) (e '()) (r '()) (x '()))
|
||||||
(syntax-case specs (rename)
|
(syntax-case specs (rename)
|
||||||
(() (values e r))
|
(() (values e r x))
|
||||||
(((rename (from to) ...) . rest)
|
(((rename (from to) ...) . rest)
|
||||||
(and (and-map identifier? #'(from ...))
|
(and (and-map identifier? #'(from ...))
|
||||||
(and-map identifier? #'(to ...)))
|
(and-map identifier? #'(to ...)))
|
||||||
(let lp2 ((in #'((from . to) ...)) (e e) (r r))
|
(let lp2 ((in #'((from . to) ...)) (e e) (r r) (x x))
|
||||||
(syntax-case in ()
|
(syntax-case in ()
|
||||||
(() (lp #'rest e r))
|
(() (lp #'rest e r x))
|
||||||
(((from . to) . in)
|
(((from . to) . in)
|
||||||
(if (re-export? (syntax->datum #'from))
|
(cond
|
||||||
(lp2 #'in e (cons #'(from . to) r))
|
((re-export? (syntax->datum #'from))
|
||||||
(lp2 #'in (cons #'(from . to) e) r))))))
|
(lp2 #'in e (cons #'(from . to) r) x))
|
||||||
|
((replace? (syntax->datum #'from))
|
||||||
|
(lp2 #'in e r (cons #'(from . to) x)))
|
||||||
|
(else
|
||||||
|
(lp2 #'in (cons #'(from . to) e) r x)))))))
|
||||||
((id . rest)
|
((id . rest)
|
||||||
(identifier? #'id)
|
(identifier? #'id)
|
||||||
(let ((sym (syntax->datum #'id)))
|
(let ((sym (syntax->datum #'id)))
|
||||||
(if (re-export? sym)
|
(cond
|
||||||
(lp #'rest e (cons #'id r))
|
((re-export? sym)
|
||||||
(lp #'rest (cons #'id e) r)))))))
|
(lp #'rest e (cons #'id r) x))
|
||||||
|
((replace? sym)
|
||||||
|
(lp #'rest e r (cons #'id x)))
|
||||||
|
(else
|
||||||
|
(lp #'rest (cons #'id e) r x))))))))
|
||||||
|
|
||||||
(syntax-case stx (export import)
|
(syntax-case stx (export import)
|
||||||
((_ (name name* ...)
|
((_ (name name* ...)
|
||||||
|
@ -169,9 +179,10 @@
|
||||||
(import-set (resolve-r6rs-interface #'import-set))))
|
(import-set (resolve-r6rs-interface #'import-set))))
|
||||||
#'(ispec ...))
|
#'(ispec ...))
|
||||||
#'(espec ...)))
|
#'(espec ...)))
|
||||||
(lambda (exports re-exports)
|
(lambda (exports re-exports replacements)
|
||||||
(with-syntax (((e ...) exports)
|
(with-syntax (((e ...) exports)
|
||||||
((r ...) re-exports))
|
((r ...) re-exports)
|
||||||
|
((x ...) replacements))
|
||||||
;; It would be nice to push the module that was current before the
|
;; It would be nice to push the module that was current before the
|
||||||
;; definition, and pop it after the library definition, but I
|
;; definition, and pop it after the library definition, but I
|
||||||
;; actually can't see a way to do that. Helper procedures perhaps,
|
;; actually can't see a way to do that. Helper procedures perhaps,
|
||||||
|
@ -183,8 +194,9 @@
|
||||||
#:version (version ...))
|
#:version (version ...))
|
||||||
(import ispec)
|
(import ispec)
|
||||||
...
|
...
|
||||||
(re-export r ...)
|
|
||||||
(export e ...)
|
(export e ...)
|
||||||
|
(re-export r ...)
|
||||||
|
(export! x ...)
|
||||||
(@@ (name name* ...) body)
|
(@@ (name name* ...) body)
|
||||||
...))))))))
|
...))))))))
|
||||||
|
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue