Add support for rest arguments in TR plain lambda

Two caveats:
  * in some positions : is not accepted as a formal
    when used in combination with * as a formal
  * the quality of parse error messages for rest
    argument types is traded for better optional argument
    error messages

pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/base-env/prims.rkt

@@ -72,6 +72,7 @@ This file defines two sorts of primitives. All of them are provided into any mod
           syntax/struct
           "annotate-classes.rkt"
           "../utils/tc-utils.rkt"
+          "../private/parse-classes.rkt"
           "../private/syntax-properties.rkt"
           "../types/utils.rkt"
           "for-clauses.rkt"
@@ -1169,15 +1170,20 @@ This file defines two sorts of primitives. All of them are provided into any mod
     #:description "rest argument"
     #:attributes (form)
     #:literals (:)
-    (pattern () #:attr form #'())
+    ;; specifying opaque here helps produce a better error
+    ;; message for optional argumenents, but produces worse
+    ;; error messages for rest arguments.
+    #:opaque
     (pattern rest:id #:attr form #'rest)
-    ;; FIXME: add a typed rest-arg case if a good syntax is found
+    (pattern (rest:id : type:expr :star)
-    )
+             #:attr form (type-label-property #'rest #'type)))
 
   (define-syntax-class lambda-formals
     #:attributes (opt-property kw-property erased)
     #:literals (:)
-    (pattern (mand:mand-formal ... opt:opt-formal ... . rest:rest-arg)
+    (pattern (~or (mand:mand-formal ... opt:opt-formal ... . rest:rest-arg)
+                  (~and (mand:mand-formal ... opt:opt-formal ...)
+                        (~bind [rest.form #'()])))
              #:attr kw-property
              (ormap values (append (attribute mand.kw) (attribute opt.kw)))
              #:attr opt-property

pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/types/kw-types.rkt

@@ -173,10 +173,7 @@
                          [kw-type (in-list kw-args)])
                 (make-Keyword kw kw-type #t)))
             (define rest-type
-              (and rest?
+              (and rest? (last other-args)))
-                   (if (equal? (last other-args) Univ)
-                       Univ
-                       -Bottom)))
             (make-Function
              (list (make-arr* (take other-args non-kw-argc)
                               rng
@@ -196,10 +193,7 @@
             (define-values (mand-args opt-and-rest-args)
               (split-at other-args mand-non-kw-argc))
             (define rest-type
-              (and rest?
+              (and rest? (last opt-and-rest-args)))
-                   (if (equal? (last opt-and-rest-args) Univ)
-                       Univ
-                       -Bottom)))
             (define opt-types (take opt-and-rest-args opt-non-kw-argc))
             (make-Function
              (for/list ([to-take (in-range (add1 (length opt-types)))])
@@ -301,10 +295,7 @@
             (define-values (mand-args opt-and-rest-args)
               (split-at doms mand-argc))
             (define rest-type
-              (and rest?
+              (and rest? (last opt-and-rest-args)))
-                   (if (equal? (last opt-and-rest-args) Univ)
-                       Univ
-                       -Bottom)))
             (define opt-types (take opt-and-rest-args opt-argc))
             (make-Function
              (for/list ([to-take (in-range (add1 (length opt-types)))])

pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/unit-tests/typecheck-tests.rkt

@@ -2062,13 +2062,20 @@
 
        ;; test lambdas with mixed type expressions, typed keywords, typed
        ;; optional arguments
-       ;; FIXME: support rest args
        [tc-e (tr:lambda (x [y : String]) (string-append y "b"))
              #:ret (ret (t:-> Univ -String -String) (-FS -top -bot))]
+       [tc-e (tr:lambda (x [y : String] . z) (string-append y "b"))
+             #:ret (ret (->* (list Univ -String) Univ -String) (-FS -top -bot))]
+       [tc-e (tr:lambda (x [y : String] . [z : String *]) (string-append y "b"))
+             #:ret (ret (->* (list Univ -String) -String -String) (-FS -top -bot))]
        [tc-e (tr:lambda (x [y : String]) : String (string-append y "b"))
              #:ret (ret (t:-> Univ -String -String) (-FS -top -bot))]
        [tc-e (tr:lambda (x z [y : String]) (string-append y "b"))
              #:ret (ret (t:-> Univ Univ -String -String) (-FS -top -bot))]
+       [tc-e (tr:lambda (x z [y : String] . w) (string-append y "b"))
+             #:ret (ret (->* (list Univ Univ -String) Univ -String) (-FS -top -bot))]
+       [tc-e (tr:lambda (x z [y : String] . [w : String *]) (string-append y "b"))
+             #:ret (ret (->* (list Univ Univ -String) -String -String) (-FS -top -bot))]
        [tc-e (tr:lambda (x z [y : String]) : String (string-append y "b"))
              #:ret (ret (t:-> Univ Univ -String -String) (-FS -top -bot))]
        [tc-err (tr:lambda (x [y : String]) : Symbol (string-append y "b"))
@@ -2077,6 +2084,10 @@
                #:msg "expected optional lambda argument"]
        [tc-e (tr:lambda (x [y : String "a"]) (string-append y "b"))
              (->opt Univ [-String] -String)]
+       [tc-e (tr:lambda (x [y : String "a"] . z) (string-append y "b"))
+             (->optkey Univ [-String] #:rest Univ -String)]
+       [tc-e (tr:lambda (x [y : String "a"] . [z : String *]) (string-append y "b"))
+             (->optkey Univ [-String] #:rest -String -String)]
        [tc-e (tr:lambda (x y [z : String "a"]) (string-append z "b"))
              (->opt Univ Univ [-String] -String)]
        [tc-e (tr:lambda (w x [y : String "y"] [z : String "z"]) (string-append y z))
@@ -2086,6 +2097,10 @@
              (->opt Univ -String [-String -String] -String)]
        [tc-e (tr:lambda (x #:y [y : String]) (string-append y "b"))
              (->key Univ #:y -String #t -String)]
+       [tc-e (tr:lambda (x #:y [y : String] . z) (string-append y "b"))
+             (->optkey Univ [] #:rest Univ #:y -String #t -String)]
+       [tc-e (tr:lambda (x #:y [y : String] . [z : String *]) (string-append y "b"))
+             (->optkey Univ [] #:rest -String #:y -String #t -String)]
        [tc-e (tr:lambda (x #:y [y : String]) : String (string-append y "b"))
              (->key Univ #:y -String #t -String)]
        [tc-e (tr:lambda (x #:y [y : String "a"]) (string-append y "b"))
@@ -2104,6 +2119,10 @@
              (->optkey Univ [Univ] #:y -String #f -String)]
        [tc-e (tr:lambda (x #:y [y : String] [z : String "z"]) (string-append y z))
              (->optkey Univ [-String] #:y -String #t -String)]
+       [tc-e (tr:lambda (x #:y [y : String] [z : String "z"] . w) (string-append y z))
+             (->optkey Univ [-String] #:rest Univ #:y -String #t -String)]
+       [tc-e (tr:lambda (x #:y [y : String] [z : String "z"] . [w : String *]) (string-append y z))
+             (->optkey Univ [-String] #:rest -String #:y -String #t -String)]
        [tc-e (tr:lambda (x #:y [y : String "y"] [z : String "z"]) (string-append y z))
              (->optkey Univ [-String] #:y -String #f -String)]
        [tc-e (tr:lambda (x [z : String "z"] #:y [y : String]) (string-append y z))