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

Fix bug 9649.

Browse Source 
svn: r11029

original commit: 28c5e71b01454eda4328a8abceed12f11aaeb865
This commit is contained in:
Sam Tobin-Hochstadt 2008-08-01 20:57:48 +00:00
parent ef047be955
commit 4f7c6aff6a
3 changed files with 28 additions and 18 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
collects/tests/typed-scheme/succeed/require-typed-rename.ss Normal file
View File

@ -0,0 +1,5 @@
#lang typed-scheme
(require/typed srfi/67 [(char-compare s67:char-compare) (Char Char -> Integer)])
s67:char-compare

37
collects/typed-scheme/private/prims.ss
View File

@ -59,24 +59,25 @@ This file defines two sorts of primitives. All of them are provided into any mod
#'(begin (require/typed nm ty lib) ...)]
[(_ nm ty lib)
(identifier? #'nm)
(quasisyntax/loc stx (begin
#,(syntax-property (syntax-property #'(define cnt* #f)
'typechecker:contract-def #'ty)
'typechecker:ignore #t)
#,(internal #'(require/typed-internal nm ty))
#,(syntax-property #'(require/contract nm cnt* lib)
'typechecker:ignore #t)))]
[(_ (rename internal-nm nm) ty lib)
(raise-syntax-error "rename not currently supported" stx)
#; #;
(identifier? #'nm)
(quasisyntax/loc stx (begin
#,(syntax-property (syntax-property #'(define cnt* #f)
'typechecker:contract-def #'ty)
'typechecker:ignore #t)
#,(internal #'(require/typed-internal internal-nm ty))
#,(syntax-property #'(require/contract nm cnt* lib)
'typechecker:ignore #t)))]))
(with-syntax ([(cnt*) (syntax->datum #'(nm))])
(quasisyntax/loc stx (begin
#,(syntax-property (syntax-property #'(define cnt* #f)
'typechecker:contract-def #'ty)
'typechecker:ignore #t)
#,(internal #'(require/typed-internal nm ty))
#,(syntax-property #'(require/contract nm cnt* lib)
'typechecker:ignore #t))))]
[(_ (orig-nm nm) ty lib)
(and (identifier? #'nm)
(identifier? #'orig-nm))
(with-syntax ([(cnt*) (syntax->datum #'(nm))])
(quasisyntax/loc stx (begin
#,(syntax-property (syntax-property #'(define cnt* #f)
'typechecker:contract-def #'ty)
'typechecker:ignore #t)
#,(internal #'(require/typed-internal nm ty))
#,(syntax-property #'(require/contract (orig-nm nm) cnt* lib)
'typechecker:ignore #t))))]))
(define-syntax (require/opaque-type stx)
(syntax-case stx ()

4
collects/typed-scheme/private/require-contract.ss
View File

@ -17,5 +17,9 @@
(define-syntax (require/contract stx)
(syntax-case stx ()
[(require/contract nm cnt lib)
(identifier? #'nm)
#`(begin (require (only-in lib [nm tmp]))
(define-ignored nm (contract cnt tmp '#,(syntax->datum #'nm) 'never-happen (quote-syntax nm))))]
[(require/contract (orig-nm nm) cnt lib)
#`(begin (require (only-in lib [orig-nm tmp]))
(define-ignored nm (contract cnt tmp '#,(syntax->datum #'nm) 'never-happen (quote-syntax nm))))]))