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

Identifiers in signature contracts don't use whatever prefixing or such may be

Browse Source 
in play in the body of a unit, so we need to rename the "external" version to
the "internal" version.  This fixes PR 10246.

svn: r17571

original commit: 9e0f2a3c5f6626843e6353c5ec83a546c483ebfc
This commit is contained in:
Stevie Strickland 2010-01-08 17:20:19 +00:00
parent 966b57ac62
commit 623bfd4e9b
1 changed files with 19 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

30
collects/mzlib/unit.ss
View File

@ -463,13 +463,13 @@
(cons (car x)
(signature-siginfo (lookup-signature (cdr x)))))
(define-for-syntax (make-import-unboxing var loc ctc)
(define-for-syntax (make-import-unboxing var renamings loc ctc)
(if ctc
(with-syntax ([ctc-stx (syntax-property ctc 'inferred-name var)])
(quasisyntax/loc (error-syntax)
(quote-syntax (let ([v/c (#,loc)])
(if (pair? v/c)
(contract ctc-stx (car v/c) (cdr v/c)
(contract (let-syntax #,renamings ctc-stx) (car v/c) (cdr v/c)
(current-contract-region)
#,(id->contract-src-info var))
(error 'unit "contracted import ~a used before definition"
@ -561,16 +561,24 @@
(let-values ([(iloc ...)
(vector->values (hash-table-get import-table import-key) 0 icount)]
...)
(letrec-syntaxes (#,@(map (lambda (ivs ils ics)
(quasisyntax/loc (error-syntax)
[#,ivs
(make-id-mappers
#,@(map (lambda (iv l c)
(make-import-unboxing iv l c))
(syntax->list ivs)
(syntax->list ils)
ics))]))
(letrec-syntaxes (#,@(map (lambda (ivs e-ivs ils ics)
(with-syntax ([renamings
(map (λ (ev iv)
#`(#,ev
(make-rename-transformer
(quote-syntax #,iv))))
(syntax->list e-ivs)
(syntax->list ivs))])
(quasisyntax/loc (error-syntax)
[#,ivs
(make-id-mappers
#,@(map (lambda (iv l c)
(make-import-unboxing iv #'renamings l c))
(syntax->list ivs)
(syntax->list ils)
ics))])))
(syntax->list #'((int-ivar ...) ...))
(syntax->list #'((ext-ivar ...) ...))
(syntax->list #'((iloc ...) ...))
(map cadddr import-sigs)))
(letrec-syntaxes+values (renames ...