diff --git a/collects/typed-scheme/private/parse-type.ss b/collects/typed-scheme/private/parse-type.ss
index 613c5a5768..098596766b 100644
--- a/collects/typed-scheme/private/parse-type.ss
+++ b/collects/typed-scheme/private/parse-type.ss
@@ -66,6 +66,12 @@
          (make-Poly vars (parse-type #'t))))]
     [(t:All . rest) (tc-error "All: bad syntax")]))
 
+(define-splicing-syntax-class keyword-tys
+  (pattern (~seq k:keyword t:expr)
+           #:attr Keyword (make-Keyword (syntax-e #'k) (parse-type #'t) #t))
+  (pattern (~seq [k:keyword t:expr])
+           #:attr Keyword (make-Keyword (syntax-e #'k) (parse-type #'t) #f)))
+
 (define (parse-type stx)    
   (parameterize ([current-orig-stx stx])    
     (syntax-parse
@@ -119,10 +125,15 @@
       (add-type-name-reference #'kw)
       ;; use parse-type instead of parse-values-type because we need to add the filters from the pred-ty
       (make-pred-ty (list (parse-type #'dom)) (parse-type #'rng) (parse-type #'pred-ty))]
-     [(dom ... rest ddd:star (~and kw t:->) rng)
+     [(dom:expr ... rest:expr ddd:star kws:keyword-tys ... (~and kw t:->) rng)
       (add-type-name-reference #'kw)
-      (->* (map parse-type (syntax->list #'(dom ...))) (parse-type #'rest) (parse-values-type #'rng))]
-     [(dom ... rest :ddd/bound (~and kw t:->) rng)
+      (make-Function
+       (list (make-arr
+              (map parse-type (syntax->list #'(dom ...)))
+              (parse-values-type #'rng)
+              #:rest (parse-type #'rest)
+              #:kws (attribute kws.Keyword))))]
+     [(dom:expr ... rest:expr :ddd/bound (~and kw t:->) rng)
       (add-type-name-reference #'kw)
       (let ([var (lookup (current-tvars) (syntax-e #'bound) (lambda (_) #f))])
         (if (not (Dotted? var))
@@ -141,7 +152,7 @@
                                       (current-tvars))])
                                  (parse-type #'rest))
                                (syntax-e #'bound))))))]
-     [(dom ... rest _:ddd (~and kw t:->) rng)
+     [(dom:expr ... rest:expr _:ddd (~and kw t:->) rng)
       (add-type-name-reference #'kw)
       (let ([bounds (filter (compose Dotted? cdr)
                             (env-keys+vals (current-tvars)))])
@@ -160,11 +171,19 @@
                                                        (current-tvars))])
                              (parse-type #'rest))
                            var)))))]
-     ;; has to be below the previous one
-     [(dom ... (~and kw t:->) rng) 
+    #| ;; has to be below the previous one
+     [(dom:expr ... (~and kw t:->) rng) 
       (add-type-name-reference #'kw)
       (->* (map parse-type (syntax->list #'(dom ...)))
-           (parse-values-type #'rng))]     
+           (parse-values-type #'rng))]     |#
+     ;; use expr to rule out keywords
+     [(dom:expr ... kws:keyword-tys ... (~and kw t:->) rng)
+      (add-type-name-reference #'kw)
+      (make-Function
+       (list (make-arr
+              (map parse-type (syntax->list #'(dom ...)))
+              (parse-values-type #'rng)
+              #:kws (attribute kws.Keyword))))]
      [((~and kw case-lambda) tys ...)
       (add-type-name-reference #'kw)
       (make-Function 
diff --git a/collects/typed-scheme/private/type-contract.ss b/collects/typed-scheme/private/type-contract.ss
index 0d8806c7e8..21276de570 100644
--- a/collects/typed-scheme/private/type-contract.ss
+++ b/collects/typed-scheme/private/type-contract.ss
@@ -72,8 +72,9 @@
            (define (f a)
              (define-values (dom* rngs* rst)
                (match a
-                 [(arr: dom (Values: (list (Result: rngs (LFilterSet: '() '()) (LEmpty:)) ...)) rst #f '())
-                  (values (map t->c/neg dom) (map t->c rngs) (and rst (t->c/neg rst)))]
+                 [(arr: dom (Values: (list (Result: rngs (LFilterSet: '() '()) (LEmpty:)) ...)) rst #f (list (Keyword: kws ktys #t) ...))
+                  (values (append (map t->c/neg dom) (append-map (lambda (kw kty) (list kw (t->c/neg kty))) kws ktys))
+                          (map t->c rngs) (and rst (t->c/neg rst)))]
                  [(arr: dom (Values: (list (Result: rngs _ _) ...)) rst #f '())
                   (if (and out? pos?)
                       (values (map t->c/neg dom) (map t->c rngs) (and rst (t->c/neg rst)))