[plt-scheme] Structure design, Immutable vs Mutable

On 28/09/2007, Henk Boom <lunarc.lists at gmail.com> wrote:
> The following seems to work, but I don't know
> enough about inspectors to know if it's a good idea or not.

I've got a nicer implementation now which doesn't rely on transparent classes.

----
(module copyable-class mzscheme
  (require (lib "class.ss"))

  (provide copyable-class
           copyable-class*
           copyable?
           copy)

  (define-local-member-name get-class)

  ;; Used to easily distinguish copyable objects from other objects
  (define copyable<%> (interface () get-class))

  (define-syntax copyable-class
    (syntax-rules ()
      ((copyable-class super class-exp ...)
       (copyable-class* super () class-exp ...))))

  (define-syntax copyable-class*
    (syntax-rules ()
      ((copyable-class* super (interface ...) class-exp ...)
       (let ()
         (define new-class
           (class* (make-copyable super) (interface ...)
             (init (copy-from #f))
             (define/override (get-class) new-class)
             (transform copy-from class-exp) ...))
         new-class))))

  (define-syntax transform
    (syntax-rules (data inspect super-new)
      ;; new copyable data clause
      ((transform copy-from (data (name default-value) ...))
       (init-field (name (if copy-from
                           (get-field name copy-from)
                           default-value)) ...))
      ;; change super-new to pass up the copy-from variable
      ((transform copy-from (super-new arg ...))
       (super-new (copy-from copy-from) arg ...))
      ;; handle begin groups
      ((transform copy-from (begin class-expr ...))
       (begin (transform copy-from class-expr) ...))
      ;; pass-through the rest
      ((transform copy-from class-exp)
       class-exp)))

  (define (copyable? x)
    (cond
      ((class? x) (implementation? x copyable<%>))
      ((object? x) (is-a? x copyable<%>))
      (else #f)))

  (define (make-copyable c)
    (if (copyable? c)
      c
      (let ()
        (define new-class
          (class* c (copyable<%>)
            (init (copy-from #f))
            (define/public (get-class) c)
            (super-new)))
        new-class)))

  (define-syntax copy
    (syntax-rules ()
      ((copy object (field value) ...)
       (new (send object get-class)
         (copy-from object)
         (field value) ...))))

  ) ;; end module
----

Here is a demo:

----
(module test mzscheme
  (require (lib "class.ss"))
  (require "copyable-class.ss")

  (define body%
    (copyable-class object%
      (data (position (list 0 0)))
      (super-new)))

  (define player%
    (copyable-class body%
      (data (orientation 0))
      (super-new)))

  (define player (new player% (orientation 90)))
  (define player2 (copy player (position '(1 2))))

  (printf "player: position=~a, orientation=~a~n"
          (get-field position player)
          (get-field orientation player))
  (printf "player2: position=~a, orientation=~a~n"
          (get-field position player2)
          (get-field orientation player2))
  (printf "~a~n" player)

  ) ;; end module
----

This outputs:
player: position=(0 0), orientation=90
player2: position=(1 2), orientation=90
#(struct:object:new-class ...)

This illustrates one problem, though, which is that every class
generated with copyable-class has a name of new-class when printed and
in error messages. I can see that this must be inferred somehow from
the (define new-class ...) in the macro (I've no idea how that is made
to work). Is there a way to pass this inference out onto the macro's
context instead, so that the above output gives
#(struct:object:player% ...) instead?

    Henk Boom