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

sync again

Browse Source 
svn: r13624
This commit is contained in:
Sam Tobin-Hochstadt 2009-02-15 22:03:05 +00:00
commit c9377a1f9d
3 changed files with 63 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
collects/redex/private/matcher.ss
View File

@ -764,7 +764,7 @@ before the pattern compiler is invoked.
#f
filtered)))))
has-hole?))]
[(? (lambda (x) (list? x))) ;; this eta expansion is to defeat a bug in match
[(? list?)
(let-values ([(rewritten has-hole?) (rewrite-ellipses non-underscore-binder? pattern compile-pattern/default-cache)])
(let ([count (and (not (ormap repeat? rewritten))
(length rewritten))])

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

@ -214,7 +214,8 @@ improve method arity mismatch contract violation error messages?
[(_ marker blame-stx ((p c) ...) (u ...) body0 body ...)
(let ([expanded-body0 (local-expand #'body0
(syntax-local-context)
(kernel-form-identifier-list))])
(cons #'splicing-syntax-parameterize
(kernel-form-identifier-list)))])
(syntax-case expanded-body0 (begin define-values)
[(begin sub ...)
(syntax/loc stx
@ -267,6 +268,19 @@ improve method arity mismatch contract violation error messages?
u-def ... p/c-def ...
(with-contract-helper marker blame-stx #,unused-p/cs #,unused-us
body ...)))))]
[(splicing-syntax-parameterize bindings . ssp-body)
(let* ([marker-f (let ([marker (syntax-e #'marker)])
(lambda (stx)
(syntax-local-introduce
(marker (syntax-local-introduce stx)))))]
[expanded-ssp (local-expand (quasisyntax/loc expanded-body0
(splicing-syntax-parameterize bindings .
#,(marker-f #'ssp-body)))
(syntax-local-context)
(kernel-form-identifier-list))])
(quasisyntax/loc stx
(begin #,expanded-ssp
(with-contract-helper marker blame-stx ((p c) ...) (u ...) body ...))))]
[else
(let*-values ([(marker-f) (let ([marker (syntax-e #'marker)])
(lambda (stx)

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

@ -2476,7 +2476,53 @@
(define (evenp n)
(if (zero? n) #t (oddp (zero? n)))))
(oddp 5)))
(test/spec-passed
'with-contract5
'(let ()
(with-contract region1
([x (-> number? number?)])
(with-contract region2
([y (-> number? boolean?)])
(define (y n) #t))
(define (x n) (if (y n) 0 3)))
(x 4)))
(test/spec-failed
'with-contract6
'(let ()
(with-contract region1
([x (-> number? number?)])
(with-contract region2
([y (-> number? boolean?)])
(define (y n) #t))
(define (x n) (y n)))
(x 4))
"(region region1)")
(test/spec-failed
'with-contract7
'(let ()
(with-contract region1
([x (-> number? number?)])
(with-contract region2
([y (-> number? boolean?)])
(define (y n) #t))
(define (x n) (if (y #t) 4 0)))
(x 4))
"(region region1)")
(test/spec-failed
'with-contract8
'(let ()
(with-contract region1
([x (-> number? number?)])
(with-contract region2
([y (-> number? boolean?)])
(define (y n) 3))
(define (x n) (if (y n) 4 0)))
(x 4))
"(region region2)")
;
;