Use simplified interface for define-generics

Also removed `generics`
This commit is contained in:
Asumu Takikawa 2012-05-22 15:13:16 -04:00 committed by Vincent St-Amour
parent f11861f60a
commit 8ac82eaf58
13 changed files with 214 additions and 221 deletions

View File

@ -3,20 +3,28 @@
racket/contract/base
racket/string
ffi/unsafe/atomic
racket/generics)
racket/private/generics)
(define ordering/c
(or/c '= '< '>))
(provide ordering/c)
(define-generics (gen:ordered-dict prop:ordered-dict ordered-dict?)
(dict-iterate-least gen:ordered-dict)
(dict-iterate-greatest gen:ordered-dict)
(dict-iterate-least/>? gen:ordered-dict key)
(dict-iterate-least/>=? gen:ordered-dict key)
(dict-iterate-greatest/<? gen:ordered-dict key)
(dict-iterate-greatest/<=? gen:ordered-dict key))
;; we use the private version here because we need to
;; provide a backwards compatible interface (just in case)
;; i.e., exporting prop:ordered-dict as opposed to using a
;; generated hidden property.
(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)
(dict-iterate-least/>? ordered-dict key)
(dict-iterate-least/>=? ordered-dict key)
(dict-iterate-greatest/<? ordered-dict key)
(dict-iterate-greatest/<=? ordered-dict key))
(define extreme-contract
(->i ([d ordered-dict?])

View File

@ -24,17 +24,12 @@ Contract for orderings, represented by the symbols @racket['=],
@racket['<], and @racket['>].
}
@deftogether[[
@defthing[gen:ordered-dict any/c]
@defthing[prop:ordered-dict
(struct-type-property/c
(vectorof _e/c _e/c _s/c _s/c _s/c _s/c))]
]]{
@defthing[gen:ordered-dict any/c]{
Struct-type property for defining new ordered dictionary types.
Methods can be attached to the @racket[prop:ordered-dict] struct property
using the @racket[methods] form and the @racket[gen:ordered-dict] generic
interface. Two ``extrema'' methods and four ``search'' methods should be
A generic interface for defining new ordered dictionary types.
Methods can be attached to the @racket[gen:ordered-dict] interface
using the @racket[#:methods] keyword in a structure type definition.
Two ``extrema'' methods and four ``search'' methods should be
implemented. The extrema methods must satisfy @racket[_e/c] and the search
methods must satisfy @racket[_s/c]:
@ -57,15 +52,24 @@ The methods are implementations of the following generic functions:
@item{@racket[dict-iterate-greatest/<=?]}
]
A struct type that implements @racket[prop:ordered-dict] must also
implement @racket[prop:dict].
A struct type that implements @racket[gen:ordered-dict] must also
implement @racket[gen:dict].
}
@defthing[prop:ordered-dict
(struct-type-property/c
(vectorof _e/c _e/c _s/c _s/c _s/c _s/c))]{
A deprecated structure type property used to defined custom
ordered dictionaries. Use @racket[gen:ordered-dict] instead.
Accepts a vector of 6 procedures with the same arguments as
the methods of @racket[gen:ordered-dict].
}
@defproc[(ordered-dict? [x any/c]) boolean?]{
Returns @racket[#t] if @racket[x] is an instance of a struct
implementing the @tech{ordered dictionary} interface (via
@racket[prop:ordered-dict]).
@racket[gen:ordered-dict]).
}
@deftogether[[

View File

@ -10,34 +10,24 @@
;; Files that use racket/private/generics _must_ pass _all_ keyword
;; arguments to define-generics _in_order_.
(provide generics define-generics define/generic)
(provide define-generics define/generic)
(define-syntax (generics stx)
(syntax-case stx ()
[(_ name (generic . generic-args) ...)
(define-syntax (define-generics stx) ; allows out-of-order / optional kw args
(syntax-case stx () ; can't use syntax-parse, since it depends on us
[(_ (name) (generic . generics-args) ...)
#'(define-generics (name #:defined-table defined-table)
(generic . generics-args) ...)]
[(_ (name #:defined-table defined-table)
(generic . generics-args) ...)
(local [(define name-str (symbol->string (syntax-e #'name)))
(define (id . strs)
(datum->syntax
#'name (string->symbol (apply string-append strs)) #'name))]
(with-syntax ([name? (id name-str "?")]
[prop:name (id "prop:" name-str)])
(syntax/loc stx
(define-generics (name prop:name name?)
(generic . generic-args) ...))))]))
(define-syntax (define-generics stx) ; allows out-of-order / optional kw args
(syntax-case stx () ; can't use syntax-parse, since it depends on us
[(_ (name prop:name name?) (generic . generics-args) ...)
#'(define-generics/pre (name prop:name name?
#:defined-table defined-table
;; the following are not public
#:coerce-method-table #f
#:prop-defined-already? #f)
(generic . generics-args) ...)]
[(_ (name prop:name name? #:defined-table defined-table)
(generic . generics-args) ...)
#'(define-generics/pre (name prop:name name?
#:defined-table defined-table
#:coerce-method-table #f
#:prop-defined-already? #f)
(generic . generics-args) ...)]))
(with-syntax ([name? (id name-str "?")]
[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
#:prop-defined-already? #f)
(generic . generics-args) ...)))]))

View File

@ -3,20 +3,20 @@
(require racket/private/generics ; to avoid circular dependencies
(for-syntax racket/base))
(define-generics (gen:dict prop:dict dict? #:defined-table dict-def-table
(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 gen:dict key [default])
(dict-set! gen:dict key val)
(dict-set gen:dict key val)
(dict-remove! gen:dict key)
(dict-remove gen:dict key)
(dict-count gen:dict)
(dict-iterate-first gen:dict)
(dict-iterate-next gen:dict pos)
(dict-iterate-key gen:dict pos)
(dict-iterate-value gen:dict pos))
(dict-ref dict key [default])
(dict-set! dict key val)
(dict-set dict key val)
(dict-remove! dict key)
(dict-remove dict key)
(dict-count dict)
(dict-iterate-first dict)
(dict-iterate-next dict pos)
(dict-iterate-key dict pos)
(dict-iterate-value dict pos))
(define (assoc? v)
(and (list? v) (andmap pair? v)))

View File

@ -13,16 +13,22 @@
(syntax-case stx () ; can't use syntax-parse, since it depends on us
;; keyword arguments must _all_ be provided _in_order_. For the
;; user-facing version of `define-generics', see racket/generics.
[(_ (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
#:prop-defined-already? defined-already?)
;;
;; The `header` is the original name the library writer provides
;; 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?
#: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
#:prop-defined-already? defined-already?)
(generic . generic-args) ...)
(and (identifier? #'name)
(and (identifier? #'header)
(identifier? #'name)
(identifier? #'prop:name)
(identifier? #'name?)
(identifier? #'defined-table)
@ -50,7 +56,7 @@
(loop #'ga i)]
[(id . ga)
(and (identifier? #'id))
(if (free-identifier=? #'name #'id)
(if (free-identifier=? #'header #'id)
i
(loop #'ga (add1 i)))]
[(keyword [id] . ga)

View File

@ -39,15 +39,15 @@
stream-add-between
stream-count)
(define-generics (gen:stream prop:stream stream?
#:defined-table defined-table
#:coerce-method-table #f
#:prop-defined-already? stream-get-generics)
(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.
(stream-empty? gen:stream)
(stream-first gen:stream)
(stream-rest gen:stream))
(stream-empty? -stream)
(stream-first -stream)
(stream-rest -stream))
(define-syntax stream
(syntax-rules ()

View File

@ -25,10 +25,14 @@
(code:line #:constructor-name constructor-id)
(code:line #:extra-constructor-name constructor-id)
(code:line #:reflection-name symbol-expr)
(code:line #:methods gen:name method-defs)
#:omit-define-syntaxes
#:omit-define-values]
[field-option #:mutable
#:auto])]{
#:auto]
[method-defs (definition ...)])
#:contracts
([gen:name identifier?])]{
Creates a new @techlink{structure type} (or uses a pre-existing
structure type if @racket[#:prefab] is specified), and binds
@ -145,6 +149,15 @@ the structure type in reflective operations such as
@racket[make-struct-type]. Structure printing uses the reflective
name, as do the various procedures that are bound by @racket[struct].
If @racket[#:methods gen:name method-defs] is provided, then
@racket[gen:name] must be a transformer binding for the static
information about a generic group produced by @racket[define-generics].
The @racket[method-defs] define the methods of @racket[gen:name].
If any method of @racket[gen:name] is not defined, then @racket[#f] is used
to signify that the structure type does not implement the particular
method. At least one method definition must be provided if this keyword
is used. A @racket[define/generic] form may appear in @racket[method-defs].
If the @racket[#:omit-define-syntaxes] option is supplied, then
@racket[id] is not bound as a transformer. If the
@racket[#:omit-define-values] option is supplied, then none of the

View File

@ -18,9 +18,8 @@ values. The following datatypes are all dictionaries:
@item{@techlink{lists} of @techlink{pairs} (an @deftech{association
list} using @racket[equal?] to compare keys); and}
@item{@techlink{structures} whose types implement the @racket[dict]
generic interface, with methods attached to the @racket[prop:dict]
struct property.}
@item{@techlink{structures} whose types implement the @racket[gen:dict]
@tech{generic interface}.}
]
@ -528,11 +527,9 @@ Returns a list of the associations from
(dict->list h)
]}
@deftogether[[
@defthing[gen:dict any/c]
@defthing[prop:dict struct-type-property?]]]{
@defthing[gen:dict any/c]{
A @tech{structure type property} (see @secref["structprops"]) that
A @tech{generic interface} (see @secref["struct-generics"]) that
supplies dictionary method implementations for a structure type.
To supply method implementations, the @racket[methods] form should be used.
The provided implementations are applied only to instances of the structure
@ -574,22 +571,20 @@ type. The following methods can be implemented:
@examples[#:eval dict-eval
(struct alist (v)
#:property prop:dict
(methods gen:dict
(define (dict-ref dict key
[default (lambda () (error "key not found" key))])
(cond [(assoc key (alist-v dict)) => cdr]
[else (if (procedure? default) (default) default)]))
(define (dict-set dict key val)
(alist (cons (cons key val) (alist-v dict))))
(define (dict-remove dict key)
(define al (alist-v dict))
(remove* (assoc key al) al))
(define (dict-count dict #:default [x #f])
(or x
(length (remove-duplicates (alist-v dict) #:key car))))
(code:comment "etc. other methods")
))
#:methods gen:dict
[(define (dict-ref dict key
[default (lambda () (error "key not found" key))])
(cond [(assoc key (alist-v dict)) => cdr]
[else (if (procedure? default) (default) default)]))
(define (dict-set dict key val)
(alist (cons (cons key val) (alist-v dict))))
(define (dict-remove dict key)
(define al (alist-v dict))
(remove* (assoc key al) al))
(define (dict-count dict #:default [x #f])
(or x
(length (remove-duplicates (alist-v dict) #:key car))))
(code:comment "etc. other methods")])
(define d1 '((1 . a) (2 . b)))
(dict? d1)
@ -598,6 +593,13 @@ type. The following methods can be implemented:
}
@defthing[prop:dict struct-type-property?]{
A deprecated structure type property used to define custom extensions
to the dictionary API. Use @racket[gen:dict] instead. Accepts a vector
of 10 procedures with the same arguments as the methods of
@racket[gen:dict].
}
@defthing[prop:dict/contract struct-type-property?]{
A structure type property for defining dictionaries with
@ -614,12 +616,13 @@ be a list of two immutable vectors:
_instance-iter-contract))
]
The first vector must be suitable as a value for @racket[prop:dict]
(in addition, it must be an immutable vector). The second vector must
contain six elements; each of the first three is a contract for the
dictionary type's keys, values, and positions, respectively. Each of
the second three is either @racket[#f] or a procedure used to extract
the contract from a dictionary instance.
The first vector must be a vector of 10 procedures which match the
@racket[gen:dict] @tech{generic interface} (in addition, it must be an
immutable vector). The second vector must contain six elements; each
of the first three is a contract for the dictionary type's keys,
values, and positions, respectively. Each of the second three is
either @racket[#f] or a procedure used to extract the contract from
a dictionary instance.
}
@deftogether[[

View File

@ -9,6 +9,12 @@
@defmodule[racket/generics]
A @deftech{generic interface} allows per-type methods to be
associated with generic functions. Generic functions are defined
using a @racket[define-generics] form. Method implementations for
a structure type are defined using the @racket[#:methods] keyword
(see @secref["define-struct"]).
@defform/subs[(define-generics (gen:name prop:name name?
[#:defined-table defined-table])
[method . kw-formals*]
@ -57,55 +63,18 @@ availability.
}
@defform[(generics gen:name
[method . kw-formals*]
...)
#:contracts
([gen:name identifier?]
[method identifier?])]{
Expands to
@racketblock[(define-generics (gen:name _prop:name _name?)
[method . kw-formals*]
...)]
where @racket[_prop:name] and @racket[_name?] are created with the lexical
context of @racket[gen:name].
}
@defform[(methods gen:name definition ...)
#:contracts
([gen:name identifier?])]{
@racket[gen:name] must be a transformer binding for the static information
about a new generic group.
Expands to a value usable as the property value for the structure type
property of the @racket[gen:name] generic group.
If the @racket[definition]s define the methods of @racket[gen:name], then
they are used in the property value.
If any method of @racket[gen:name] is not defined, then @racket[#f] is used
to signify that the structure type does not implement the particular
method.
Allows @racket[define/generic] to appear in @racket[definition ...].
}
@defform[(define/generic local-name method-name)
#:contracts
([local-name identifier?]
[method-name identifier?])]{
When used inside @racket[methods], binds @racket[local-name] to
When used inside the method definitions associated with the
@racket[#:methods] keyword, binds @racket[local-name] to
the generic for @racket[method-name]. This is useful for method
specializations to use the generic methods on other values.
Syntactically an error when used outside @racket[methods].
Syntactically an error when used outside the definitions associated
with @racket[#:methods].
}
@ -120,36 +89,34 @@ Syntactically an error when used outside @racket[methods].
@(define evaluator (new-evaluator))
@examples[#:eval evaluator
(define-generics (gen:printable prop:printable printable?)
(gen-print gen:printable [port])
(gen-port-print port gen:printable)
(gen-print* gen:printable [port] #:width width #:height [height]))
(define-generics (printable)
(gen-print printable [port])
(gen-port-print port printable)
(gen-print* printable [port] #:width width #:height [height]))
(define-struct num (v)
#:property prop:printable
(methods gen:printable
(define/generic super-print gen-print)
(define (gen-print n [port (current-output-port)])
(fprintf port "Num: ~a" (num-v n)))
(define (gen-port-print port n)
(super-print n port))
(define (gen-print* n [port (current-output-port)]
#:width w #:height [h 0])
(fprintf port "Num (~ax~a): ~a" w h (num-v n)))))
#:methods gen:printable
[(define/generic super-print gen-print)
(define (gen-print n [port (current-output-port)])
(fprintf port "Num: ~a" (num-v n)))
(define (gen-port-print port n)
(super-print n port))
(define (gen-print* n [port (current-output-port)]
#:width w #:height [h 0])
(fprintf port "Num (~ax~a): ~a" w h (num-v n)))])
(define-struct bool (v)
#:property prop:printable
(methods gen:printable
(define/generic super-print gen-print)
(define (gen-print b [port (current-output-port)])
(fprintf port "Bool: ~a"
(if (bool-v b) "Yes" "No")))
(define (gen-port-print port b)
(super-print b port))
(define (gen-print* b [port (current-output-port)]
#:width w #:height [h 0])
(fprintf port "Bool (~ax~a): ~a" w h
(if (bool-v b) "Yes" "No")))))
#:methods gen:printable
[(define/generic super-print gen-print)
(define (gen-print b [port (current-output-port)])
(fprintf port "Bool: ~a"
(if (bool-v b) "Yes" "No")))
(define (gen-port-print port b)
(super-print b port))
(define (gen-print* b [port (current-output-port)]
#:width w #:height [h 0])
(fprintf port "Bool (~ax~a): ~a" w h
(if (bool-v b) "Yes" "No")))])
(define x (make-num 10))
(gen-print x)

View File

@ -73,14 +73,14 @@ except that @racket[_k] by itself is not a @tech{stream}.
Custom sequences can be defined using structure type properties.
The easiest method to define a custom sequence is to use the
@racket[prop:stream] property and the @racket[gen:stream]
extension interface. Streams are a suitable abstraction for data
structures that are directly iterable. For example, a list is directly
iterable with @racket[first] and @racket[rest]. On the other hand,
vectors are not directly iterable: iteration has to go through an
index. For data structures that are not directly iterable, the
@deftech{iterator} for the data structure can be defined to be a
stream (e.g., a structure containing the index of a vector).
@racket[gen:stream] @tech{generic interface}. Streams are a suitable
abstraction for data structures that are directly iterable.
For example, a list is directly iterable with @racket[first] and
@racket[rest]. On the other hand, vectors are not directly
iterable: iteration has to go through an index. For data
structures that are not directly iterable, the @deftech{iterator}
for the data structure can be defined to be a stream
(e.g., a structure containing the index of a vector).
For example, unrolled linked lists (represented as a list of vectors)
themeselves do not fit the stream abstraction, but have index-based iterators
@ -88,23 +88,22 @@ that can be represented as streams:
@examples[#:eval stream-evaluator
(struct unrolled-list-iterator (idx lst)
#:property prop:stream
(methods gen:stream
(define (stream-empty? iter)
(define lst (unrolled-list-iterator-lst iter))
(or (null? lst)
(and (>= (unrolled-list-iterator-idx iter)
(vector-length (first lst)))
(null? (rest lst)))))
(define (stream-first iter)
(vector-ref (first (unrolled-list-iterator-lst iter))
(unrolled-list-iterator-idx iter)))
(define (stream-rest iter)
(define idx (unrolled-list-iterator-idx iter))
(define lst (unrolled-list-iterator-lst iter))
(if (>= idx (sub1 (vector-length (first lst))))
(unrolled-list-iterator 0 (rest lst))
(unrolled-list-iterator (add1 idx) lst)))))
#:methods gen:stream
[(define (stream-empty? iter)
(define lst (unrolled-list-iterator-lst iter))
(or (null? lst)
(and (>= (unrolled-list-iterator-idx iter)
(vector-length (first lst)))
(null? (rest lst)))))
(define (stream-first iter)
(vector-ref (first (unrolled-list-iterator-lst iter))
(unrolled-list-iterator-idx iter)))
(define (stream-rest iter)
(define idx (unrolled-list-iterator-idx iter))
(define lst (unrolled-list-iterator-lst iter))
(if (>= idx (sub1 (vector-length (first lst))))
(unrolled-list-iterator 0 (rest lst))
(unrolled-list-iterator (add1 idx) lst)))])
(define (make-unrolled-list-iterator ul)
(unrolled-list-iterator 0 (unrolled-list-lov ul)))
@ -775,16 +774,13 @@ A shorthand for nested @racket[stream-cons]es ending with
but with @racket[e] between each pair of elements in @racket[s].
The new stream is constructed lazily.}
@deftogether[[
@defthing[gen:stream any/c]
@defthing[prop:stream struct-type-property?]]]{
@defthing[gen:stream any/c]{
Associates three procedures to a structure type to implement stream
methods for instances of the stream generics.
Associates three methods to a structure type to implement the
@tech{generic interface} for streams.
To supply method implementations, the @racket[methods] form should be used.
The methods are applied only to instances of the structure type that has
the property value. The following three methods should be implemented:
To supply method implementations, the @racket[#:methods] keyword should be used.
The following three methods should be implemented:
@itemize[
@item{@racket[stream-empty?] : accepts one argument}
@ -794,20 +790,26 @@ A shorthand for nested @racket[stream-cons]es ending with
@examples[#:eval stream-evaluator
(define-struct list-stream (v)
#:property prop:stream
(methods gen:stream
(define (stream-empty? stream)
(empty? (list-stream-v stream)))
(define (stream-first stream)
(first (list-stream-v stream)))
(define (stream-rest stream)
(rest (list-stream-v stream)))))
#:methods gen:stream
[(define (stream-empty? stream)
(empty? (list-stream-v stream)))
(define (stream-first stream)
(first (list-stream-v stream)))
(define (stream-rest stream)
(rest (list-stream-v stream)))])
(define l1 (list-stream '(1 2)))
(stream? l1)
(stream-first l1)
]}
@defthing[prop:stream struct-type-property?]{
A deprecated structure type property used to define custom
extensions to the stream API. Use @racket[gen:stream] instead.
Accepts a vector of three procedures taking the same arguments
as the methods in @racket[gen:stream].
}
@; ======================================================================
@section{Generators}

View File

@ -2,14 +2,14 @@
(require racket/private/generics)
(define-generics (echoable prop:echo echo?
(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 echoable
#:methods gen:echoable
;; defined the "new" way
((define (echo x) (echo1-s x))))

View File

@ -2,13 +2,13 @@
(require racket/generics racket/port)
(define-generics (printable prop:printable printable?)
(define-generics (printable)
(gen-print printable [port])
(gen-port-print port printable)
(gen-print* printable [port] #:width width #:height [height]))
(define-struct num (v)
#:methods printable
#:methods gen:printable
[(define/generic super-print gen-print)
(define (gen-print n [port (current-output-port)])
(fprintf port "Num: ~a" (num-v n)))
@ -19,7 +19,7 @@
(fprintf port "Num (~ax~a): ~a" w h (num-v n)))])
(define-struct bool (v)
#:methods printable
#:methods gen:printable
[(define/generic super-print gen-print)
(define (gen-print b [port (current-output-port)])
(fprintf port "Bool: ~a"

View File

@ -31,7 +31,7 @@
(lambda (v) #t)
(lambda (t v) #t))))))))))
(define-generics (iterator prop:iterator iterator?
(define-generics (iterator gen:iterator prop:iterator iterator?
#:defined-table dummy
#:coerce-method-table #f
#:prop-defined-already? iterator-accessor)
@ -40,13 +40,13 @@
(iterator-continue? iterator))
(struct list-iterator (l)
#:methods iterator
#:methods gen:iterator
[(define (iterator-first x) (car (list-iterator-l x)))
(define (iterator-rest x) (list-iterator (cdr (list-iterator-l x))))
(define (iterator-continue? x) (not (null? (list-iterator-l x))))])
(struct vector-iterator (i v)
#:methods iterator
#:methods gen:iterator
[(define (iterator-first x) (vector-ref (vector-iterator-v x)
(vector-iterator-i x)))
(define (iterator-rest x) (vector-iterator (add1 (vector-iterator-i x))