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

Make a table of the original imports these came from for easy lookup. This

Browse Source 
way we can actually bind only the identifiers which were in the original
signature over the contract.

svn: r13567

original commit: dba74f8f15c36dbacb0c18ee7a71dcf693d3969c
This commit is contained in:
Stevie Strickland 2009-02-14 02:33:15 +00:00
parent eb8a57c182
commit a434af8f5d
1 changed files with 9 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

20
collects/mzlib/unit.ss
View File

@ -661,11 +661,7 @@
target-import-sigs)
(define def-table (make-bound-identifier-mapping))
(define ctc-table (make-bound-identifier-mapping))
(define sig-of-all-import-sigs
(list (apply append (map car import-sigs))
(apply append (map cadr import-sigs))
(apply append (map caddr import-sigs))
(apply append (map cadddr import-sigs))))
(define sig-table (make-bound-identifier-mapping))
(for-each
(lambda (tagged-info sig)
(define v
@ -677,7 +673,10 @@
#`(vector-ref #,v #,index))
(bound-identifier-mapping-put! ctc-table
(car int/ext-name)
ctc))
ctc)
(bound-identifier-mapping-put! sig-table
(car int/ext-name)
sig))
(car sig)
(iota (length (car sig)))
(cadddr sig)))
@ -686,10 +685,6 @@
(with-syntax ((((eloc ...) ...)
(map
(lambda (target-sig)
(define rename-bindings
(get-member-bindings def-table
sig-of-all-import-sigs
#'(current-contract-region)))
(map
(lambda (target-int/ext-name target-ctc)
(let* ([var (car target-int/ext-name)]
@ -703,7 +698,10 @@
"identifier ~a is not present in new imports"
"identifier ~a is not present in old exports")
(syntax-e (car target-int/ext-name))))))]
[ctc (bound-identifier-mapping-get ctc-table var)])
[ctc (bound-identifier-mapping-get ctc-table var)]
[rename-bindings (get-member-bindings def-table
(bound-identifier-mapping-get sig-table var)
#'(current-contract-region))])
(if (or target-ctc ctc)
#`(cons
(λ ()