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

rnrs modules #:replace as appropriate

Browse source 
* 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:
Andy Wingo 2010-06-20 23:59:57 +02:00
parent 73b03e98a7
commit 1052739b74
2 changed files with 33 additions and 13 deletions
Download patch file Download diff file Expand all files Collapse all files

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

@ -3036,6 +3036,14 @@ module '(ice-9 q) '(make-q q-length))}."
(lambda ()
(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
(syntax-rules ()
((_ name ...)

38
module/ice-9/r6rs-libraries.scm
View file

@ -121,26 +121,36 @@
(define (compute-exports ifaces specs)
(define (re-export? sym)
(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)
(() (values e r))
(() (values e r x))
(((rename (from to) ...) . rest)
(and (and-map identifier? #'(from ...))
(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 ()
(() (lp #'rest e r))
(() (lp #'rest e r x))
(((from . to) . in)
(if (re-export? (syntax->datum #'from))
(lp2 #'in e (cons #'(from . to) r))
(lp2 #'in (cons #'(from . to) e) r))))))
(cond
((re-export? (syntax->datum #'from))
(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)
(identifier? #'id)
(let ((sym (syntax->datum #'id)))
(if (re-export? sym)
(lp #'rest e (cons #'id r))
(lp #'rest (cons #'id e) r)))))))
(cond
((re-export? sym)
(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)
((_ (name name* ...)
@ -169,9 +179,10 @@
(import-set (resolve-r6rs-interface #'import-set))))
#'(ispec ...))
#'(espec ...)))
(lambda (exports re-exports)
(lambda (exports re-exports replacements)
(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
;; definition, and pop it after the library definition, but I
;; actually can't see a way to do that. Helper procedures perhaps,
@ -183,8 +194,9 @@
#:version (version ...))
(import ispec)
...
(re-export r ...)
(export e ...)
(re-export r ...)
(export! x ...)
(@@ (name name* ...) body)
...))))))))