[gnunet-scheme] 04/07: records: Correct calling convention for constructor.

[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 5aafa40a799fcc1510d765f8200e0e99fa6924ee
Author: Maxime Devos <maximedevos@telenet.be>
AuthorDate: Sat Mar 4 02:13:22 2023 +0100

    records: Correct calling convention for constructor.
    
    Oops another bug ...
    
    The constructor now sometimes expects keyword arguments!
    
    * gnu/gnunet/utils/records.scm
    (process)[keywordify]: New procedure.
    (process)[copy*]: Use it, and add a TODO about apparent bug.
    (process)[constructor/copy*]: Use it.
---
 gnu/gnunet/utils/records.scm | 43 ++++++++++++++++++++++++++++++++++++-------
 1 file changed, 36 insertions(+), 7 deletions(-)

diff --git a/gnu/gnunet/utils/records.scm b/gnu/gnunet/utils/records.scm
index fc001e1..d7fc8a1 100644
--- a/gnu/gnunet/utils/records.scm
+++ b/gnu/gnunet/utils/records.scm
@@ -19,13 +19,14 @@
   (export define-record-type*)
   ;; keyword? cannot be used from (srfi srfi-88) because that sets
   ;; a reader option.
-  (import (only (guile) define* lambda* keyword? error define-values pk 
syntax-error)
+  (import (only (guile) define* lambda* keyword? error define-values pk 
syntax-error
+               symbol->keyword)
          (only (ice-9 match) match)
          (only (rnrs base)
                begin define lambda define-syntax cons quasiquote quote unquote
                unquote-splicing apply reverse append null? eq? and not if
                string? values map assert car cdr cadr cddr let or pair?
-               => let* length)
+               => let* length list)
          (only (rnrs control) when unless)
          (only (rnrs syntax-case)
                syntax quasisyntax unsyntax unsyntax-splicing syntax-case
@@ -184,6 +185,32 @@
              (() s)
              (_ (pk s)
                 (error "invalid keyword argument syntax in constructor"))))))
+      (define (keywordify positional-arguments keyword-signature)
+       (define (keywordify* positional-arguments keyword-signature positional?)
+         (define (something id rest)
+           (assert (identifier? id))
+           (assert (pair? positional-arguments))
+           #`(#,@(if positional?
+                     #'()
+                     #`(#,(datum->syntax #f (symbol->keyword (syntax->datum 
id)))))
+              #,(car positional-arguments)
+              . #,(keywordify* (cdr positional-arguments)
+                               rest
+                               positional?)))
+         (syntax-case keyword-signature ()
+           ((#:rest _) ; untested
+            (begin
+              (assert (= (length positional-arguments) 1))
+              #`(#,(car positional-arguments))))
+           ((#:allow-other-keys . r)
+            (keywordify* positional-arguments #'r positional?))
+           ((#:key . r)
+            (keywordify* positional-arguments #'r #false))
+           (((i default) . r) (something #'i #'r))
+           ((i . r)
+            (something #'i #'r))
+           (() #'((list)))))
+       (keywordify* positional-arguments keyword-signature #true))
       (define (preprocess-arguments body)
        ;; First, use field-names/different as constructor arguments.
        ;; Otherwise, the preprocessors might accidentally use an
@@ -238,15 +265,17 @@
                   ;; If not, just copy fields one-by-one.
                   (#false
                    #`((define (#,copy* object)
-                        (#,constructor
-                         #,@(map (lambda (f) (field-copy f #'object))
-                                 fields*)))))))
+                        (apply #,constructor ; TODO: why not constructor*?
+                               #,@(keywordify (map (lambda (f) (field-copy f 
#'object))
+                                                   fields*)
+                                              
constructor-keyword-arguments*/different)))))))
          #,@(if (eq? constructor/copy* unset)
                 #'()
                 #`((define* (#,constructor/copy* 
#,@constructor-keyword-arguments*)
                      #,constructor/copy-docstring
-                     (#,copy* (#,constructor* ; <--- FIX
-                               #,@(map field-name fields*))))))))
+                     (#,copy* (apply #,constructor*
+                                     #,@(keywordify (map field-name fields*)
+                                                    
constructor-keyword-arguments*/different))))))))
 
     (define (field-ref field keyword)
       (match (assoc keyword (cdr field))

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