fix unit signature 'open' by adjusting 'rename', 'only', and 'execpt'
svn: r12964
This commit is contained in:
parent
ca913054d3
commit
1c38bd2d3f
|
@ -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,15 +199,15 @@
|
||||||
;; 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)
|
||||||
|
|
|
@ -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.}
|
||||||
|
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue
Block a user