[racket] Type-class-like idiom in Racket?

Helmut could get closer to generics and methods with some syntactic definitions: 

#lang racket/load 

(module generic racket 
  (provide defgeneric defmethod)
  
  (struct gen (name doc property pred? ref) 
          #:property prop:procedure
          (lambda (self other)
            (if ((gen-pred? self) other)
                (((gen-ref self) other) other)
                (error (gen-name self) "method not found: ~e" other))))
  
  (define-syntax-rule 
    (defgeneric name docs)
    (define name 
      (let-values ([(prop:name prop:name? prop:ref) (make-struct-type-property 'name)])
        (gen 'name docs prop:name prop:name? prop:ref))))
  
  (define-syntax (defmethod stx)
    (syntax-case stx ()
      [(_ name meth (field ...) f)
       #`(struct name (field ...) #:property (gen-property meth) f)])))

;; -----------------------------------------------------------------------------

(module client racket 
  (require 'generic)
  (defgeneric speak "hello world")
  
  (defmethod cat speak () (lambda (self) (displayln "Meow")))
  (defmethod dog speak () (lambda (self) (displayln "Whoof")))
  (defmethod man speak (name) (lambda (self) (displayln (man-name self))))
  
  (speak (cat))
  (speak (dog))
  (speak (man "Danny"))
  (speak 'rock))

(require 'client)





On Mar 4, 2012, at 5:33 PM, Danny Yoo wrote:

>> I see that Racket has generic functions, but they see to work a bit
>> differently that CLOS-style generics.  Further, like Haskell's type-classes
>> I would like to be able to provide a contract for functions that take a
>> Listable type:
> 
> 
> Racket provides a general mechanism to associate properties to
> structure types.  These structure type properties,
> 
>    http://docs.racket-lang.org/reference/structprops.html#(tech._structure._type._property)
> 
> allow a structure to define behavior in an extensible way.
> 
> For example,
> 
> 
> ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
> 
> #lang racket
> 
> ;; Define a protocol for speaking.
> (define-values (prop:speak prop:speak? prop:speak-ref)
>  (make-struct-type-property 'speak))
> 
> 
> (struct cat ()
>  #:property prop:speak (lambda (x) (printf "Meow\n")))
> 
> (struct bird ()
>  #:property prop:speak (lambda (x) (printf "Chirp\n")))
> 
> (struct person (name)
>  #:property prop:speak (lambda (x) (printf "Hi, I'm ~a\n" (person-name x))))
> 
> 
> (define (doolittle! entity)
>  (cond
>    [(prop:speak? entity)
>     (printf "~a says: " entity)
>     ((prop:speak-ref entity) entity)]
>    [else
>     (raise-type-error 'speak! "speaking animal" entity)]))
> 
> (doolittle! (cat))
> (doolittle! (bird))
> (doolittle! (person "Danny"))
> (doolittle! 'rock)
> 
> ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
> 
> 
> 
> In this way, we can define interfaces and implementation of those
> interfaces, without the need for class infrastructure.
> 
> ____________________
>  Racket Users list:
>  http://lists.racket-lang.org/users