[plt-scheme] Structure design, Immutable vs Mutable

If you have all classes under control -- your control -- this is  
acceptable. -- Matthias


On Oct 1, 2007, at 1:24 AM, Henk Boom wrote:

> 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