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