From 1943083cf921d86dfc6b40ecbb5af855ede66ded Mon Sep 17 00:00:00 2001
From: Stevie Strickland <sstrickl@racket-lang.org>
Date: Sun, 15 Feb 2009 21:59:22 +0000
Subject: [PATCH 1/2] Fix nested with-contracts by checking explicitly for
 ssps.  Apparently painting the bindings causes the ssp to later fail when you
 try to access the parameter.  Not sure if this is a bug or not, will talk to
 Matthew.

svn: r13621
---
 collects/scheme/private/contract.ss      | 16 +++++++-
 collects/tests/mzscheme/contract-test.ss | 48 +++++++++++++++++++++++-
 2 files changed, 62 insertions(+), 2 deletions(-)

diff --git a/collects/scheme/private/contract.ss b/collects/scheme/private/contract.ss
index 15f476b2fb..acae98e8bd 100644
--- a/collects/scheme/private/contract.ss
+++ b/collects/scheme/private/contract.ss
@@ -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)
diff --git a/collects/tests/mzscheme/contract-test.ss b/collects/tests/mzscheme/contract-test.ss
index fef049973d..2e4c85d6f9 100644
--- a/collects/tests/mzscheme/contract-test.ss
+++ b/collects/tests/mzscheme/contract-test.ss
@@ -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)")
 
 ;                                                                                                                         
 ;                                                                                                                         

From 72e118d92fb910e30345b81682314120c7db9926 Mon Sep 17 00:00:00 2001
From: Sam Tobin-Hochstadt <samth@racket-lang.org>
Date: Sun, 15 Feb 2009 21:59:55 +0000
Subject: [PATCH 2/2] Remove eta expansion, match is now fixed.

svn: r13622
---
 collects/redex/private/matcher.ss | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/collects/redex/private/matcher.ss b/collects/redex/private/matcher.ss
index 09fd40f5a7..64016610fe 100644
--- a/collects/redex/private/matcher.ss
+++ b/collects/redex/private/matcher.ss
@@ -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))])