From 2393ae10330bea8cc970c025337e01566f30100c Mon Sep 17 00:00:00 2001
From: Eric Dobson <eric.n.dobson@gmail.com>
Date: Mon, 4 Jul 2011 20:16:54 -0400
Subject: [PATCH] Clean up some contract errors and type->contract. Closes
 PR11756.

original commit: bf72db0f7b5120f9de8aa3c4a912de935256f605
---
 .../tests/typed-scheme/succeed/pr11756.rkt    | 10 ++++++++++
 .../typed-scheme/private/type-contract.rkt    |  2 +-
 .../typecheck/check-subforms-unit.rkt         | 20 ++++++++++---------
 3 files changed, 22 insertions(+), 10 deletions(-)
 create mode 100644 collects/tests/typed-scheme/succeed/pr11756.rkt

diff --git a/collects/tests/typed-scheme/succeed/pr11756.rkt b/collects/tests/typed-scheme/succeed/pr11756.rkt
new file mode 100644
index 00000000..6970d855
--- /dev/null
+++ b/collects/tests/typed-scheme/succeed/pr11756.rkt
@@ -0,0 +1,10 @@
+#lang typed/racket/base
+
+(: test : (All (X) X -> (All (Y) Y -> X)))
+(define (test n)
+  (: helper : (All (Z) Z -> X))
+  (define (helper m) n)
+  helper)
+
+; if the below is commented out the code runs without errors
+(provide test)
diff --git a/collects/typed-scheme/private/type-contract.rkt b/collects/typed-scheme/private/type-contract.rkt
index 12b4fc26..7797514b 100644
--- a/collects/typed-scheme/private/type-contract.rkt
+++ b/collects/typed-scheme/private/type-contract.rkt
@@ -204,7 +204,7 @@
 	[(Poly: vs b)
          (if from-typed?
              ;; in positive position, no checking needed for the variables
-             (parameterize ([vars (append (for/list ([v vs]) (list v #'any/c)))])
+             (parameterize ([vars (append (for/list ([v vs]) (list v #'any/c)) (vars))])
                (t->c b))
              ;; in negative position, use `parameteric/c'
              (match-let ([(Poly-names: vs-nm _) ty])
diff --git a/collects/typed-scheme/typecheck/check-subforms-unit.rkt b/collects/typed-scheme/typecheck/check-subforms-unit.rkt
index b7c142f5..9c4d0ec2 100644
--- a/collects/typed-scheme/typecheck/check-subforms-unit.rkt
+++ b/collects/typed-scheme/typecheck/check-subforms-unit.rkt
@@ -33,23 +33,25 @@
          ;; if this needs to be checked
          #:when (syntax-property form 'typechecker:with-type)
          ;; the form should be already ascribed the relevant type
-	 (tc-expr form)]
+         (tc-expr form)]
         [stx
          ;; this is a handler function
          #:when (syntax-property form 'typechecker:exn-handler)
          (let ([t (tc-expr form)])
            (match t
-	     [(tc-result1:
-	       (and t
-		    (Function: (list (arr: (list _) _ _ _ (list (Keyword: _ _ #f) ...)) ...))))
-	      (set! handler-tys (cons (get-result-ty t) handler-tys))]
-	     [(tc-results: t)
-	      (tc-error "Exception handler must be a single-argument function, got \n~a" t)]))]
+             [(tc-result1:
+               (and t
+                    (Function: (list (arr: (list _) _ _ _ (list (Keyword: _ _ #f) ...)) ...))))
+              (set! handler-tys (cons (get-result-ty t) handler-tys))]
+             [(tc-results: t)
+              (tc-error "Exception handler must be a single-argument function, got \n~a" t)]))]
         [stx
          ;; this is the body of the with-handlers
          #:when (syntax-property form 'typechecker:exn-body)
-         (match-let ([(tc-results: ts) (tc-expr form)])
-           (set! body-ty (-values ts)))]
+         (match (tc-expr form)
+          [(tc-result1: t) (set! body-ty t)]
+          [(tc-results: ts) (tc-expr form)
+           (tc-error "Exception handler body must return a single value, got \n~a" (length ts))])]
         [(a . b)
 	 (loop #'a)
 	 (loop #'b)]