suzanne.soy/compatibility
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

unit clean-up

Browse Source 
svn: r5160

original commit: 7b13755dadb4945ff467a1d6b1a067e76a53767c
This commit is contained in:
Matthew Flatt 2006-12-22 01:26:58 +00:00
parent 0956729355
commit 4022f6d97c
1 changed files with 18 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

22
collects/mzlib/unit.ss
View File

@ -206,12 +206,12 @@
((((vid ...) . vbody) ...) all-val-defs)
((((sid ...) . sbody) ...) all-stx-defs))
#`(begin
(define x (gensym))
(define signature-tag (gensym))
(define-syntax #,sigid
(make-set!-transformer
(make-signature
(make-siginfo (list #'#,sigid #'super-name ...)
(list ((syntax-local-certifier) (quote-syntax x))
(list ((syntax-local-certifier) (quote-syntax signature-tag))
#'super-rtime
...))
(list (quote-syntax var) ...)
@ -294,12 +294,26 @@
(define-for-syntax (signature->identifiers sigids)
(define provide-tagged-sigs (map process-tagged-import sigids))
(define provide-sigs (map caddr provide-tagged-sigs))
(apply append (map sig-int-names provide-sigs)))
(map sig-int-names provide-sigs))
(define-syntax/err-param (provide-signature-elements stx)
(syntax-case stx ()
((_ . p)
(let* ((names (signature->identifiers (checked-syntax->list #'p)))
(let* ((sigs (checked-syntax->list #'p))
(nameses (signature->identifiers sigs))
;; Export only the names that would be visible to uses
;; with the same lexical context as p. Otherwise, we
;; can end up with collisions with renamings that are
;; symbolically the same, such as those introduced by
;; `open'.
(nameses (map (lambda (sig names)
(filter (lambda (name)
(bound-identifier=?
name
(datum->syntax-object sig (syntax-e name))))
names))
sigs nameses))
(names (apply append nameses))
(dup (check-duplicate-identifier names)))
(when dup
(raise-stx-err (format "duplicate binding for ~e" (syntax-e dup))))