diff --git a/pkgs/data-lib/data/order.rkt b/pkgs/data-lib/data/order.rkt index a6bb85449a..9c0c5685db 100644 --- a/pkgs/data-lib/data/order.rkt +++ b/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 () - ;; private version needs all kw args, in order - #:define-contract #f) + #:defaults ()) (dict-iterate-least ordered-dict) (dict-iterate-greatest ordered-dict) (dict-iterate-least/>? ordered-dict key) diff --git a/pkgs/racket-pkgs/racket-test/tests/generic/pr13737.rkt b/pkgs/racket-pkgs/racket-test/tests/generic/pr13737.rkt index c668058510..5e01649ddd 100644 --- a/pkgs/racket-pkgs/racket-test/tests/generic/pr13737.rkt +++ b/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)]) - #:define-contract #f) + #:defaults ([number? (define (meth foo #:kw kw) kw)])) (meth foo #:kw kw)) (check-equal? (meth 3 #:kw 5) 5)) diff --git a/racket/lib/collects/racket/generic.rkt b/racket/lib/collects/racket/generic.rkt index c908c8f8c4..77f167a42c 100644 --- a/racket/lib/collects/racket/generic.rkt +++ b/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 - (name gen-name prop-name pred-name - #:defined-table table-name - #:defaults [default ...] - #:define-contract define-generics-contract) - method ...))])) + #'(begin + (define-primitive-generics + (name gen-name prop-name get-name pred-name + #:defined-table table-name + #:defaults [default ...]) + 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) diff --git a/racket/lib/collects/racket/private/dict.rkt b/racket/lib/collects/racket/private/dict.rkt index c5fd47d983..b6f3fe747a 100644 --- a/racket/lib/collects/racket/private/dict.rkt +++ b/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 () - ;; private version needs all kw args, in order - #:define-contract #f) + #:defaults ()) (dict-ref dict key [default]) (dict-set! dict key val) (dict-set dict key val) diff --git a/racket/lib/collects/racket/private/generic.rkt b/racket/lib/collects/racket/private/generic.rkt index bf3dfdb1b7..91e31da401 100644 --- a/racket/lib/collects/racket/private/generic.rkt +++ b/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