From cec84d33dda295ec908f67ece69cd4e34810afe5 Mon Sep 17 00:00:00 2001
From: Eli Barzilay <eli@racket-lang.org>
Date: Tue, 14 Oct 2008 18:44:05 +0000
Subject: [PATCH] Allow an implicit paren for (: <id> : T ... -> T)

svn: r12038

original commit: 9cc7f90a0aa877aab3310a83b1f3133105d2aefa
---
 collects/typed-scheme/private/prims.ss | 40 ++++++++++++++------------
 1 file changed, 22 insertions(+), 18 deletions(-)

diff --git a/collects/typed-scheme/private/prims.ss b/collects/typed-scheme/private/prims.ss
index dd72df9f..b01a3525 100644
--- a/collects/typed-scheme/private/prims.ss
+++ b/collects/typed-scheme/private/prims.ss
@@ -160,24 +160,28 @@ This file defines two sorts of primitives. All of them are provided into any mod
      (syntax-property #'arg 'type-ascription #'ty)]))
 
 (define-syntax (: stx)
-  (let ([stx*
-         ;; make it possible to add another colon after the id for clarity
-         (syntax-case stx (:)
-           [(: id : . more) (syntax/loc stx (: id . more))]
-           [_ stx])])
-    (syntax-case stx* ()
-      [(_ id ty)
-       (identifier? #'id)
-       (syntax-property
-        (internal (syntax/loc stx (:-internal id ty)))
-        'disappeared-use #'id)]
-      [(_ id ty)
-       (raise-syntax-error '|type declaration| "can only annotate identifiers with types"
-                           stx #'id)]
-      [(_ _ _ _ . _)
-       (raise-syntax-error '|type declaration| "too many arguments" stx)]
-      [(_ _)
-       (raise-syntax-error '|type declaration| "too few arguments" stx)])))
+  (define stx*
+    ;; make it possible to add another colon after the id for clarity
+    ;; and in that case, a `->' on the RHS does not need to be
+    ;; explicitly parenthesized
+    (syntax-case stx (:)
+      [(: id : first x ... last)
+       (ormap (lambda (x) (eq? '-> (syntax-e x))) (syntax->list #'(x ...)))
+       (syntax/loc stx (: id (first x ... last)))]
+      [(: id : . more) (syntax/loc stx (: id . more))]
+      [_ stx]))
+  (define (err str . sub)
+    (apply raise-syntax-error '|type declaration| str stx sub))
+  (syntax-case stx* ()
+    [(_ id ty)
+     (identifier? #'id)
+     (syntax-property (internal (syntax/loc stx (:-internal id ty)))
+                      'disappeared-use #'id)]
+    [(_ id x ...)
+     (case (length (syntax->list #'(x ...)))
+       [(1)  (err "can only annotate identifiers with types" #'id)]
+       [(0)  (err "missing type")]
+       [else (err "bad syntax (multiple types after identifier)")])]))
 
 (define-syntax (inst stx)
   (syntax-case stx (:)