Generic record copy

I've found a tweet that says R7RS define-record-type doesn't create copier (or copy constructor) by default. Well, I can imagine why it doesn't if I think of C++'s copy constructor (which I think very confusing and causing unexpected behaviour). And it's also context dependent what exactly copy means.

Now, if I just say like this, then it's not so fun. So let's write kind of generic copy procedure. Before that, here our definition of copy is deep copy. So it creates a new object without having the same object inside. So more like cloning.

Preparation

If it's generic, then it should work also builtin types. Generally, Scheme chose to have distinct procedures per types and what we want is one generic procedure. The very simple strategy would be dispatching. It might be convenient if users can specify how copy works per types. So the interface of copy procedure would look like this:

(define *copier-table* '())

(define (generic-copy obj)
  (cond ((assoc obj *copier-table* (lambda (x p) (p x))) =>
         (lambda (s) ((cdr s) obj)))
        ;; shallow copy, sort of
        (else obj)))

(define (register-copier! pred copier)
  (set! *copier-table* (cons (cons pred copier) *copier-table*)))

To register built-in types, we can do like this:

(register-copier! pair? list-copy)
(register-copier! vector? vector-copy)
(register-copier! string? string-copy)
(register-copier! bytevector? bytevector-copy)

Now, we have generic copy procedure for built-in types.

NB: list-copy and vector-copy doesn't consider the elements of copying object. If you want to follow the definition of copy here, you need to create own copy procedure.

Syntax

You know how define-record-type works, right? It needs to be fed name of constructors, predicate procedures. So doing the same for copy procedure. Let's call our brand new record definition syntax define-record-type/copy. It would look like this:

(define-record-type/copy pare (kons a d) pare? pare-copy
   (a kar)
   (d kdr))

The extra argument pare-copy is the procedure automatically generated by the macro.

Implementation strategy

Now, how can we implement it? The strategy I chose (and probably this is the only way to do it portably) is that:

• Collect field value and order it by constructor tag
• Create object by passing above value with specified constructor
• Set field values of fields which are not listed on constructor

So my implementation is like this:

(define-syntax define-record-copier
  (syntax-rules ()
    ((define-record-copier "emit" name (ctr f ...) (acc ...) ((a m) ...))
     ;; now we have all information
     (define (name obj)
       (let ((c (ctr (acc obj) ...)))
         ;; mutate if mutators are defined, then we use it.
         ;; to make it simple, we do for all mutator. so some
         ;; of them are just useless.
         ;; FIXME this is not efficient.
         (m c (a obj)) ...
         c)))
    ((_ "mutator" name ctr accessor mutator ())
     (define-record-copier "emit" name ctr accessor mutator))
    ((_ "mutator" name ctr accessor (mutator* ...) ((f a) rest ...))
     (define-record-copier "mutator" name ctr accessor
       (mutator* ...) (rest ...)))
    ((_ "mutator" name ctr accessor (mutator* ...) ((f a m) rest ...))
     (define-record-copier "mutator" name ctr accessor
       (mutator* ... (a m)) (rest ...)))
    ((_ "collect" name ctr (acc ...) () (def* ...))
     (define-record-copier "mutator" name ctr (acc ...) ()(def* ...)))
    ((_ "collect" name ctr (acc ...) (field field* ...) (def* ...))
     (begin
       ;; this part is not R7RS portable since 'foo' doesn't have to be
       ;; renamed (right?). so some of implementation may raise an error
       ;; of redefinition (e.g. Foment)
       ;; however we can't use letrec-syntax because it creates a scope.
       ;; sucks...
       (define-syntax foo
         (syntax-rules (field)
           ((_ ?n ?c
               ((field ac . ignore) rest (... ...))
               (next (... ...))
               (src  (... ...)))
            (define-record-copier "collect" ?n ?c (acc ... ac)
              (next (... ...)) (src (... ...))))
           ((_ ?n ?c (_ rest (... ...)) (next (... ...)) (src (... ...)))
            (foo ?n ?c (rest (... ...)) (next (... ...)) (src (... ...))))))
       (foo name ctr (def* ...) (field* ...) (def* ...))))
    ((_ name ctr (ctr-field* ...) (field-def* ...))
     (define-record-copier "collect" name ctr
       () ;; accessor
       (ctr-field* ...)
       (field-def* ...)))))

(define-syntax define-record-type/copy
  (syntax-rules ()
    ((_ name (ctr field* ...) pred copier field-def* ...)
     (begin
       (define-record-type name (ctr field* ...) pred
         field-def* ...)
       (define-record-copier copier (ctr field* ...)
         (field* ...) (field-def* ...))))))

I usually use letrec-syntax to detect free identifier (well, it should be bound identifier but I don't think there's no way to do it in range of R7RS). But needed to use define-syntax (see comment).

Then you can use it like this:

(define-record-type/copy pare (kons a d) pare? pare-copy
   (a kar)
   (d kdr)
   (s pare-src pare-src-set!))

(register-copier! pare? pare-copy)
(let ((p (kons 'a 'b)))
  (pare-src-set! p '(src))
  (let ((c (generic-copy p)))
    (print (kar c))
    (print (kdr c))
    (print (pare-src c))))

(Write your own print procedure :P). The implementation is not efficient since we call mutator procedure no matter what. To make it efficient, you need to get mutators of which are not listed on constructor tags.

The whole scripts are here:

Conclusion

Use R6RS or SRFI-99.