fix unit signature 'open' by adjusting 'rename', 'only', and 'execpt'

svn: r12964
This commit is contained in:
Matthew Flatt 2009-01-01 21:15:56 +00:00
parent ca913054d3
commit 1c38bd2d3f
2 changed files with 34 additions and 33 deletions

View File

@ -151,17 +151,17 @@
(raise-stx-err "not a unit definition" id)) (raise-stx-err "not a unit definition" id))
u)) u))
;; check-module-id-subset : (listof syntax-object) (listof identifier) syntax-object -> ;; check-bound-id-subset : (listof syntax-object) (listof identifier) syntax-object ->
;; ensures each element of i1 is an identifier module-identifier=? to an identifier in i2 ;; ensures each element of i1 is an identifier bound-identifier=? to an identifier in i2
(define (check-module-id-subset i1 i2) (define (check-bound-id-subset i1 i2)
(let ((ht (make-module-identifier-mapping))) (let ((ht (make-bound-identifier-mapping)))
(for-each (lambda (id) (for-each (lambda (id)
(module-identifier-mapping-put! ht id #t)) (bound-identifier-mapping-put! ht id #t))
i2) i2)
(for-each (for-each
(lambda (id) (lambda (id)
(check-id id) (check-id id)
(unless (module-identifier-mapping-get ht id (lambda () #f)) (unless (bound-identifier-mapping-get ht id (lambda () #f))
(raise-stx-err "listed identifier not present in signature specification" id))) (raise-stx-err "listed identifier not present in signature specification" id)))
i1))) i1)))
@ -169,20 +169,20 @@
;; internals and externals must both be of the form (x ...) ;; internals and externals must both be of the form (x ...)
;; ensures that each x above is an identifier ;; ensures that each x above is an identifier
(define (do-rename sig internals externals) (define (do-rename sig internals externals)
(check-module-id-subset (syntax->list externals) (check-bound-id-subset (syntax->list externals)
(sig-int-names sig)) (sig-int-names sig))
(let ((ht (make-module-identifier-mapping))) (let ((ht (make-bound-identifier-mapping)))
(for-each (for-each
(lambda (int ext) (lambda (int ext)
(check-id int) (check-id int)
(when (module-identifier-mapping-get ht ext (lambda () #f)) (when (bound-identifier-mapping-get ht ext (lambda () #f))
(raise-stx-err "duplicate renamings" ext)) (raise-stx-err "duplicate renamings" ext))
(module-identifier-mapping-put! ht ext int)) (bound-identifier-mapping-put! ht ext int))
(syntax->list internals) (syntax->list internals)
(syntax->list externals)) (syntax->list externals))
(map-sig (map-sig
(lambda (id) (lambda (id)
(module-identifier-mapping-get ht id (lambda () id))) (bound-identifier-mapping-get ht id (lambda () id)))
(lambda (x) x) (lambda (x) x)
sig))) sig)))
@ -199,17 +199,17 @@
;; do-only/except : sig (listof identifier) -> sig ;; do-only/except : sig (listof identifier) -> sig
;; ensures that only-ids are identifiers and are mentioned in the signature ;; ensures that only-ids are identifiers and are mentioned in the signature
(define (do-only/except sig only/except-ids put get) (define (do-only/except sig only/except-ids put get)
(check-module-id-subset only/except-ids (check-bound-id-subset only/except-ids
(sig-int-names sig)) (sig-int-names sig))
(let ((ht (make-module-identifier-mapping))) (let ((ht (make-bound-identifier-mapping)))
(for-each (lambda (id) (for-each (lambda (id)
(module-identifier-mapping-put! ht id (put id))) (bound-identifier-mapping-put! ht id (put id)))
only/except-ids) only/except-ids)
(map-sig (map-sig
(lambda (id) (lambda (id)
(module-identifier-mapping-get ht id (bound-identifier-mapping-get ht id
(lambda () (lambda ()
(get id)))) (get id))))
(lambda (x) x) (lambda (x) x)
sig))) sig)))

View File

@ -89,24 +89,25 @@ ways:
As an export, this form causes definitions using the @scheme[id] As an export, this form causes definitions using the @scheme[id]
prefix to satisfy the exports required by @scheme[sig-spec].} prefix to satisfy the exports required by @scheme[sig-spec].}
@item{@scheme[(rename sig-spec (id id) ...)] as @item{@scheme[(rename sig-spec (id id) ...)] as an import binds the
an import binds the same as @scheme[sig-spec], except that the first @scheme[id] same as @scheme[sig-spec], except that the first @scheme[id] is used
is used for the binding instead of the second @scheme[id] (where for the binding instead of the second @scheme[id] (where
@scheme[sig-spec] by itself must imply a binding for the second @scheme[id]). @scheme[sig-spec] by itself must imply a bindingthat is
As an export, this form causes a definition for the first @scheme[id] @scheme[bound-identifier=?] to second @scheme[id]). As an export,
to satisfy the export named by the second @scheme[id] in @scheme[sig-spec].} this form causes a definition for the first @scheme[id] to satisfy
the export named by the second @scheme[id] in @scheme[sig-spec].}
@item{@scheme[(only sig-spec id ...)] as @item{@scheme[(only sig-spec id ...)] as an import binds the same as
an import binds the same as @scheme[sig-spec], but restricted to just the @scheme[sig-spec], but restricted to just the listed @scheme[id]s
listed @scheme[id]s (where (where @scheme[sig-spec] by itself must imply a binding that is
@scheme[sig-spec] by itself must imply a binding for each @scheme[id]). @scheme[bound-identifier=?] to each @scheme[id]). This form is not
This form is not allowed for an export.} allowed for an export.}
@item{@scheme[(except sig-spec id ...)] as @item{@scheme[(except sig-spec id ...)] as an import binds the same
an import binds the same as @scheme[sig-spec], but excluding all listed as @scheme[sig-spec], but excluding all listed @scheme[id]s (where
@scheme[id]s (where @scheme[sig-spec] by itself must imply a binding that is
@scheme[sig-spec] by itself must imply a binding for each @scheme[id]). @scheme[bound-identifier=?] to each @scheme[id]). This form is not
This form is not allowed for an export.} allowed for an export.}
} }