diff --git a/collects/scheme/contract.ss b/collects/scheme/contract.ss
index c7ce9353ab..98132589cb 100644
--- a/collects/scheme/contract.ss
+++ b/collects/scheme/contract.ss
@@ -13,8 +13,7 @@
  (except-out (all-from-out "private/contract-ds.ss")
              lazy-depth-to-look)
  
- (except-out (all-from-out "private/contract-arrow.ss")
-             check-procedure)
+ (except-out (all-from-out "private/contract-arrow.ss"))
  (except-out (all-from-out "private/contract.ss")
              check-between/c
              check-unary-between/c))
diff --git a/collects/scheme/private/contract-arr-checks.ss b/collects/scheme/private/contract-arr-checks.ss
index 977cbb6102..1c1a3992ee 100644
--- a/collects/scheme/private/contract-arr-checks.ss
+++ b/collects/scheme/private/contract-arr-checks.ss
@@ -58,6 +58,10 @@
            arity-count
            f)))
 
+(define (get-mandatory-keywords f)
+  (let-values ([(mandatory optional) (procedure-keywords f)])
+    mandatory))
+
 (define (no-mandatory-keywords? f)
   (let-values ([(mandatory optional) (procedure-keywords f)])
     (null? mandatory)))
@@ -89,19 +93,31 @@
                           orig-str
                           "post-condition expression failure")))
 
-(define (check-procedure val dom-length src-info blame orig-str)
+(define (check-procedure val dom-length mandatory-kwds src-info blame orig-str)
   (unless (and (procedure? val)
-               (and (procedure-arity-includes? val dom-length)
-                    (no-mandatory-keywords? val)))
+               (procedure-arity-includes? val dom-length)
+               (equal? mandatory-kwds (get-mandatory-keywords val)))
     (raise-contract-error
      val
      src-info
      blame
      orig-str
-     "expected a procedure that accepts ~a arguments without any keywords, given: ~e"
+     "expected a procedure that accepts ~a arguments~a, given: ~e"
      dom-length
+     (keyword-error-text mandatory-kwds)
      val)))
 
+(define (keyword-error-text mandatory-keywords)
+  (cond
+    [(null? mandatory-keywords) " without any keywords"]
+    [(null? (cdr mandatory-keywords))
+     (format " and the keyword ~a" (car mandatory-keywords))]
+    [else
+     (format
+      " and the keywords ~a~a"
+      (car mandatory-keywords)
+      (apply string-append (map (λ (x) (format " ~a" x)) (cdr mandatory-keywords))))]))
+
 (define ((check-procedure? arity) val)
   (and (procedure? val)
        (procedure-arity-includes? val arity)
@@ -149,17 +165,18 @@
                           (procedure-arity val)
                           val)))
 
-(define (check-procedure/more val dom-length src-info blame orig-str)
+(define (check-procedure/more val dom-length mandatory-kwds src-info blame orig-str)
   (unless (and (procedure? val)
-               (procedure-accepts-and-more? val dom-length))
+               (procedure-accepts-and-more? val dom-length)
+               (equal? mandatory-kwds (get-mandatory-keywords val)))
     (raise-contract-error
      val
      src-info
      blame
      orig-str
-     "expected a procedure that accepts ~a arguments and any number of arguments larger than ~a, given: ~e"
-     dom-length
+     "expected a procedure that accepts ~a arguments and and arbitrarily more~a, given: ~e"
      dom-length
+     (keyword-error-text mandatory-kwds)
      val)))
 
 
diff --git a/collects/scheme/private/contract-arr-obj-helpers.ss b/collects/scheme/private/contract-arr-obj-helpers.ss
index affb0d96a9..4e76478a67 100644
--- a/collects/scheme/private/contract-arr-obj-helpers.ss
+++ b/collects/scheme/private/contract-arr-obj-helpers.ss
@@ -382,7 +382,7 @@
              (lambda (outer-args)
                (with-syntax ([(val pos-blame neg-blame src-info orig-str name-id) outer-args])
                  (syntax
-                  (check-procedure val dom-length src-info pos-blame orig-str))))
+                  (check-procedure val dom-length '() #|mandatory-keywords|# src-info pos-blame orig-str))))
              (syntax (check-procedure? dom-length))
              (lambda (outer-args)
                (with-syntax ([(val pos-blame neg-blame src-info orig-str name-id) outer-args])
@@ -428,7 +428,7 @@
                (lambda (outer-args)
                  (with-syntax ([(val pos-blame neg-blame src-info orig-str name-id) outer-args])
                    (syntax
-                    (check-procedure val dom-length src-info pos-blame orig-str))))
+                    (check-procedure val dom-length '() #|mandatory-keywords|# src-info pos-blame orig-str))))
                (syntax (check-procedure? dom-length))
                
                (lambda (outer-args)
@@ -472,7 +472,7 @@
                (lambda (outer-args)
                  (with-syntax ([(val pos-blame neg-blame src-info orig-str name-id) outer-args])
                    (syntax
-                    (check-procedure val dom-length src-info pos-blame orig-str))))
+                    (check-procedure val dom-length '() #|mandatory keywords|# src-info pos-blame orig-str))))
                (syntax (check-procedure? dom-length))
                (lambda (outer-args)
                  (with-syntax ([(val pos-blame neg-blame src-info orig-str name-id) outer-args])
@@ -548,7 +548,7 @@
         (lambda (outer-args)
           (with-syntax ([(val pos-blame neg-blame src-info orig-str name-id) outer-args])
             (syntax
-             (check-procedure/more val dom-length src-info pos-blame orig-str))))
+             (check-procedure/more val dom-length '() #|mandatory keywords|# src-info pos-blame orig-str))))
         (syntax (check-procedure/more? dom-length))
         (lambda (outer-args)
           (with-syntax ([(val pos-blame neg-blame src-info orig-str name-id) outer-args])
@@ -610,7 +610,7 @@
         (lambda (outer-args)
           (with-syntax ([(val pos-blame neg-blame src-info orig-str name-id) outer-args])
             (syntax
-             (check-procedure/more val dom-length src-info pos-blame orig-str))))
+             (check-procedure/more val dom-length '() #|mandatory keywords|# src-info pos-blame orig-str))))
         (syntax (check-procedure/more? dom-length))
         (lambda (outer-args)
           (with-syntax ([(val pos-blame neg-blame src-info orig-str name-id) outer-args])
@@ -663,7 +663,7 @@
         (lambda (outer-args)
           (with-syntax ([(val pos-blame neg-blame src-info orig-str name-id) outer-args])
             (syntax
-             (check-procedure val arity src-info pos-blame orig-str))))
+             (check-procedure val arity '() #|mandatory keywords|# src-info pos-blame orig-str))))
         
         (syntax (check-procedure? arity))
         
@@ -723,7 +723,7 @@
         (lambda (outer-args)
           (with-syntax ([(val pos-blame neg-blame src-info orig-str name-id) outer-args])
             (syntax
-             (check-procedure val dom-length src-info pos-blame orig-str))))
+             (check-procedure val dom-length '() #|mandatory keywords|# src-info pos-blame orig-str))))
         (syntax (check-procedure? dom-length))
         
         (lambda (outer-args)
@@ -797,7 +797,7 @@
         (lambda (outer-args)
           (with-syntax ([(val pos-blame neg-blame src-info orig-str name-id) outer-args])
             (syntax
-             (check-procedure/more val arity src-info pos-blame orig-str))))
+             (check-procedure/more val arity '() #|mandatory keywords|# src-info pos-blame orig-str))))
         (syntax (check-procedure/more? arity))
         
         (lambda (outer-args)
diff --git a/collects/scheme/private/contract-arrow.ss b/collects/scheme/private/contract-arrow.ss
index c638caea09..00ccfc5deb 100644
--- a/collects/scheme/private/contract-arrow.ss
+++ b/collects/scheme/private/contract-arrow.ss
@@ -2,11 +2,21 @@
 
 #|
 
-add mandatory keywords to ->, ->* ->d ->d*
+keywords done:
+
+- added mandatory keywords to ->
+
+keywords todo:
+
+add mandatory keywords to ->* ->d ->d*
 
 Add both optional and mandatory keywords to opt-> and friends. 
 (Update opt-> so that it doesn't use case-lambda anymore.)
 
+- raise-syntax-errors
+  . multiple identical keywords syntax error, sort-keywords
+  . split-doms
+
 |#
 
 (require "contract-guts.ss"
@@ -16,8 +26,8 @@ Add both optional and mandatory keywords to opt-> and friends.
          (for-syntax "contract-opt-guts.ss")
          (for-syntax "contract-helpers.ss")
          (for-syntax "contract-arr-obj-helpers.ss")
-         (for-syntax (lib "stx.ss" "syntax"))
-         (for-syntax (lib "name.ss" "syntax")))
+         (for-syntax syntax/stx)
+         (for-syntax syntax/name))
 
 (provide ->
          ->d
@@ -29,8 +39,7 @@ Add both optional and mandatory keywords to opt-> and friends.
          case->
          opt->
          opt->*
-         unconstrained-domain->
-         check-procedure)
+         unconstrained-domain->)
 
 (define-syntax (unconstrained-domain-> stx)
   (syntax-case stx ()
@@ -57,20 +66,30 @@ Add both optional and mandatory keywords to opt-> and friends.
                                               "expected a procedure")))))
               procedure?))))]))
 
-;; FIXME: need to pass in the name of the contract combinator.
-(define (build--> name doms doms-rest rngs rng-any? func)
+(define (build--> name doms doms-rest rngs kwds quoted-kwds rng-any? func)
   (let ([doms/c (map (λ (dom) (coerce-contract name dom)) doms)]
         [rngs/c (map (λ (rng) (coerce-contract name rng)) rngs)]
+        [kwds/c (map (λ (kwd) (coerce-contract name kwd)) kwds)]
         [doms-rest/c (and doms-rest (coerce-contract name doms-rest))])
-    (make--> rng-any? doms/c doms-rest/c rngs/c func)))
-
-(define-struct/prop -> (rng-any? doms dom-rest rngs func)
+    (make--> rng-any? doms/c doms-rest/c rngs/c kwds/c quoted-kwds func)))
+;; rng-any? : boolean
+;; doms : (listof contract)
+;; dom-rest : (or/c false/c contract)
+;; rngs : (listof contract) -- may be ignored by the wrapper function in the case of any
+;; kwds : (listof contract)
+;; quoted-keywords : (listof keyword) -- must be sorted by keyword<
+;; func : the wrapper function maker. It accepts a procedure for
+;;        checking the first-order properties and the contracts
+;;        and it produces a wrapper-making function.
+(define-struct/prop -> (rng-any? doms dom-rest rngs kwds quoted-kwds func)
   ((proj-prop (λ (ctc) 
                 (let* ([doms/c (map (λ (x) ((proj-get x) x)) 
                                     (if (->-dom-rest ctc)
                                         (append (->-doms ctc) (list (->-dom-rest ctc)))
                                         (->-doms ctc)))]
                        [rngs/c (map (λ (x) ((proj-get x) x)) (->-rngs ctc))]
+                       [kwds/c (map (λ (x) ((proj-get x) x)) (->-kwds ctc))]
+                       [mandatory-keywords (->-quoted-kwds ctc)]
                        [func (->-func ctc)]
                        [dom-length (length (->-doms ctc))]
                        [check-proc
@@ -81,10 +100,12 @@ Add both optional and mandatory keywords to opt-> and friends.
                     (let ([partial-doms (map (λ (dom) (dom neg-blame pos-blame src-info orig-str))
                                              doms/c)]
                           [partial-ranges (map (λ (rng) (rng pos-blame neg-blame src-info orig-str))
-                                               rngs/c)])
+                                               rngs/c)]
+                          [partial-kwds (map (λ (kwd) (kwd neg-blame pos-blame src-info orig-str))
+                                             kwds/c)])
                       (apply func
-                             (λ (val) (check-proc val dom-length src-info pos-blame orig-str))
-                             (append partial-doms partial-ranges)))))))
+                             (λ (val) (check-proc val dom-length mandatory-keywords src-info pos-blame orig-str))
+                             (append partial-doms partial-ranges partial-kwds)))))))
    (name-prop (λ (ctc) (single-arrow-name-maker 
                         (->-doms ctc)
                         (->-dom-rest ctc)
@@ -134,68 +155,134 @@ Add both optional and mandatory keywords to opt-> and friends.
               [else (apply build-compound-type-name 'values rngs)])])
        (apply build-compound-type-name '-> (append doms/c (list rng-name))))]))
 
+(define-for-syntax (sort-keywords stx kwd/ctc-pairs)
+  (define (insert x lst)
+    (cond
+      [(null? lst) (list x)]
+      [else
+       (let ([fst-kwd (syntax-e (car (car lst)))])
+         (printf "comparing ~s to ~s\n" (car x) fst-kwd)
+         (cond
+           [(equal? (syntax-e (car x)) fst-kwd)
+            (raise-syntax-error #f 
+                                "duplicate keyword"
+                                stx
+                                (car x))]
+           [(keyword<? (syntax-e (car x)) fst-kwd)
+            (cons x lst)]
+           [else (cons (car lst) (insert x (cdr lst)))]))]))
+  
+  (let loop ([pairs (map syntax->list kwd/ctc-pairs)])
+    (cond
+      [(null? pairs) null]
+      [else (insert (car pairs) (loop (cdr pairs)))])))
+
+(define-for-syntax (split-doms stx name raw-doms)
+  (let loop ([raw-doms raw-doms]
+             [doms '()]
+             [kwd-doms '()])
+    (syntax-case raw-doms ()
+      [() (list (reverse doms)
+                (sort-keywords stx kwd-doms))]
+      [(kwd arg . rest)
+       (and (keyword? (syntax-e #'kwd))
+            (not (keyword? (syntax-e #'arg))))
+       (loop #'rest
+             doms
+             (cons #'(kwd arg) kwd-doms))]
+      [(kwd arg . rest)
+       (and (keyword? (syntax-e #'kwd))
+            (keyword? (syntax-e #'arg)))
+       (raise-syntax-error name
+                           "expected a keyword followed by a contract"
+                           stx
+                           #'kwd)]
+      [(kwd)
+       (keyword? (syntax-e #'kwd))
+       (raise-syntax-error name
+                           "expected a keyword to be followed by a contract"
+                           stx
+                           #'kwd)]
+      [(x . rest)
+       (loop #'rest (cons #'x doms) kwd-doms)])))
+
 (define-for-syntax (->-helper stx)
-  (syntax-case* stx (-> any values) module-or-top-identifier=?
-    [(-> doms ... any)
-     (with-syntax ([(args ...) (generate-temporaries (syntax (doms ...)))]
-                   [(dom-ctc ...) (generate-temporaries (syntax (doms ...)))]
-                   [(ignored) (generate-temporaries (syntax (rng)))])
-       (values (syntax (dom-ctc ...))
-               (syntax (ignored))
-               (syntax (doms ...))
-               (syntax (any/c))
-               (syntax ((args ...) (val (dom-ctc args) ...)))
-               #t))]
-    [(-> doms ... (values rngs ...))
-     (with-syntax ([(args ...) (generate-temporaries (syntax (doms ...)))]
-                   [(dom-ctc ...) (generate-temporaries (syntax (doms ...)))]
-                   [(rng-x ...) (generate-temporaries (syntax (rngs ...)))]
-                   [(rng-ctc ...) (generate-temporaries (syntax (rngs ...)))])
-       (values (syntax (dom-ctc ...))
-               (syntax (rng-ctc ...))
-               (syntax (doms ...))
-               (syntax (rngs ...))
-               (syntax ((args ...) 
-                        (let-values ([(rng-x ...) (val (dom-ctc args) ...)])
-                          (values (rng-ctc rng-x) ...))))
-               #f))]
-    [(_ doms ... rng)
-     (with-syntax ([(args ...) (generate-temporaries (syntax (doms ...)))]
-                   [(dom-ctc ...) (generate-temporaries (syntax (doms ...)))]
-                   [(rng-ctc) (generate-temporaries (syntax (rng)))])
-       (values (syntax (dom-ctc ...))
-               (syntax (rng-ctc))
-               (syntax (doms ...))
-               (syntax (rng))
-               (syntax ((args ...) (rng-ctc (val (dom-ctc args) ...))))
-               #f))]))
+  (syntax-case stx ()
+    [(-> raw-doms ... last-one)
+     (with-syntax ([((doms ...) ((dom-kwd dom-kwd-ctc) ...)) (split-doms stx '-> #'(raw-doms ...))])
+       (with-syntax ([(dom-kwd-arg ...) (generate-temporaries (syntax (dom-kwd ...)))]
+                     [(dom-kwd-ctc-id ...) (generate-temporaries (syntax (dom-kwd ...)))])
+         (with-syntax ([(keyword-call/ctc ...) (apply append (map syntax->list (syntax->list #'((dom-kwd (dom-kwd-ctc-id dom-kwd-arg)) ...))))]
+                       [(keyword-formal-parameters ...) (apply append (map syntax->list (syntax->list #'((dom-kwd dom-kwd-arg) ...))))]
+                       [(args ...) (generate-temporaries (syntax (doms ...)))]
+                       [(dom-ctc ...) (generate-temporaries (syntax (doms ...)))])
+           (syntax-case* #'last-one (-> any values) module-or-top-identifier=?
+             [any
+              (with-syntax ([(ignored) (generate-temporaries (syntax (rng)))])
+                (values (syntax (dom-ctc ...))
+                        (syntax (ignored))
+                        (syntax (dom-kwd-ctc-id ...))
+                        (syntax (doms ...))
+                        (syntax (any/c))
+                        (syntax (dom-kwd-ctc ...))
+                        (syntax (dom-kwd ...))
+                        (syntax ((args ... keyword-formal-parameters ...) (val (dom-ctc args) ... keyword-call/ctc ...)))
+                        #t))]
+             [(values rngs ...)
+              (with-syntax ([(rng-x ...) (generate-temporaries (syntax (rngs ...)))]
+                            [(rng-ctc ...) (generate-temporaries (syntax (rngs ...)))])
+                (values (syntax (dom-ctc ...))
+                        (syntax (rng-ctc ...))
+                        (syntax (dom-kwd-ctc-id ...))
+                        (syntax (doms ...))
+                        (syntax (rngs ...))
+                        (syntax (dom-kwd-ctc ...))
+                        (syntax (dom-kwd ...))
+                        (syntax ((args ... keyword-formal-parameters ...) 
+                                 (let-values ([(rng-x ...) (val (dom-ctc args) ... keyword-call/ctc ...)])
+                                   (values (rng-ctc rng-x) ...))))
+                        #f))]
+             [rng
+              (with-syntax ([(rng-ctc) (generate-temporaries (syntax (rng)))])
+                (values (syntax (dom-ctc ...))
+                        (syntax (rng-ctc))
+                        (syntax (dom-kwd-ctc-id ...))
+                        (syntax (doms ...))
+                        (syntax (rng))
+                        (syntax (dom-kwd-ctc ...))
+                        (syntax (dom-kwd ...))
+                        (syntax ((args ... keyword-formal-parameters ...) (rng-ctc (val (dom-ctc args) ... keyword-call/ctc ...))))
+                        #f))]))))]))
 
 ;; ->/proc/main : syntax -> (values syntax[contract-record] syntax[args/lambda-body] syntax[names])
 (define-for-syntax (->/proc/main stx)
-  (let-values ([(dom-names rng-names dom-ctcs rng-ctcs inner-args/body use-any?) (->-helper stx)])
+  (let-values ([(dom-names rng-names kwd-names dom-ctcs rng-ctcs kwd-ctcs kwds inner-args/body use-any?) (->-helper stx)])
     (with-syntax ([(args body) inner-args/body])
       (with-syntax ([(dom-names ...) dom-names]
                     [(rng-names ...) rng-names]
+                    [(kwd-names ...) kwd-names]
                     [(dom-ctcs ...) dom-ctcs]
                     [(rng-ctcs ...) rng-ctcs]
+                    [(kwd-ctcs ...) kwd-ctcs]
+                    [(kwds ...) kwds]
                     [inner-lambda 
                      (add-name-prop
                       (syntax-local-infer-name stx)
                       (syntax (lambda args body)))]
                     [use-any? use-any?])
         (with-syntax ([outer-lambda
-                       (let* ([lst (syntax->list #'args)]
-                              [len (and lst (length lst))])
-                         (syntax
-                          (lambda (chk dom-names ... rng-names ...)
-                            (lambda (val)
-                              (chk val)
-                              inner-lambda))))])
+                       (syntax
+                        (lambda (chk dom-names ... rng-names ... kwd-names ...)
+                          (lambda (val)
+                            (chk val)
+                            inner-lambda)))])
           (values
            (syntax (build--> '->
                              (list dom-ctcs ...)
                              #f
                              (list rng-ctcs ...)
+                             (list kwd-ctcs ...)
+                             '(kwds ...)
                              use-any?
                              outer-lambda))
            inner-args/body
@@ -237,6 +324,8 @@ Add both optional and mandatory keywords to opt-> and friends.
                                        (list doms ...)
                                        rst
                                        (list rngs ...)
+                                       '()
+                                       '()
                                        #f 
                                        outer-lambda))
                      inner-args/body
@@ -263,6 +352,8 @@ Add both optional and mandatory keywords to opt-> and friends.
                                        (list doms ...)
                                        rst
                                        (list any/c)
+                                       '()
+                                       '()
                                        #t
                                        outer-lambda))
                      inner-args/body
@@ -364,7 +455,7 @@ Add both optional and mandatory keywords to opt-> and friends.
                      (dom-len (length dom-vars))
                      ((next-rng ...) next-rngs))
          (syntax (begin
-                   (check-procedure val dom-len src-info pos orig-str)
+                   (check-procedure val dom-len '() #| mandatory-keywords |# src-info pos orig-str)
                    (λ (dom-arg ...)
                      (let-values ([(rng-arg ...) (val next-dom ...)])
                        (values next-rng ...))))))
@@ -412,7 +503,7 @@ Add both optional and mandatory keywords to opt-> and friends.
                      ((next-dom ...) next-doms)
                      (dom-len (length dom-vars)))
          (syntax (begin
-                   (check-procedure val dom-len src-info pos orig-str)
+                   (check-procedure val dom-len '() #|mandatory-keywords|# src-info pos orig-str)
                    (λ (dom-arg ...)
                      (val next-dom ...)))))
        lifts-doms
@@ -424,10 +515,16 @@ Add both optional and mandatory keywords to opt-> and friends.
   
   (syntax-case* stx (-> values any) module-or-top-identifier=?
     [(-> dom ... (values rng ...))
-     (opt/arrow-ctc (syntax->list (syntax (dom ...)))
-                    (syntax->list (syntax (rng ...))))]
+     (if (ormap (λ (x) (keyword? (syntax-e x))) (syntax->list #'(dom ...)))
+         (opt/unknown opt/i opt/info stx) ;; give up if there is a mandatory keyword 
+         (opt/arrow-ctc (syntax->list (syntax (dom ...)))
+                        (syntax->list (syntax (rng ...)))))]
     [(-> dom ... any)
-     (opt/arrow-any-ctc (syntax->list (syntax (dom ...))))]
+     (if (ormap (λ (x) (keyword? (syntax-e x))) (syntax->list #'(dom ...)))
+         (opt/unknown opt/i opt/info stx) ;; give up if there is a mandatory keyword 
+         (opt/arrow-any-ctc (syntax->list (syntax (dom ...)))))]
     [(-> dom ... rng)
-     (opt/arrow-ctc (syntax->list (syntax (dom ...)))
-                    (list #'rng))]))
+     (if (ormap (λ (x) (keyword? (syntax-e x))) (syntax->list #'(dom ...)))
+         (opt/unknown opt/i opt/info stx) ;; give up if there is a mandatory keyword 
+         (opt/arrow-ctc (syntax->list (syntax (dom ...)))
+                        (list #'rng)))]))
diff --git a/collects/scheme/private/contract-opt-guts.ss b/collects/scheme/private/contract-opt-guts.ss
index 679d1ae5a0..1deacd0c07 100644
--- a/collects/scheme/private/contract-opt-guts.ss
+++ b/collects/scheme/private/contract-opt-guts.ss
@@ -1,6 +1,7 @@
 #lang scheme/base
 (require syntax/private/boundmap ;; needs to be the private one, since the public one has contracts
          (for-template scheme/base)
+         (for-template "contract-guts.ss")
          (for-syntax scheme/base))
 
 (provide get-opter reg-opter! opter
@@ -20,7 +21,9 @@
          opt/info-that
          
          opt/info-swap-blame
-         opt/info-change-val)
+         opt/info-change-val
+         
+         opt/unknown)
 
 ;; a hash table of opters
 (define opters-table
@@ -159,3 +162,42 @@
 
 (define (lifts-to-save lifts) (filter values (map car lifts)))
 
+;;
+;; opt/unknown : opt/i id id syntax
+;;
+(define (opt/unknown opt/i opt/info uctc)
+  (let* ((lift-var (car (generate-temporaries (syntax (lift)))))
+         (partial-var (car (generate-temporaries (syntax (partial)))))
+         (partial-flat-var (car (generate-temporaries (syntax (partial-flat))))))
+    (values
+     (with-syntax ((partial-var partial-var)
+                   (lift-var lift-var)
+                   (uctc uctc)
+                   (val (opt/info-val opt/info)))
+       (syntax (partial-var val)))
+     (list (cons lift-var 
+                 ;; FIXME needs to get the contract name somehow
+                 (with-syntax ((uctc uctc))
+                   (syntax (coerce-contract 'opt/c uctc)))))
+     null
+     (list (cons
+            partial-var
+            (with-syntax ((lift-var lift-var)
+                          (pos (opt/info-pos opt/info))
+                          (neg (opt/info-neg opt/info))
+                          (src-info (opt/info-src-info opt/info))
+                          (orig-str (opt/info-orig-str opt/info)))
+              (syntax (((proj-get lift-var) lift-var) pos neg src-info orig-str))))
+           (cons
+            partial-flat-var
+            (with-syntax ((lift-var lift-var))
+              (syntax (if (flat-pred? lift-var)
+                          ((flat-get lift-var) lift-var)
+                          (lambda (x) (error 'opt/unknown "flat called on an unknown that had no flat pred ~s ~s"
+                                             lift-var
+                                             x)))))))
+     (with-syntax ([val (opt/info-val opt/info)]
+                   [partial-flat-var partial-flat-var])
+       #'(partial-flat-var val))
+     lift-var
+     null)))
\ No newline at end of file
diff --git a/collects/scheme/private/contract-opt.ss b/collects/scheme/private/contract-opt.ss
index f7a38e2684..61005aa25a 100644
--- a/collects/scheme/private/contract-opt.ss
+++ b/collects/scheme/private/contract-opt.ss
@@ -52,46 +52,6 @@
              (void))
          (error 'define/opter "expected opter name to be an identifier, got ~e" (syntax-e #'for)))]))
 
-;;
-;; opt/unknown : opt/i id id syntax
-;;
-(define-for-syntax (opt/unknown opt/i opt/info uctc)
-  (let* ((lift-var (car (generate-temporaries (syntax (lift)))))
-         (partial-var (car (generate-temporaries (syntax (partial)))))
-         (partial-flat-var (car (generate-temporaries (syntax (partial-flat))))))
-    (values
-     (with-syntax ((partial-var partial-var)
-                   (lift-var lift-var)
-                   (uctc uctc)
-                   (val (opt/info-val opt/info)))
-       (syntax (partial-var val)))
-     (list (cons lift-var 
-                 ;; FIXME needs to get the contract name somehow
-                 (with-syntax ((uctc uctc))
-                   (syntax (coerce-contract 'opt/c uctc)))))
-     null
-     (list (cons
-            partial-var
-            (with-syntax ((lift-var lift-var)
-                          (pos (opt/info-pos opt/info))
-                          (neg (opt/info-neg opt/info))
-                          (src-info (opt/info-src-info opt/info))
-                          (orig-str (opt/info-orig-str opt/info)))
-              (syntax (((proj-get lift-var) lift-var) pos neg src-info orig-str))))
-           (cons
-            partial-flat-var
-            (with-syntax ((lift-var lift-var))
-              (syntax (if (flat-pred? lift-var)
-                          ((flat-get lift-var) lift-var)
-                          (lambda (x) (error 'opt/unknown "flat called on an unknown that had no flat pred ~s ~s"
-                                             lift-var
-                                             x)))))))
-     (with-syntax ([val (opt/info-val opt/info)]
-                   [partial-flat-var partial-flat-var])
-       #'(partial-flat-var val))
-     lift-var
-     null)))
-
 ;;
 ;; opt/recursive-call
 ;;
diff --git a/collects/scribblings/reference/contracts.scrbl b/collects/scribblings/reference/contracts.scrbl
index 45e602c59f..bd45dfd839 100644
--- a/collects/scribblings/reference/contracts.scrbl
+++ b/collects/scribblings/reference/contracts.scrbl
@@ -317,16 +317,17 @@ checks for its arguments and results.
 
 @defform*[#:literals (any)
           [(-> expr ... res-expr)
+           (-> expr ... (values res-expr ...))
            (-> expr ... any)]]{
 
-Produces a contract for a function that accepts a fixed number of
-arguments and returns either a single result or an unspecified number
-of results (the latter when @scheme[any] is specified).
+Produces a contract for a function that accepts a fixed
+number of arguments and returns either a fixed number of
+results or completely unspecified results (the latter when
+@scheme[any] is specified).
 
-Each @scheme[expr] is a contract on the argument to a function, and
-either @scheme[res-expr] or @scheme[any] specifies the result
-contract. Each @scheme[expr] or @scheme[res-expr] must produce a
-contract or a predicate.
+Each @scheme[expr] is a contract on the argument to a
+function, and each @scheme[res-expr] is a contract on the
+result of the function.
 
 For example,
 
@@ -338,11 +339,25 @@ function must produce an integer. (This example uses Scheme's infix
 notation so that the @scheme[->] appears in a suggestive place; see
 @secref["parse-pair"]).
 
+The @scheme[expr] may be keywords. If so, the functions must
+have the corresponding (mandatory) keyword and those keyword
+arguments must match the contracts that follow them. For example:
+
+@schemeblock[(integer? #:x boolean? . -> . integer?)]
+
+is a contract on a function that accepts a single, integer
+ordinary argument and the keyword argument @scheme[#:x]
+whose values must be booleans.
+
 If @scheme[any] is used as the last argument to @scheme[->], no
 contract checking is performed on the result of the function, and
 tail-recursion is preserved. Note that the function may return
-multiple values in that case.}
+multiple values in that case.
 
+If @scheme[(values res-expr ...)] is used as the last
+argument to @scheme[->], the result must have single value
+for each contract and the values must match their respective
+contracts.}
 
 @defform*[#:literals (any)
           [(->* (expr ...) (res-expr ...))
diff --git a/collects/tests/mzscheme/contract-test.ss b/collects/tests/mzscheme/contract-test.ss
index 7ed3e5a723..14cb8f09cf 100644
--- a/collects/tests/mzscheme/contract-test.ss
+++ b/collects/tests/mzscheme/contract-test.ss
@@ -428,12 +428,154 @@
      1))
 
   (test/pos-blame
-   'contract-arrow-keyword
+   'contract-arrow-keyword1
+   '(contract (-> integer? any)
+              (λ (x #:y y) x)
+              'pos
+              'neg))
+  
+  (test/pos-blame
+   'contract-arrow-keyword1b
+   '(contract (-> integer? #:y integer? any)
+              (λ (x) x)
+              'pos
+              'neg))
+  
+  (test/spec-passed
+   'contract-arrow-keyword2
+   '(contract (-> integer? #:y boolean? any)
+              (λ (x #:y y) x)
+              'pos
+              'neg))
+  
+  (test/spec-passed
+   'contract-arrow-keyword2b
+   '(contract (-> #:x boolean? #:y boolean? any)
+              (λ (#:x x #:y y) x)
+              'pos
+              'neg))
+  
+  (test/spec-passed
+   'contract-arrow-keyword2c
+   '(contract (-> #:y boolean? #:x boolean? any)
+              (λ (#:x x #:y y) x)
+              'pos
+              'neg))
+  
+  (test/spec-passed
+   'contract-arrow-keyword2d
+   '(contract (-> #:y boolean? #:x boolean? any)
+              (λ (#:y y #:x x) x)
+              'pos
+              'neg))
+  
+  (test/spec-passed
+   'contract-arrow-keyword2e
+   '(contract (-> #:x boolean? #:y boolean?  any)
+              (λ (#:y y #:x x) x)
+              'pos
+              'neg))
+  
+  (test/neg-blame
+   'contract-arrow-keyword3
+   '((contract (-> integer? #:y boolean? any)
+               (λ (x #:y y) x)
+               'pos
+               'neg)
+     1 #:y 1))
+  
+  (test/neg-blame
+   'contract-arrow-keyword4
+   '((contract (-> integer? #:y boolean? any)
+               (λ (x #:y y) x)
+               'pos
+               'neg)
+     #t #:y #t))
+  
+  (test/spec-passed
+   'contract-arrow-keyword5
+   '((contract (-> integer? #:y boolean? any)
+               (λ (x #:y y) x)
+               'pos
+               'neg)
+     1 #:y #t))
+  
+  (test/pos-blame
+   'contract-arrow-keyword6
    '(contract (-> integer? integer?)
               (λ (x #:y y) x)
               'pos
               'neg))
   
+  (test/spec-passed
+   'contract-arrow-keyword7
+   '(contract (-> integer? #:y boolean? integer?)
+              (λ (x #:y y) x)
+              'pos
+              'neg))
+  
+  (test/neg-blame
+   'contract-arrow-keyword8
+   '((contract (-> integer? #:y boolean? integer?)
+               (λ (x #:y y) x)
+               'pos
+               'neg)
+     1 #:y 1))
+  
+  (test/neg-blame
+   'contract-arrow-keyword9
+   '((contract (-> integer? #:y boolean? integer?)
+               (λ (x #:y y) x)
+               'pos
+               'neg)
+     #t #:y #t))
+  
+  (test/spec-passed
+   'contract-arrow-keyword10
+   '((contract (-> integer? #:y boolean? integer?)
+               (λ (x #:y y) x)
+               'pos
+               'neg)
+     1 #:y #t))
+  
+  (test/pos-blame
+   'contract-arrow-keyword11
+   '(contract (-> integer? (values integer? integer?))
+              (λ (x #:y y) x)
+              'pos
+              'neg))
+  
+  (test/spec-passed
+   'contract-arrow-keyword12
+   '(contract (-> integer? #:y boolean? (values integer? integer?))
+              (λ (x #:y y) x)
+              'pos
+              'neg))
+  
+  (test/neg-blame
+   'contract-arrow-keyword13
+   '((contract (-> integer? #:y boolean? (values integer? integer?))
+               (λ (x #:y y) x)
+               'pos
+               'neg)
+     1 #:y 1))
+  
+  (test/neg-blame
+   'contract-arrow-keyword14
+   '((contract (-> integer? #:y boolean? (values integer? integer?))
+               (λ (x #:y y) x)
+               'pos
+               'neg)
+     #t #:y #t))
+  
+  (test/spec-passed
+   'contract-arrow-keyword15
+   '((contract (-> integer? #:y boolean? (values integer? integer?))
+               (λ (x #:y y) (values x x))
+               'pos
+               'neg)
+     1 #:y #t))
+
   (test/pos-blame
    'contract-d1
    '(contract (integer? . ->d . (lambda (x) (lambda (y) (= x y))))