Updated local-expand of contract forms in require/contract.
svn: r17725
This commit is contained in:
parent
0edd786361
commit
9e540043bc
|
@ -1,6 +1,9 @@
|
||||||
#lang scheme/base
|
#lang scheme/base
|
||||||
|
|
||||||
(require scheme/contract (for-syntax scheme/base syntax/kerncase
|
(require scheme/contract
|
||||||
|
unstable/location
|
||||||
|
(for-syntax scheme/base
|
||||||
|
syntax/kerncase
|
||||||
syntax/parse
|
syntax/parse
|
||||||
"../utils/tc-utils.ss"
|
"../utils/tc-utils.ss"
|
||||||
(prefix-in tr: "../private/typed-renaming.ss")))
|
(prefix-in tr: "../private/typed-renaming.ss")))
|
||||||
|
@ -19,7 +22,7 @@
|
||||||
(define name #,(syntax-property #'e*
|
(define name #,(syntax-property #'e*
|
||||||
'inferred-name
|
'inferred-name
|
||||||
(syntax-e #'name))))]
|
(syntax-e #'name))))]
|
||||||
[(begin (begin e))
|
[(begin e)
|
||||||
#`(define name #,(syntax-property #'e
|
#`(define name #,(syntax-property #'e
|
||||||
'inferred-name
|
'inferred-name
|
||||||
(syntax-e #'name)))])]))
|
(syntax-e #'name)))])]))
|
||||||
|
@ -42,7 +45,8 @@
|
||||||
(get-alternate nm.r)
|
(get-alternate nm.r)
|
||||||
'(interface for #,(syntax->datum #'nm))
|
'(interface for #,(syntax->datum #'nm))
|
||||||
'never-happen
|
'never-happen
|
||||||
(quote-syntax nm))))]
|
(quote nm)
|
||||||
|
(quote-srcloc nm))))]
|
||||||
[(require/contract (orig-nm:renameable nm:id) cnt lib)
|
[(require/contract (orig-nm:renameable nm:id) cnt lib)
|
||||||
#`(begin (require (only-in lib [orig-nm orig-nm.r]))
|
#`(begin (require (only-in lib [orig-nm orig-nm.r]))
|
||||||
(define-ignored nm
|
(define-ignored nm
|
||||||
|
@ -50,4 +54,5 @@
|
||||||
(get-alternate orig-nm.r)
|
(get-alternate orig-nm.r)
|
||||||
'#,(syntax->datum #'nm)
|
'#,(syntax->datum #'nm)
|
||||||
'never-happen
|
'never-happen
|
||||||
(quote-syntax nm))))]))
|
(quote nm)
|
||||||
|
(quote-srcloc nm))))]))
|
||||||
|
|
Loading…
Reference in New Issue
Block a user