Updated local-expand of contract forms in require/contract.

svn: r17725

original commit: 9e540043bca10416a07cdb7dc36729cd62b648d9
This commit is contained in:
Carl Eastlund 2010-01-19 00:20:54 +00:00
parent 34bb0090a0
commit 2fda2984ab

View File

@ -1,9 +1,12 @@
#lang scheme/base
(require scheme/contract (for-syntax scheme/base syntax/kerncase
syntax/parse
"../utils/tc-utils.ss"
(prefix-in tr: "../private/typed-renaming.ss")))
(require scheme/contract
unstable/location
(for-syntax scheme/base
syntax/kerncase
syntax/parse
"../utils/tc-utils.ss"
(prefix-in tr: "../private/typed-renaming.ss")))
(provide require/contract define-ignored)
@ -19,7 +22,7 @@
(define name #,(syntax-property #'e*
'inferred-name
(syntax-e #'name))))]
[(begin (begin e))
[(begin e)
#`(define name #,(syntax-property #'e
'inferred-name
(syntax-e #'name)))])]))
@ -42,7 +45,8 @@
(get-alternate nm.r)
'(interface for #,(syntax->datum #'nm))
'never-happen
(quote-syntax nm))))]
(quote nm)
(quote-srcloc nm))))]
[(require/contract (orig-nm:renameable nm:id) cnt lib)
#`(begin (require (only-in lib [orig-nm orig-nm.r]))
(define-ignored nm
@ -50,4 +54,5 @@
(get-alternate orig-nm.r)
'#,(syntax->datum #'nm)
'never-happen
(quote-syntax nm))))]))
(quote nm)
(quote-srcloc nm))))]))