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

checkpoint

Browse Source 
svn: r17045
This commit is contained in:
Sam Tobin-Hochstadt 2009-11-24 17:10:44 +00:00
parent 176920530f
commit 29c4a84183
4 changed files with 12 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
collects/tests/typed-scheme/fail/back-and-forth.ss
View File

@ -1,18 +1,19 @@
#;
(exn-pred exn:fail:contract? #rx".*violator.*contract.*\\(-> Number Number\\).*")
(exn-pred exn:fail:contract? #rx".*violator.*contract.*\\(-> Number Number\\).*f.*")
#lang scheme/load
(module m typed/scheme
(: f (Number -> Number))
(define (f x) (add1 x))
(provide f))
(define g 17)
(provide f g))
(module violator scheme
(require 'm)
(f 'foo))
(module o typed-scheme
(module o typed/scheme
(require 'violator))
(require 'o)

2
collects/typed-scheme/ts-reference.scrbl
View File

@ -228,7 +228,7 @@ This is legal only in expression contexts.}
appropriate number of type variables. This is legal only in expression
contexts.}
@schemevarfont|{#{e @ t ...}}| This is identical to @scheme[(inst e t ...)].
@litchar|{#{e @ t ...}}| This is identical to @scheme[(inst e t ...)].
@subsection{Require}

8
collects/typed-scheme/typecheck/provide-handling.ss
View File

@ -33,7 +33,7 @@
(make-typed-renaming (syntax-property id 'not-free-identifier=? #t) alt)
(make-rename-transformer (syntax-property id 'not-free-identifier=? #t))))
(define (generate-prov stx-defs val-defs)
(define (generate-prov stx-defs val-defs pos-blame-id)
(define mapping (make-free-identifier-mapping))
(lambda (form)
(define (mem? i vd)
@ -59,19 +59,15 @@
=>
(lambda (cnt)
(with-syntax ([(export-id cnt-id) (generate-temporaries #'(id id))]
[module-source (generate-temporary 'module-source)]
;; don't actually need to verify - this is generated
[module-source pos-blame-id]
[the-contract (generate-temporary 'generated-contract)])
#`(begin
(define module-source (#%variable-reference))
(define the-contract #,cnt)
(define-syntax cnt-id
(make-provide/contract-transformer
(quote-syntax the-contract)
(quote-syntax id)
(quote-syntax module-source)))
#;
(define/contract cnt-id #,cnt id)
(define-syntax export-id
(if (unbox typed-context?)
(renamer #'id #:alt #'cnt-id)

8
collects/typed-scheme/typecheck/tc-toplevel.ss
View File

@ -3,7 +3,7 @@
(require (rename-in "../utils/utils.ss" [infer r:infer]))
(require syntax/kerncase
unstable/list
unstable/list unstable/syntax
mzlib/etc
scheme/match
"signatures.ss"
@ -253,9 +253,11 @@
;; report delayed errors
(report-all-errors)
;; compute the new provides
(with-syntax
([((new-provs ...) ...) (map (generate-prov stx-defs val-defs) provs)])
(with-syntax*
([the-variable-reference (generate-temporary #'blame)]
[((new-provs ...) ...) (map (generate-prov stx-defs val-defs #'the-variable-reference) provs)])
#`(begin
(define the-variable-reference (#%variable-reference))
#,(env-init-code)
#,(tname-env-init-code)
#,(talias-env-init-code)