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

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

Browse Source 
svn: r17725
This commit is contained in:
Carl Eastlund 2010-01-19 00:20:54 +00:00
parent 0edd786361
commit 9e540043bc
1 changed files with 12 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
collects/typed-scheme/utils/require-contract.ss
View File

@ -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))))]))