From b835002d72e06f13991ea4adbc6d052fa6fe0c0e Mon Sep 17 00:00:00 2001
From: Sam Tobin-Hochstadt <samth@racket-lang.org>
Date: Mon, 7 Jul 2008 19:21:42 -0400
Subject: [PATCH] Finally found a nasty bug involving variables not appearing
 in the hash table.

---
 collects/typed-scheme/private/tc-expr-unit.ss        | 2 +-
 collects/typed-scheme/private/type-effect-printer.ss | 8 ++++----
 collects/typed-scheme/private/type-rep.ss            | 7 +++----
 3 files changed, 8 insertions(+), 9 deletions(-)

diff --git a/collects/typed-scheme/private/tc-expr-unit.ss b/collects/typed-scheme/private/tc-expr-unit.ss
index d0a4acd1ca..32736434c4 100644
--- a/collects/typed-scheme/private/tc-expr-unit.ss
+++ b/collects/typed-scheme/private/tc-expr-unit.ss
@@ -71,7 +71,7 @@
          (tc-error/expr #:return (ret (Un)) 
                         "Wrong number of type arguments to polymorphic type ~a:~nexpected at least: ~a~ngot: ~a"
                         ty (sub1 (PolyDots-n ty)) (length (syntax->list inst)))]
-        [(and (PolyDots? ty) (= (length (syntax->list inst)) (PolyDots-n ty)))
+        [(PolyDots? ty)
          ;; In this case, we need to check the last thing.  If it's a dotted var, then we need to
          ;; use instantiate-poly-dotted, otherwise we do the normal thing.
          (let-values ([(all-but-last last-stx) (split-last (syntax->list inst))])
diff --git a/collects/typed-scheme/private/type-effect-printer.ss b/collects/typed-scheme/private/type-effect-printer.ss
index 1f30170540..b4fbcc44f3 100644
--- a/collects/typed-scheme/private/type-effect-printer.ss
+++ b/collects/typed-scheme/private/type-effect-printer.ss
@@ -66,7 +66,6 @@
     (match t
       [(Pair: a e) (cons a (tuple-elems e))]
       [(Value: '()) null]))
-  ;(fp "~a~n" (Type-seq c))
   (match c 
     [(Univ:) (fp "Any")]
     [(? has-name?) (fp "~a" (has-name? c))]
@@ -116,12 +115,13 @@
          (fp "(Parameter ~a)" in)           
          (fp "(Parameter ~a ~a)" in out))]
     [(Hashtable: k v) (fp "(HashTable ~a ~a)" k v)]
-    #;
-    [(Poly-unsafe: n b) (fp "(unsafe-poly ~a ~a ~a)" (Type-seq c) n b)]
+    
+    #;[(Poly-unsafe: n b) (fp "(unsafe-poly ~a ~a ~a)" (Type-seq c) n b)]
     [(Poly-names: names body) 
      #;(fprintf (current-error-port) "POLY SEQ: ~a~n" (Type-seq body))
      (fp "(All ~a ~a)" names body)]
-    [(PolyDots-names: (list names ... dotted) body) 
+    #;[(PolyDots-unsafe: n b) (fp "(unsafe-polydots ~a ~a ~a)" (Type-seq c) n b)]
+    [(PolyDots-names: (list names ... dotted) body)
      (fp "(All ~a ~a)" (append names (list dotted '...)) body)]
     #;
     [(Mu-unsafe: b) (fp "(unsafe-mu ~a ~a)" (Type-seq c) b)]
diff --git a/collects/typed-scheme/private/type-rep.ss b/collects/typed-scheme/private/type-rep.ss
index 06442e2c03..be57887412 100644
--- a/collects/typed-scheme/private/type-rep.ss
+++ b/collects/typed-scheme/private/type-rep.ss
@@ -351,14 +351,13 @@
                     (map (lambda (e) (sub-eff sb e)) els-eff))]
        [#:ValuesDots tys dty dbound
                      (*ValuesDots (map sb tys)
-                                  (sb dty)
-                                  
+                                  (sb dty)                                  
                                   (if (eqv? dbound (+ count outer)) (F-n image) dbound))]
        [#:Mu (Scope: body) (*Mu (*Scope (loop (add1 outer) body)))]
        [#:PolyDots n body* 
                    (let ([body (remove-scopes n body*)])
                      (*PolyDots n (*Scope (loop (+ n outer) body))))]
-       [#:Poly n body* 
+       [#:Poly n body*
                (let ([body (remove-scopes n body*)])
                  (*Poly n (*Scope (loop (+ n outer) body))))])))
   (let ([n (length images)])
@@ -500,7 +499,7 @@
        #'(? PolyDots?
             (app (lambda (t) 
                    (let* ([n (PolyDots-n t)]
-                          [syms (hash-ref name-table t)])
+                          [syms (hash-ref name-table t (lambda _ (build-list n (lambda _ (gensym)))))])
                      (list syms (PolyDots-body* syms t))))
                  (list nps bp)))])))