racket/generic: fix kw args with #:defaults

Closes PR 13737

collects/racket/private/generic.rkt

@@ -200,17 +200,14 @@
              (define generic
                (generic-arity-coerce
                 'generic
+                ;; We could put `generic-args` here for the method header, but
+                ;; since we need to keyword-apply the method in the method table,
+                ;; it doesn't help. Thus we use `make-keyword-procedure`.
+                ;;
+                ;; If keyword-apply ends up being a bottleneck, consider
+                ;; adding the second argument to `make-keyword-procedure` again.
                 (make-keyword-procedure
                  (lambda (kws kws-args . given-args)
-                   (define this (list-ref given-args generic-this-idx))
-                   (if (name? this)
-                       (let ([m (vector-ref (get-generics this) generic-idx)])
-                         (if m
-                             (keyword-apply m kws kws-args given-args)
-                             (error 'generic "not implemented for ~e" this)))
-                       (raise-argument-error 'generic name-str this)))
-                 ; XXX (non-this ... this . rst)
-                 (lambda given-args
                    (define this (list-ref given-args generic-this-idx))
                    (cond
                     [#,(if prop-defined-already?
@@ -218,10 +215,10 @@
                            #'(-name? this))
                      (let ([m (vector-ref (get-generics this) generic-idx)])
                        (if m
-                           (apply m given-args)
+                           (keyword-apply m kws kws-args given-args)
                            (error 'generic "not implemented for ~e" this)))]
                     ;; default cases
-                    [(pred? this) (apply cond-impl given-args)]
+                    [(pred? this) (keyword-apply cond-impl kws kws-args given-args)]
                     ...
                     [else (raise-argument-error 'generic name-str this)])))))
              ...)))]))

collects/tests/generic/pr13737.rkt

@@ -0,0 +1,36 @@
+#lang racket
+
+(require racket/generic
+         rackunit)
+
+;; This tests PR 13737 (keyword arguments and #:defaults did
+;; not work together)
+
+(define-generics thing
+  (foo thing #:stuff other)
+  #:defaults
+  {[number?
+    (define (foo thing #:stuff other) (+ thing other))]})
+
+(check-equal? (foo 1 #:stuff 2) 3)
+
+;; This tests that the keyword & defaults issue doesn't occur for
+;; forged generics either
+
+(let ()
+  (local-require racket/private/generic)
+
+  (define-values (prop:foo foo? foo-accessor)
+    (make-struct-type-property
+     'foo
+     #f))
+
+  (define-generics (foo gen:foo prop:foo foo?
+                        #:defined-table dummy
+                        #:defaults ([number? (define (meth foo #:kw kw) kw)])
+                        #:prop-defined-already? foo-accessor
+                        #:define-contract #f)
+    (meth foo #:kw kw))
+
+  (check-equal? (meth 3 #:kw 5) 5))
+

collects/tests/generic/tests.rkt

@@ -16,4 +16,6 @@
          "from-unstable.rkt"
          "poly-contracts.rkt"
          "empty-interface.rkt"
-         "top-level.rkt")
+         "top-level.rkt"
+         "pr13737.rkt")
+