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

Disallow unit/new-import-export if contracts are involved. This is not

Browse Source 
planned to be permanent, but until I've figured out how to implement the
fix, just say no.

svn: r13311

original commit: 2f323578def1504977a1238d3d5c5fbfece9cd1e
This commit is contained in:
Stevie Strickland 2009-01-29 07:19:23 +00:00
parent 8f3c97eab8
commit 122b049167
1 changed files with 30 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

44
collects/mzlib/unit.ss
View File

@ -762,29 +762,45 @@
(define v
#`(hash-table-get #,table-stx #,(car (tagged-info->keys tagged-info))))
(for-each
(lambda (int/ext-name index)
(lambda (int/ext-name index ctc)
(bound-identifier-mapping-put! def-table
(car int/ext-name)
#`(vector-ref #,v #,index)))
(cons #`(vector-ref #,v #,index) ctc)))
(car sig)
(iota (length (car sig)))))
(iota (length (car sig)))
(cadddr sig)))
import-tagged-infos
import-sigs)
(with-syntax ((((eloc ...) ...)
(map
(lambda (target-sig)
(map
(lambda (target-int/ext-name)
(bound-identifier-mapping-get
def-table
(car target-int/ext-name)
(lambda ()
(raise-stx-err
(format (if import?
"identifier ~a is not present in new imports"
"identifier ~a is not present in old export")
(syntax-e (car target-int/ext-name)))))))
(car target-sig)))
(lambda (target-int/ext-name target-ctc)
(when target-ctc
(raise-stx-err
(format (if import?
"identifier ~a is contracted in old imports"
"identifier ~a is contracted in new exports")
(syntax-e (car target-int/ext-name)))))
(let ([vref/ctc
(bound-identifier-mapping-get
def-table
(car target-int/ext-name)
(lambda ()
(raise-stx-err
(format (if import?
"identifier ~a is not present in new imports"
"identifier ~a is not present in old exports")
(syntax-e (car target-int/ext-name))))))])
(when (cdr vref/ctc)
(raise-stx-err
(format (if import?
"identifier ~a is contracted in new imports"
"identifier ~a is contracted in old exports")
(syntax-e (car target-int/ext-name)))))
(car vref/ctc)))
(car target-sig)
(cadddr target-sig)))
target-import-sigs))
(((export-keys ...) ...)
(map tagged-info->keys target-import-tagged-infos)))