From ae851e41cdf95f0537cfd438deaf2360eadf1fab Mon Sep 17 00:00:00 2001
From: Sam Tobin-Hochstadt <samth@racket-lang.org>
Date: Sun, 13 Jun 2010 14:35:37 -0400
Subject: [PATCH] Allow (All (A) A -> A), dropping pair of parens.

original commit: d4d286d31dce759129c372c9e42bfb37300bf167
---
 .../unit-tests/parse-type-tests.rkt           |  5 +++++
 collects/typed-scheme/private/parse-type.rkt  | 21 +++++++++++++++----
 .../scribblings/ts-reference.scrbl            |  4 +++-
 3 files changed, 25 insertions(+), 5 deletions(-)

diff --git a/collects/tests/typed-scheme/unit-tests/parse-type-tests.rkt b/collects/tests/typed-scheme/unit-tests/parse-type-tests.rkt
index b365336b..155a8026 100644
--- a/collects/tests/typed-scheme/unit-tests/parse-type-tests.rkt
+++ b/collects/tests/typed-scheme/unit-tests/parse-type-tests.rkt
@@ -74,6 +74,11 @@
    [(-> (values Number Boolean Number)) (t:-> (-values (list N B N)))]
    [(Number -> Number) (t:-> N N)]
    [(Number -> Number) (t:-> N N)]
+   [(All (A) Number -> Number) (-poly (a) (t:-> N N))]
+   [(All (A) (Number -> Number)) (-poly (a) (t:-> N N))]
+   [(All (A) A -> A) (-poly (a) (t:-> a a))]
+   [(All (A) A → A) (-poly (a) (t:-> a a))]
+   [(All (A) (A -> A)) (-poly (a) (t:-> a a))]
    ;; requires transformer time stuff that doesn't work
    #;[(Refinement even?) (make-Refinement #'even?)]
    [(Number Number Number Boolean -> Number) (N N N B . t:-> . N)]
diff --git a/collects/typed-scheme/private/parse-type.rkt b/collects/typed-scheme/private/parse-type.rkt
index 3477ec06..1232d7ee 100644
--- a/collects/typed-scheme/private/parse-type.rkt
+++ b/collects/typed-scheme/private/parse-type.rkt
@@ -51,23 +51,36 @@
            #:attr bound (datum->syntax #'i (string->symbol (substring (attribute s) 3)) #'i #'i))
   (pattern (~seq _:ddd bound:id)))
 
+(define (parse-all-body s)
+  (syntax-parse s
+    [(ty)
+     (parse-type #'ty)]
+    [(x ...)
+     #:fail-unless (= 1 (length 
+			 (for/list ([i (syntax->list #'(x ...))]
+				    #:when (and (identifier? i)
+						(free-identifier=? i #'t:->)))
+				   i))) 
+     #f
+     (parse-type s)]))
+
 (define (parse-all-type stx parse-type)
   ;(printf "parse-all-type: ~a ~n" (syntax->datum stx))
   (syntax-parse stx #:literals (t:All)
-    [((~and kw t:All) (vars:id ... v:id dd:ddd) t)
+    [((~and kw t:All) (vars:id ... v:id dd:ddd) . t)
      (let* ([vars (map syntax-e (syntax->list #'(vars ...)))]
             [tvars (map make-F vars)]
             [v (syntax-e #'v)]
             [tv (make-Dotted (make-F v))])
        (add-type-name-reference #'kw)
        (parameterize ([current-tvars (extend-env (cons v vars) (cons tv tvars) (current-tvars))])
-         (make-PolyDots (append vars (list v)) (parse-type #'t))))]
-    [((~and kw t:All) (vars:id ...) t) 
+         (make-PolyDots (append vars (list v)) (parse-all-body #'t))))]
+    [((~and kw t:All) (vars:id ...) . t) 
      (let* ([vars (map syntax-e (syntax->list #'(vars ...)))]
             [tvars (map make-F vars)])
        (add-type-name-reference #'kw)
        (parameterize ([current-tvars (extend-env vars tvars (current-tvars))])
-         (make-Poly vars (parse-type #'t))))]
+         (make-Poly vars (parse-all-body #'t))))]
     [(t:All (_:id ...) _ _ _ ...) (tc-error "All: too many forms in body of All type")]
     [(t:All . rest) (tc-error "All: bad syntax")]))
 
diff --git a/collects/typed-scheme/scribblings/ts-reference.scrbl b/collects/typed-scheme/scribblings/ts-reference.scrbl
index 9912490b..f7cc38cd 100644
--- a/collects/typed-scheme/scribblings/ts-reference.scrbl
+++ b/collects/typed-scheme/scribblings/ts-reference.scrbl
@@ -202,7 +202,9 @@ The following base types are parameteric in their type arguments.
 @defform/none[(t t1 t2 ...)]{is the instantiation of the parametric type
   @racket[t] at types @racket[t1 t2 ...]}
 @defform[(All (v ...) t)]{is a parameterization of type @racket[t], with
-  type variables @racket[v ...]}
+  type variables @racket[v ...].  If @racket[t] is a function type
+      constructed with @racket[->], the outer pair of parentheses
+      around the function type may be omitted.}
 @defform[(values t ...)]{is the type of a sequence of multiple values, with
 types @racket[t ...].  This can only appear as the return type of a
 function.