generalized except-out

svn: r9015
This commit is contained in:
Matthew Flatt 2008-03-18 13:38:13 +00:00
parent b34d267438
commit 3a763f3bcc
2 changed files with 28 additions and 32 deletions

View File

@ -750,41 +750,36 @@
(make-provide-transformer
(lambda (stx modes)
(syntax-case stx ()
[(_ out id ...)
[(_ out spec ...)
(let ([exports (expand-export #'out modes)]
[ids (syntax->list #'(id ...))])
(for-each (lambda (id)
(unless (identifier? id)
(raise-syntax-error
#f
"expected <id>, but found something else"
stx
id)))
ids)
(let ([dup-id (check-duplicate-identifier ids)])
(when dup-id
(raise-syntax-error
#f
"duplicate identifier"
stx
dup-id)))
(for-each (lambda (id)
[exceptions (apply
append
(map (lambda (spec)
(expand-export spec modes))
(syntax->list #'(spec ...))))])
(for-each (lambda (exception)
(or (ormap (lambda (export)
(free-identifier=? id (export-local-id export)
(export-mode export)))
(and (eq? (export-mode export)
(export-mode exception))
(free-identifier=? (export-local-id exception)
(export-local-id export)
(export-mode export))))
exports)
(raise-syntax-error
#f
(format "identifier `~a' not included in nested provide spec"
(syntax-e id))
(format "identifier to remove `~a' not included in nested provide spec"
(syntax-e (export-local-id exception)))
stx
#'out)))
ids)
exceptions)
(filter (lambda (export)
(not (ormap (lambda (id)
(free-identifier=? id (export-local-id export)
(export-mode export)))
ids)))
(not (ormap (lambda (exception)
(and (eq? (export-mode export)
(export-mode exception))
(free-identifier=? (export-local-id exception)
(export-local-id export)
(export-mode export))))
exceptions)))
exports))]))))
(define-for-syntax (build-name id . parts)

View File

@ -1494,7 +1494,7 @@ an identifier can be either imported or defined for a given
(all-defined-out)
(all-from-out module-path ...)
(rename-out [orig-id export-id] ...)
(except-out provide-spec id ...)
(except-out provide-spec provide-spec ...)
(prefix-out prefix-id provide-spec)
(struct-out id)
(combine-out provide-spec ...)
@ -1552,10 +1552,11 @@ follows.
@tech{phase level} 0. The symbolic name for each export is
@scheme[export-id] instead @scheme[orig-d].}
@defsubform[(except-out provide-spec id ...)]{ Like
@scheme[provide-spec], but omitting the export of each binding with
external name @scheme[id]. If @scheme[id] is not specified as an
export by @scheme[provide-spec], a syntax error is reported.}
@defsubform[(except-out provide-spec provide-spec ...)]{ Like the
first @scheme[provide-spec], but omitting the bindings listed in each
subsequent @scheme[provide-spec]. If one of the latter bindings is
not included in the initial @scheme[provide-spec], a syntax error is
reported.}
@defsubform[(prefix-out prefix-id provide-spec)]{
Like @scheme[provide-spec], but with each symbolic export name from