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

Instead of just using the quoted versions of the contracts, actually evaluate

Browse Source 
them, with signature elements rewritten to quoted versions of the same, so
that we get a better result for the name of the contract used by contract
errors.

svn: r13903
This commit is contained in:
Stevie Strickland 2009-03-03 02:00:31 +00:00
parent ea156c984c
commit 2f065df887
1 changed files with 24 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

26
collects/mzlib/private/unit-contract.ss
View File

@ -122,6 +122,10 @@
(with-syntax ([(isig ...) isig]
[(esig ...) esig]
[((import-id ...) ...)
(map (λ (sig) (map car (car sig))) import-sigs)]
[((export-id ...) ...)
(map (λ (sig) (map car (car sig))) export-sigs)]
[((import-key ...) ...)
(map tagged-info->keys import-tagged-infos)]
[((export-key ...) ...)
@ -139,12 +143,30 @@
(cons 'import
(list (cons 'isig
(map list (list 'i.x ...)
(build-compound-type-name 'i.c ...)))
(let-syntax ([import-id
(make-set!-transformer
(λ (stx)
(syntax-case stx (set!)
[(id . x)
#'(list 'import-id . x)]
[id
(identifier? #'id)
#''import-id])))] ...)
(build-compound-type-name i.c ...))))
...))
(cons 'export
(list (cons 'esig
(map list (list 'e.x ...)
(build-compound-type-name 'e.c ...)))
(let-syntax ([export-id
(make-set!-transformer
(λ (stx)
(syntax-case stx (set!)
[(id . x)
#'(list 'export-id . x)]
[id
(identifier? #'id)
#''export-id])))] ...)
(build-compound-type-name e.c ...))))
...)))
(λ (pos neg src-info name)
(λ (unit-tmp)