[plt-scheme] struct copy with optional arguments

From: Jon Rafkind (workmin at ccs.neu.edu)
Date: Thu Apr 3 00:30:14 EDT 2008

I implemented a short macro to generate a function that copies a struct 
and optionally replaces some values with arguments to the function. I 
got tired of manually extracting the values from a struct just to update 
1 field so I was guessing maybe other people were too.

(require (lib "kw.ss"))

(define-syntax (define-struct/copy stx)
  (syntax-case stx ()
    ((_ name (field ...))
     (let ((name-string (symbol->string
                          (syntax-object->datum #'name))))
       (define (substitute-name s)
             (format s name-string))))
       (with-syntax ((copy (substitute-name "copy-~a"))
                     (make (substitute-name "make-~a"))
                     (name? (substitute-name "~a?"))
                     ((field-access ...)
                      (map (lambda (f)
                                 (format "~a-~a"
                                           (syntax-object->datum f))))))
                           (syntax->list #'(field ...))))
                     ((new-field ...) (generate-temporaries
                                        (syntax->list #'(field ...)))))
             (define-struct name (field ...))
             (define null (lambda () (void)))
             (define/kw (copy obj #:key (field null) ...)
                        (let ((new-field (if (eqv? field null)
                                           (field-access obj)
                          (make new-field ...)))))))))

(define-struct/copy foo (x y z))
(define n (make-foo 1 2 3))
(printf "~a ~a ~a\n" (foo-x n) (foo-y n) (foo-z n)) ;; 1 2 3
(define n1 (copy-foo n #:x 9))
(printf "~a ~a ~a\n" (foo-x n1) (foo-y n1) (foo-z n1)) ;; 9 2 3
(define n2 (copy-foo n #:z 9 #:y 4))
(printf "~a ~a ~a\n" (foo-x n2) (foo-y n2) (foo-z n2)) ;; 1 4 9

Obviously it doesn't handle super types.. but I rarely use them anyway. 
I found the copy-struct module from David Van Horn which is pretty 
close, but slightly more verbose( in usage ).

..BTW it would have been cool if I could have done
  (define/kw (copy obj #:key (field (field-accessor obj)) ...)

instead of adding that ugly if. Can kw support something like that?

Posted on the users mailing list.