diff --git a/collects/scheme/class.ss b/collects/scheme/class.ss index 81915d0195..3375685b7a 100644 --- a/collects/scheme/class.ss +++ b/collects/scheme/class.ss @@ -7,5 +7,5 @@ ;; which provides extra (private) functionality to contract.ss. (require "private/class-internal.ss") - (provide-public-names)) - + (provide-public-names) + (provide generic?)) diff --git a/collects/scheme/private/class-internal.ss b/collects/scheme/private/class-internal.ss index debc069284..c6abc7248f 100644 --- a/collects/scheme/private/class-internal.ss +++ b/collects/scheme/private/class-internal.ss @@ -24,45 +24,45 @@ (provide provide-public-names ;; needed for Typed Scheme (protect-out do-make-object find-method/who)) - (define-syntax (provide-public-names stx) - #'(provide class class* class/derived - define-serializable-class define-serializable-class* - class? - mixin - interface interface? - object% object? externalizable<%> - object=? - new make-object instantiate - send send/apply send* class-field-accessor class-field-mutator with-method - get-field field-bound? field-names - private* public* pubment* - override* overment* - augride* augment* - public-final* override-final* augment-final* - define/private define/public define/pubment - define/override define/overment - define/augride define/augment - define/public-final define/override-final define/augment-final - define-local-member-name define-member-name - member-name-key generate-member-key - member-name-key? member-name-key=? member-name-key-hash-code - generic make-generic send-generic - is-a? subclass? implementation? interface-extension? - object-interface object-info object->vector - object-method-arity-includes? - method-in-interface? interface->method-names class->interface class-info - (struct-out exn:fail:object) - make-primitive-class - - ;; "keywords": - private public override augment - pubment overment augride - public-final override-final augment-final - field init init-field init-rest - rename-super rename-inner inherit inherit/super inherit/inner inherit-field - this super inner - super-make-object super-instantiate super-new - inspect)) + (define-syntax-rule (provide-public-names) + (provide class class* class/derived + define-serializable-class define-serializable-class* + class? + mixin + interface interface? + object% object? externalizable<%> + object=? + new make-object instantiate + send send/apply send* class-field-accessor class-field-mutator with-method + get-field field-bound? field-names + private* public* pubment* + override* overment* + augride* augment* + public-final* override-final* augment-final* + define/private define/public define/pubment + define/override define/overment + define/augride define/augment + define/public-final define/override-final define/augment-final + define-local-member-name define-member-name + member-name-key generate-member-key + member-name-key? member-name-key=? member-name-key-hash-code + generic make-generic send-generic + is-a? subclass? implementation? interface-extension? + object-interface object-info object->vector + object-method-arity-includes? + method-in-interface? interface->method-names class->interface class-info + (struct-out exn:fail:object) + make-primitive-class + + ;; "keywords": + private public override augment + pubment overment augride + public-final override-final augment-final + field init init-field init-rest + rename-super rename-inner inherit inherit/super inherit/inner inherit-field + this super inner + super-make-object super-instantiate super-new + inspect)) ;;-------------------------------------------------------------------- @@ -3678,7 +3678,7 @@ define/public-final define/override-final define/augment-final define-local-member-name define-member-name member-name-key generate-member-key member-name-key? member-name-key=? member-name-key-hash-code - (rename-out [generic/form generic]) (rename-out [make-generic/proc make-generic]) send-generic + (rename-out [generic/form generic]) (rename-out [make-generic/proc make-generic]) send-generic generic? is-a? subclass? implementation? interface-extension? object-interface object-info object->vector object-method-arity-includes? diff --git a/collects/scribblings/reference/class.scrbl b/collects/scribblings/reference/class.scrbl index 75b716f5c6..686decf57a 100644 --- a/collects/scribblings/reference/class.scrbl +++ b/collects/scribblings/reference/class.scrbl @@ -1136,6 +1136,13 @@ If @scheme[obj-expr] does not produce a object, or if not an instance of the class or interface encapsulated by the result of @scheme[generic-expr], the @exnraise[exn:fail:object].} +@defproc[(make-generic [type (or/c class? interface?)] + [method-name symbol?]) + generic?]{ + +Like the @scheme[generic] form, but as a procedure that accepts a +symbolic method name.} + @; ------------------------------------------------------------------------ @section[#:tag "mixins"]{Mixins} @@ -1544,6 +1551,11 @@ Returns @scheme[#t] if @scheme[v] is a class, @scheme[#f] otherwise.} Returns @scheme[#t] if @scheme[v] is an interface, @scheme[#f] otherwise.} +@defproc[(generic? [v any/c]) boolean?]{ + +Returns @scheme[#t] if @scheme[v] is a @tech{generic}, @scheme[#f] otherwise.} + + @defproc[(object=? [a object?][b object?]) eq?]{ Determines if two objects are the same object, or not; this procedure uses