suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Separated generic contracts from define-primitive-generics.

Browse Source 
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.
This commit is contained in:
Carl Eastlund 2013-07-08 17:12:18 -04:00
parent 00ccb5850b
commit 6e01d1d9a3
5 changed files with 24 additions and 34 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
pkgs/data-lib/data/order.rkt
View File

@ -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)

5
pkgs/racket-pkgs/racket-test/tests/generic/pr13737.rkt
View File

@ -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))

21
racket/lib/collects/racket/generic.rkt
View File

@ -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)

6
racket/lib/collects/racket/private/dict.rkt
View File

@ -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)

20
racket/lib/collects/racket/private/generic.rkt
View File

@ -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