From d6f8dfc983289f95245b17c7d1deb04f16b55d2c Mon Sep 17 00:00:00 2001
From: Sam Tobin-Hochstadt <samth@racket-lang.org>
Date: Tue, 10 Jun 2008 14:10:40 -0400
Subject: [PATCH] Instantiation appears to work.

original commit: e912818f866d6bcbeb43e4567ba9d0f1d58d6e3c
---
 collects/typed-scheme/private/base-env.ss          | 14 ++++++++++++++
 collects/typed-scheme/private/extra-procs.ss       |  6 +++++-
 .../typed-scheme/private/type-effect-printer.ss    |  4 +++-
 collects/typed-scheme/private/type-utils.ss        |  2 +-
 4 files changed, 23 insertions(+), 3 deletions(-)

diff --git a/collects/typed-scheme/private/base-env.ss b/collects/typed-scheme/private/base-env.ss
index 898796f6..0b8695a3 100644
--- a/collects/typed-scheme/private/base-env.ss
+++ b/collects/typed-scheme/private/base-env.ss
@@ -498,6 +498,20 @@
      [syntax? (make-pred-ty (-Syntax Univ))]
      [syntax-property (-poly (a) (cl->* (-> (-Syntax a) Univ Univ (-Syntax a))
                                         (-> (-Syntax Univ) Univ Univ)))]
+     
+     ;; experimental
+     
+     [map* (make-PolyDots 
+            (list 'a 'b 'c)
+            (make-Function 
+             (list 
+              (make-arr-dots 
+               (list (make-Function (list (make-arr-dots (list (-v b)) (-v a) (-v c) 'c)))
+                     (-lst (-v b)))
+               (-lst (-v a))
+               (-lst (-v c))
+               'c))))]
+     
      )))
 
 (begin-for-syntax 
diff --git a/collects/typed-scheme/private/extra-procs.ss b/collects/typed-scheme/private/extra-procs.ss
index b8b87b6c..428b5eaf 100644
--- a/collects/typed-scheme/private/extra-procs.ss
+++ b/collects/typed-scheme/private/extra-procs.ss
@@ -1,7 +1,11 @@
 #lang scheme/base
-(provide assert)    
+(provide assert map*)
 
 (define (assert v)
   (unless v
     (error "Assertion failed - value was #f"))
   v)
+
+(define map* map)
+
+
diff --git a/collects/typed-scheme/private/type-effect-printer.ss b/collects/typed-scheme/private/type-effect-printer.ss
index c2a2d940..2a5dac4d 100644
--- a/collects/typed-scheme/private/type-effect-printer.ss
+++ b/collects/typed-scheme/private/type-effect-printer.ss
@@ -52,7 +52,7 @@
        (when rest
          (fp "~a* " rest))
        (when drest
-         (fp "~a ..." drest))
+         (fp "~a ... ~a " (car drest) (cdr drest)))
        (fp "-> ~a" rng)
        (unless (and (null? thn-eff) (null? els-eff))
          (fp " : ~a ~a" thn-eff els-eff))
@@ -115,6 +115,8 @@
     [(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) 
+     (fp "(All ~a ~a)" (append names (list dotted '...)) body)]
     #;
     [(Mu-unsafe: b) (fp "(unsafe-mu ~a ~a)" (Type-seq c) b)]
     [(Mu: x (Syntax: (Union: (list
diff --git a/collects/typed-scheme/private/type-utils.ss b/collects/typed-scheme/private/type-utils.ss
index ead27eea..621f6aab 100644
--- a/collects/typed-scheme/private/type-utils.ss
+++ b/collects/typed-scheme/private/type-utils.ss
@@ -33,7 +33,7 @@
                         (begin
                           (when (and (pair? drest)
                                      (eq? name (cdr drest)))
-                            (int-err "substitute used on ... variable ~a" name))
+                            (int-err "substitute used on ... variable ~a in type ~a" name target))
                           (make-arr (map sb dom)
                                     (sb rng)
                                     (and rest (sb rest))