[gnunet-scheme] 03/08: utils/records: Support copying when #:read-only-slice-wrapper=#false.

[gnunet]

This is an automated email from the git hooks/post-receive script.

maxime-devos pushed a commit to branch master
in repository gnunet-scheme.

commit 1844a2430f3a45de1237030365b0fe3e79033a61
Author: Maxime Devos <maximedevos@telenet.be>
AuthorDate: Wed Feb 8 15:57:15 2023 +0100

    utils/records: Support copying when #:read-only-slice-wrapper=#false.
    
    * gnu/gnunet/utils/records.scm (preprocess): Support more cases.
---
 gnu/gnunet/utils/records.scm | 34 ++++++++++++++++++++--------------
 1 file changed, 20 insertions(+), 14 deletions(-)

diff --git a/gnu/gnunet/utils/records.scm b/gnu/gnunet/utils/records.scm
index 590f308..b2f0b03 100644
--- a/gnu/gnunet/utils/records.scm
+++ b/gnu/gnunet/utils/records.scm
@@ -131,6 +131,8 @@
        (if (field-set field #:preprocess)
            #`(#,(field-ref field #:preprocess) #,(field-name field))
            (field-name field)))
+      (define (field-copy field object)
+       #`(#,(field-ref field #:copy) (#,(field-ref field #:getter) #,object)))
       #`(begin
          (define-record-type (#,<type> #,constructor* #,type?)
            (fields #,@(map field-clause fields*))
@@ -155,22 +157,26 @@
                       #,@(map field->analyse-fragment fields*)))))
          #,@(if (eq? copy* unset)
                 #'()
-                ;; Note: support for read-only-slice-wrapper = unset can be
-                ;; implemented if needed with some work.
-                (begin
-                  (assert (eq? #true (syntax->datum read-only-slice-wrapper)))
-                  #`((define (#,copy* slice)
-                      (#,constructor*
-                       (slice-copy/read-only
-                        (#,(field-ref (car fields*) #:getter) slice)))))))
+                ;; When possible, avoid having to define a #:copy
+                ;; procedure and sort-of 'batch' allocations a bit.
+                (syntax-case read-only-slice-wrapper ()
+                  (#true
+                   #`((define (#,copy* slice)
+                        (#,constructor*
+                         (slice-copy/read-only
+                          (#,(field-ref (car fields*) #:getter) slice))))))
+                  ;; If not, just copy fields one-by-one.
+                  (#false
+                   #`((define (#,copy* object)
+                        (#,constructor
+                         #,@(map (lambda (f) (field-copy f #'object))
+                                 fields*)))))))
          #,@(if (eq? constructor/copy* unset)
                 #'()
-                ;; Note: likewise.
-                (begin
-                  (assert (eq? #true (syntax->datum read-only-slice-wrapper)))
-                  #`((define (#,constructor/copy* object)
-                       #,constructor/copy-docstring
-                       (#,copy* (#,constructor* object))))))))
+                #`((define (#,constructor/copy* #,@(map field-name fields*))
+                     #,constructor/copy-docstring
+                     (#,copy* (#,constructor*
+                               #,@(map field-name fields*))))))))
 
     (define (field-ref field keyword)
       (match (assoc keyword (cdr field))

-- 
To stop receiving notification emails like this one, please contact
gnunet@gnunet.org.