fix bug in ->* contract combinator

that would cause the optional and mandatory keyword arguments
to get mixed up in certain situations

pkgs/racket-pkgs/racket-test/tests/racket/contract/arrow-neg-party.rkt

@@ -16,7 +16,7 @@
                                 #f #t))
       (wrapped-extra-arg-arrow-extra-neg-party-argument
        (((contract-struct-val-first-projection c) blame) val))))
-#|
+
   (test/spec-passed/result 
    'arity-as-string1
    '(arity-as-string (let ([f (λ (x) x)]) f))
@@ -160,7 +160,7 @@
       (->* () (boolean? char? integer?) any)
       (λ args 1))
      'neg #f #\f #xf))
-  |#
+  
   (test/spec-passed
    '->*neg-party10
    '((neg-party-fn
@@ -226,4 +226,21 @@
            (and/c hash? immutable?))
       (λ (h #:combine [x void] #:combine/key [y void] . rest)
         (hash)))
-     'neg (hash) 11 12)))
+     'neg (hash) 11 12))
+  
+  (test/spec-passed/result
+   '->*neg-party18
+   '((neg-party-fn 
+      (->* (#:user string?)
+           (#:database (or/c string? #f)
+                       #:password (or/c string? (list/c 'hash string?) #f)
+                       #:port (or/c exact-positive-integer? #f))
+           any/c)
+      (λ (#:user user
+                 #:database [db #f]
+                 #:password [password #f]
+                 #:port [port #f])
+        (list user db password port)))
+     'neg #:database "db" #:password "password" #:user "user")
+   (list "user" "db" "password" #f)))
+

pkgs/racket-pkgs/racket-test/tests/racket/contract/arrow-star.rkt

@@ -526,6 +526,23 @@
                 new-statement
                 'pos 'neg)))
   
+  (test/spec-passed/result
+   'contract-arrow-star-optional25
+   '((contract 
+      (->* (#:user string?)
+           (#:database (or/c string? #f)
+                       #:password (or/c string? (list/c 'hash string?) #f)
+                       #:port (or/c exact-positive-integer? #f))
+           any/c)
+      (λ (#:user user
+                 #:database [db #f]
+                 #:password [password #f]
+                 #:port [port #f])
+        (list user db password port))
+      'pos 'neg)
+     #:database "db" #:password "password" #:user "user")
+   (list "user" "db" "password" #f))
+  
   (test/spec-passed
    'contract-arrow-star-keyword-ordering
    '((contract (->* (integer? #:x boolean?) (string? #:y char?) any)

racket/collects/racket/contract/private/arrow-higher-order.rkt

@@ -32,8 +32,8 @@
                 [(rest-proj ...) (if rest (generate-temporaries '(rest-proj)) '())])
     #`(λ (blame f neg-party
                 mandatory-dom-proj ...  
-                rest-proj ...
                 optional-dom-proj ... 
+                rest-proj ...
                 mandatory-dom-kwd-proj ... 
                 optional-dom-kwd-proj ... 
                 rng-proj ...)
@@ -321,21 +321,24 @@
         (kwd-proj (blame-add-context orig-blame
                                      (format "the ~a argument of" (kwd-info-kwd kwd))
                                      #:swap? #t))))
-    (define the-args (append partial-doms 
-                             (if partial-rest (list partial-rest) '())
-                             partial-kwds
-                             partial-ranges))
-    (define plus-one-constructor-args
-      (append partial-doms 
-              (for/list ([partial-kwd (in-list partial-kwds)]
+    (define man-then-opt-partial-kwds
+      (append (for/list ([partial-kwd (in-list partial-kwds)]
                          [kwd-info (in-list kwd-infos)]
                          #:when (kwd-info-mandatory? kwd-info))
                 partial-kwd)
               (for/list ([partial-kwd (in-list partial-kwds)]
                          [kwd-info (in-list kwd-infos)]
                          #:unless (kwd-info-mandatory? kwd-info))
-                partial-kwd)
-              partial-ranges 
+                partial-kwd)))
+    
+    (define the-args (append partial-doms
+                             (if partial-rest (list partial-rest) '())
+                             man-then-opt-partial-kwds
+                             partial-ranges))
+    (define plus-one-constructor-args
+      (append partial-doms
+              man-then-opt-partial-kwds
+              partial-ranges
               (if partial-rest (list partial-rest) '())))
     (λ (val)
       (wrapped-extra-arg-arrow 

racket/collects/racket/contract/private/guts.rkt

@@ -359,15 +359,17 @@
      (define p? (predicate-contract-pred ctc))
      (define name (predicate-contract-name ctc))
      (λ (blame)
-       (λ (v)
-         (if (p? v)
-             (λ (neg-party)
-               v)
-             (λ (neg-party)
-               (raise-blame-error blame v #:missing-party neg-party
-                                  '(expected: "~s" given: "~e")
-                                  name 
-                                  v))))))
+       (let ([predicate-contract-proj
+              (λ (v)
+                (if (p? v)
+                    (λ (neg-party)
+                      v)
+                    (λ (neg-party)
+                      (raise-blame-error blame v #:missing-party neg-party
+                                         '(expected: "~s" given: "~e")
+                                         name 
+                                         v))))])
+         predicate-contract-proj)))
    #:generate (λ (ctc)
                  (let ([generate (predicate-contract-generate ctc)])
                    (if (generate-ctc-fail? generate)