[racket] help: how to define serializable classes with contracts attached

From: Christopher (ultimatemacfanatic at gmail.com)
Date: Wed Aug 21 12:07:47 EDT 2013

Thank you to Asumu Takikawa for giving me some ideas for how to solve the problem.

After thinking over Asumu's ideas, I synthesized a new solution based upon Asumu's feedback, that seemed more concise yet still general-purpose in more familiar syntax.

In case it is useful to anyone else, here is what I came up with.


;; macro to define serializable class with an attached contract in one s-expression like define/contract
;; usage:
;; (define-serializable-class/contract contract-expr class-decl)
;; 	class-decl = (class class-id superclass-expr class-clause ...)
;;	           | (class* class-id superclass-expr [interface-expr ...] class-clause ...)
;;      ; (class and class* are literal symbols)

(provide define-serializable-class/contract)
(define-syntax [define-serializable-class/contract stx]
  (syntax-case stx []
    [[_ cls-name cls-contract cls-expr]
         #,(syntax-case #'cls-expr [class class*]
             [[class super-cls clause ...]
              #'(define-serializable-class cls-name 
                                           clause ... )]
             [[class* super-cls [interface ...] clause ...]
              #'(define-serializable-class* cls-name
                                            [interface ...]
                                            clause ... )])
         (set! cls-name
               (contract cls-contract
                         '(definition cls-name)
                         current-contract-region )))])) ; identifier macro

;; example:

(define-serializable-class/contract my-class%
    (init-field [name string?])
    [say-hello (->m string? void?)] )
  (class object%
    (init-field name)
    (define/public [say-hello to-whom]
      {printf "~a says hello to ~a." name to-whom} )))

(send (new my-class% [name "Bill"]) say-hello "Sally"))

Posted on the users mailing list.