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

Add the first-order free variable contract checks I mentioned earlier.

Browse Source 
svn: r13707
This commit is contained in:
Stevie Strickland 2009-02-17 20:50:56 +00:00
parent 9098c94e9c
commit 3ff2184a38
2 changed files with 18 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
collects/scheme/private/contract.ss
View File

@ -317,6 +317,7 @@ improve method arity mismatch contract violation error messages?
(marker (a:mangle-id stx "with-contract-contract-id" i))) (marker (a:mangle-id stx "with-contract-contract-id" i)))
free-vars)] free-vars)]
[(free-ctc ...) free-ctcs] [(free-ctc ...) free-ctcs]
[(free-src-info ...) (map id->contract-src-info free-vars)]
[(ctc-id ...) (map (λ (i) [(ctc-id ...) (map (λ (i)
(marker (a:mangle-id stx "with-contract-contract-id" i))) (marker (a:mangle-id stx "with-contract-contract-id" i)))
protected)] protected)]
@ -348,6 +349,11 @@ improve method arity mismatch contract violation error messages?
blame-stx blame-stx
'cant-happen 'cant-happen
src-info) ... src-info) ...
(-contract free-ctc-id
free-var
blame-id
'cant-happen
free-src-info) ...
(values))) (values)))
(define-syntaxes (u ... p ...) (define-syntaxes (u ... p ...)
(values (make-rename-transformer #'marked-u) ... (values (make-rename-transformer #'marked-u) ...

12
collects/tests/mzscheme/contract-test.ss
View File

@ -2465,6 +2465,18 @@
(f 5)) (f 5))
"(function f)") "(function f)")
(test/spec-failed
'define/contract25
'(let ()
(define y #t)
(define z 3)
(define/contract f
number?
#:freevars ([y number?] [z number?])
(+ y z))
1)
"top-level")
; ;
; ;