Separated generic contracts from define-primitive-generics.

Now the primitive generics form just defines generics with their properties and
methods, and the surface-level form calls the contract definition form
directly.  This means the primitive generics form now requires an explicit name
for a struct property accessor, so that the same name can be used for the
contract.

pkgs/data-lib/data/order.rkt

@@ -15,11 +15,9 @@
 ;; i.e., exporting prop:ordered-dict as opposed to using a
 ;;       generated hidden property.
 (define-primitive-generics
-  (ordered-dict gen:ordered-dict prop:ordered-dict ordered-dict?
+  (ordered-dict gen:ordered-dict prop:ordered-dict ordered-methods ordered-dict?
                 #:defined-table dict-def-table
-                #:defaults ()
+                #:defaults ())
-                ;; private version needs all kw args, in order
-                #:define-contract #f)
   (dict-iterate-least ordered-dict)
   (dict-iterate-greatest ordered-dict)
   (dict-iterate-least/>? ordered-dict key)

pkgs/racket-pkgs/racket-test/tests/generic/pr13737.rkt

@@ -21,10 +21,9 @@
   (local-require racket/private/generic)
 
   (define-primitive-generics
-    (foo gen:foo prop:foo foo?
+    (foo gen:foo prop:foo foo-methods foo?
          #:defined-table dummy
-         #:defaults ([number? (define (meth foo #:kw kw) kw)])
+         #:defaults ([number? (define (meth foo #:kw kw) kw)]))
-         #:define-contract #f)
     (meth foo #:kw kw))
 
   (check-equal? (meth 3 #:kw 5) 5))

racket/lib/collects/racket/generic.rkt

@@ -61,16 +61,25 @@
          (parse #'rest #f #f #f))
        (define/with-syntax [default ...] defaults)
        (define/with-syntax [method ...] methods)
+       (define/with-syntax [method-name ...] (map stx-car methods))
+       (define/with-syntax [method-index ...]
+         (for/list ([method (in-list methods)]
+                    [index (in-naturals 0)])
+           index))
        (define/with-syntax pred-name (format-id #'name "~a?" #'name))
        (define/with-syntax gen-name (format-id #'name "gen:~a" #'name))
        (define/with-syntax prop-name (generate-temporary #'name))
+       (define/with-syntax get-name (generate-temporary #'name))
        (define/with-syntax table-name table)
-       #'(define-primitive-generics
+       #'(begin
-           (name gen-name prop-name pred-name
+           (define-primitive-generics
+             (name gen-name prop-name get-name pred-name
                    #:defined-table table-name
-                 #:defaults [default ...]
+                   #:defaults [default ...])
-                 #:define-contract define-generics-contract)
+             method ...)
-           method ...))]))
+           (define-generics-contract name pred-name get-name
+             [method-name method-index]
+             ...)))]))
 
 ;; generate a contract combinator for instances of a generic interface
 (define-syntax (define-generics-contract stx)

racket/lib/collects/racket/private/dict.rkt

@@ -3,11 +3,9 @@
 (require racket/private/generic ; to avoid circular dependencies
          (for-syntax racket/base))
 
-(define-primitive-generics (dict gen:dict prop:dict dict?
+(define-primitive-generics (dict gen:dict prop:dict dict-methods dict?
                                  #:defined-table dict-def-table
-                                 #:defaults ()
+                                 #:defaults ())
-                                 ;; private version needs all kw args, in order
-                                 #:define-contract #f)
   (dict-ref  dict key [default])
   (dict-set! dict key val)
   (dict-set  dict key val)

racket/lib/collects/racket/private/generic.rkt

@@ -20,21 +20,17 @@
     ;; that is used to define the `name`, `prop:name`, and `name?`
     ;; identifiers. We have it here so that we can use it to match
     ;; the method header's self argument.
-    [(_ (header name prop:name name?
+    [(_ (header name prop:name get-generics name?
                 #:defined-table defined-table
                 #:defaults
                 ([pred? impl ...]
                  ;; TODO fallthrough?
-                 ...)
+                 ...))
-                ;; Passed in by `define-generics` in racket/generic.
-                ;; This enables us to cut the dependency on racket/contract
-                ;; for users of this private module. Pass in #f
-                ;; to avoid defining a contract.
-                #:define-contract define-generics-contract)
         (generic . generic-args) ...)
      (and (identifier? #'header)
           (identifier? #'name)
           (identifier? #'prop:name)
+          (identifier? #'get-generics)
           (identifier? #'name?)
           (identifier? #'defined-table)
           (let ([generics (syntax->list #'(generic ...))])
@@ -114,10 +110,6 @@
                              #'id]
                             [()
                              #'()])))]
-                     ;; if we're the ones defining the struct property,
-                     ;; generate a new id, otherwise use the struct property
-                     ;; accessor that we were passed
-                     [get-generics (generate-temporary 'get-generics)]
                      ;; for each generic method, builds a cond clause to do the
                      ;; predicate dispatch found in method-impl-list
                      [((cond-impl ...) ...) marked-generics]
@@ -176,12 +168,6 @@
                (for/hash ([name (in-list '(#,@(map syntax->datum generics)))]
                           [gen (in-vector (get-generics this))])
                  (values name (not (not gen)))))
-             ;; Define the contract that goes with this generic interface
-             #,@(if (syntax-e #'define-generics-contract)
-                    (list #'(define-generics-contract header name? get-generics
-                             (generic generic-idx) ...))
-                    ;; don't define a contract when given #f
-                    '())
              ;; Define default implementations
              #,@method-impl-list
              ;; Define generic functions