Re: [Chicken-users] tinyclos - how to copy an object?

[Shawn Rutledge]

On 9/20/07, Kon Lovett <address@hidden> wrote:
>
> On Sep 19, 2007, at 11:40 PM, Shawn Rutledge wrote:
>
> > Is there a generic way to copy an object already?  (Make another
> > instance with the same slots)  Or is it necessary to write such a
> > function using introspection?
>
> (define copy-object (make-generic "copy-object"))
>
> (add-method copy-object
>    (make-method (list <object>)
>      (lambda (call-next-method x . initargs)
>        (let ([class (class-of x)])
>          (apply make class
>                      (let ([inited-slot?
>                              (lambda (nam)
>                                (let loop ([flag #t] [prplst initargs])
>                                  (and (pair? prplst)
>                                       (or (and flag (equal? nam (car
> prplst)))
>                                           (loop (not flag) (cdr
> prplst)) ) ) ) )])
>                        (for-each
>                          (lambda (s)
>                            (let ([nam (car s)])
>                              (unless (inited-slot? nam)
>                                (set! initargs (cons nam (cons (slot-
> ref x nam) initargs))) ) ) )
>                          (class-slots class))
>                        initargs ) ) ) ) ) )
>

Yeah I wrote one too:

(define (copy o)
        (let*
                (
                        [class (class-of o)]
                        [slots (class-slots class)]
                        [thevoid (void)]
                )
                ; (printf "copying object of ~s~%" class)
                (apply make  (cons class
                        (let loop ([args '()][rem slots])
                                (if (null? rem)
                                        (reverse args)
                                        (let*
                                                (
                                                        [slot-name (caar rem)]
                                                        [val (-> o slot-name)]
                                                )
                                                (if (eq? thevoid val)
                                                        (loop args (cdr rem))
                                                        (loop (cons val (cons 
(caar rem) args)) (cdr rem) )))))))))

(apply) is inefficient, isn't it?  I saw a trick once to get rid of
it, but forgot what it was.

Well I would think something like this would be a nice addition to the egg.