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

Remove the coercion function code.

Browse Source 
Didn't turn out to be useful.
This commit is contained in:
Vincent St-Amour 2012-05-22 17:53:41 -04:00
parent 44783b9f8e
commit cc7ae795ea
8 changed files with 2 additions and 100 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
collects/data/order.rkt
View File

@ -17,7 +17,6 @@
(define-generics (ordered-dict gen:ordered-dict prop:ordered-dict ordered-dict?
#:defined-table dict-def-table
;; private version needs all kw args, in order
#:coerce-method-table #f
#:prop-defined-already? #f)
(dict-iterate-least ordered-dict)
(dict-iterate-greatest ordered-dict)

3
collects/racket/generics.rkt
View File

@ -27,7 +27,6 @@
[gen:name (id "gen:" name-str)])
#'(define-generics/pre (name gen:name prop:name name?
#:defined-table defined-table
;; the following are not public
#:coerce-method-table #f
;; the following is not public
#:prop-defined-already? #f)
(generic . generics-args) ...)))]))

1
collects/racket/private/dict.rkt
View File

@ -5,7 +5,6 @@
(define-generics (dict gen:dict prop:dict dict? #:defined-table dict-def-table
;; private version needs all kw args, in order
#:coerce-method-table #f
#:prop-defined-already? #f)
(dict-ref dict key [default])
(dict-set! dict key val)

60
collects/racket/private/generics.rkt
View File

@ -20,8 +20,6 @@
;; the method header's self argument.
[(_ (header name prop:name name?
#:defined-table defined-table
;; use of coercion functions is explained below
#:coerce-method-table coerce-method-table
;; are we being passed an existing struct property? If so,
;; this kw arg is bound to the struct property accessor, and
;; we don't define the struct property
@ -39,7 +37,6 @@
i)]
[name-str (symbol->string (syntax-e #'name))]
[generics (syntax->list #'(generic ...))]
[need-coercion? (syntax->datum #'coerce-method-table)]
[prop-defined-already? (syntax-e #'defined-already?)])
(with-syntax ([name-str name-str]
[how-many-generics (length idxs)]
@ -92,13 +89,6 @@
#'id]
[()
#'()])))]
[prop:method-table
;; if we need to coerce what's at prop:name into a
;; method table, we need to generate a new struct
;; property for the method table
(if need-coercion?
(generate-temporary (syntax->datum #'prop:name))
#'prop:name)]
;; if we're the ones defining the struct property,
;; generate a new id, otherwise use the struct property
;; accessor that we were passed
@ -119,7 +109,7 @@
#,@(if prop-defined-already?
'() ; we don't need to define it
(list
#'(define-values (prop:method-table name? get-generics)
#'(define-values (prop:name name? get-generics)
(make-struct-type-property
'name
(lambda (generic-vector si)
@ -137,54 +127,6 @@
(and mthd-generic
(generic-arity-coerce mthd-generic)))
...))))))
;; Use case for method table coercion: retrofitting a generics-
;; based API on top of a struct property that uses its own ad-hoc
;; extension mechanism.
;; If coercion is used, prop:method-table and prop:name are
;; distinct. We define prop:name (e.g. prop:equals+hash-code,
;; the user-facing name) to "push" its method table to
;; prop:method-table, calling the coercion function if necessary.
;; prop:method-table is then used for dispatch and all.
;; That way, existing code can use prop:name using its old
;; extension API, and new code can use the generics-based
;; interface.
;; The coercion function should take whatever lives at prop:name
;; according to its old extension API, and produce a vector of
;; methods in the defined order.
;;
;; Note: this feature turned out to be less useful than we
;; expected, because most of the backwards compatibility
;; examples we found were much more complicated. It would
;; have been useful for equal+hash were it not defined
;; in the C code.
#,@(if need-coercion?
(list
#'(define-values (prop:name unused unused2)
(make-struct-type-property
'front-facing-name
#f ; no guard, we accept anything;
;; prop:method-table does the checking
(list
(cons prop:method-table
(lambda (maybe-method-table)
;; if we get a valid method table, (methods
;; was used, not the old API provided for
;; prop:name) we just use it. otherwise, we
;; call the coercion function
(if (and (vector? maybe-method-table)
(= (vector-length
maybe-method-table)
how-many-generics)
(for/and ([g (in-vector
maybe-method-table)])
(procedure? g)))
;; valid method table
maybe-method-table
(coerce-method-table
maybe-method-table))))))))
;; no need for coercions, methods are stored at prop:name
'())
;; Hash table mapping method name symbols to
;; whether the given method is implemented
(define (defined-table this)

1
collects/racket/stream.rkt
View File

@ -41,7 +41,6 @@
(define-generics (-stream gen:stream prop:stream stream?
#:defined-table defined-table
#:coerce-method-table #f
#:prop-defined-already? stream-get-generics)
;; These three are never used for the reasons explained above.
;; We still need the headers for clients who extend racket/stream.

34
collects/tests/generics/coercion.rkt
View File

@ -1,34 +0,0 @@
#lang racket
(require racket/private/generics)
(define-generics (echoable gen:echoable prop:echo echo?
#:defined-table dummy
#:coerce-method-table list->vector
#:prop-defined-already? #f)
(echo echoable))
(struct echo1 (s)
#:methods gen:echoable
;; defined the "new" way
((define (echo x) (echo1-s x))))
(struct echo2 (s)
#:property prop:echo
;; defined the "old" way
(list (lambda (x) (echo2-s x))))
(struct echo3 (s)
#:property prop:echo
;; happens to get a valid method table, we're good
(vector (lambda (x) (echo3-s x))))
(module+ test
(require rackunit)
(define e1 (echo1 "a"))
(check-equal? (echo e1) "a")
(define e2 (echo2 "b"))
(check-equal? (echo e2) "b")
(define e3 (echo3 "c"))
(check-equal? (echo e3) "c"))

1
collects/tests/generics/iterator.rkt
View File

@ -33,7 +33,6 @@
(define-generics (iterator gen:iterator prop:iterator iterator?
#:defined-table dummy
#:coerce-method-table #f
#:prop-defined-already? iterator-accessor)
(iterator-first iterator)
(iterator-rest iterator)

1
collects/tests/generics/tests.rkt
View File

@ -3,7 +3,6 @@
(require (submod "custom-hash.rkt" test)
(submod "alist.rkt" test)
(submod "from-docs.rkt" test)
(submod "coercion.rkt" test)
(submod "stream.rkt" test)
(submod "iterator.rkt" test)
(submod "struct-form.rkt" test)