[gnunet-scheme] branch master updated (785d738 -> c0951e2)

[gnunet]

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

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

    from 785d738  dht/client: Rewrite <insertion> in terms of cisw.
     new e7a78fa  records: Fix let-binding syntax in lambda*/define*.
     new ac3a942  records: Check for keywords correctly.
     new 7df580c  records: Use default values correctly.
     new 5aafa40  records: Correct calling convention for constructor.
     new 23f95e1  dht/client: Fix typo in <insertion> field name.
     new bcfd4f3  records: Correct constructor->constructor*.
     new c0951e2  dht/client: Use #:constructor-keyword-arguments instead of 
wrapping.

The 7 revisions listed above as "new" are entirely new to this
repository and will be described in separate emails.  The revisions
listed as "add" were already present in the repository and have only
been added to this reference.


Summary of changes:
 gnu/gnunet/dht/client.scm    | 27 +++++++++++-------------
 gnu/gnunet/utils/records.scm | 49 +++++++++++++++++++++++++++++++++++---------
 2 files changed, 51 insertions(+), 25 deletions(-)

diff --git a/gnu/gnunet/dht/client.scm b/gnu/gnunet/dht/client.scm
index 1b86d6d..789dc97 100644
--- a/gnu/gnunet/dht/client.scm
+++ b/gnu/gnunet/dht/client.scm
@@ -271,31 +271,28 @@ the constructor."
       #:copy (copy-insertion
              "Make a copy of the insertion, such that modifications to the
 slices in the old insertion do not impact the new insertion.")
-      #:constructor/copy %make-insertion
-      #:constructor %make-insertion/share
+      #:constructor/copy make-insertion
+      #:constructor (make-insertion/share
+                    "Make an insertion object for inserting the datum 
@var{datum},
+desiring a replication level @var{desired-replication-level} (see ??).
+
+Insertions are cisw (?) ojects and as such the procedures
+@code{insertion->datum}, @code{insertion-desired-replication-level},
+@code{insertion?}, @code{make-insertion}, @code{make-insertion/share}
+and @code{insertion=?} have the usual semantics.")
+      ;; TODO defaults
+      #:constructor-keyword-arguments (datum #:key (desired-replication-level 
3))
       #:equality insertion=?
       #:field (datum #:copy copy-datum
                     #:equality datum=?
                     #:getter insertion->datum
                     #:preprocess validate-datum)
-      #:field (desired-replication-leval
+      #:field (desired-replication-level
               #:copy identity
               #:equality =
               #:getter insertion-desired-replication-level
               #:preprocess bound-replication-level))
 
-    (define* (make-insertion datum #:key (desired-replication-level 3)) ; TODO 
defaults
-      "Make an insertion object for inserting the datum @var{datum},
-desiring a replication level @var{desired-replication-level} (see ??).
-
-Insertions are cisw (?) ojects and as such the procedures
-@code{insertion->datum}, @code{insertion-desired-replication-level},
-@code{insertion?}, @code{make-insertion}, @code{make-insertion/share}
-and @code{insertion=?} have the usual semantics."
-      (%make-insertion datum desired-replication-level))
-    (define* (make-insertion/share datum #:key (desired-replication-level 3))
-      (%make-insertion/share datum desired-replication-level))
-
     (define-record-type (<query> make-query query?)
       (fields (immutable type query-type)
              (immutable key query-key)
diff --git a/gnu/gnunet/utils/records.scm b/gnu/gnunet/utils/records.scm
index 0935efb..2948acf 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
@@ -165,7 +166,7 @@
                     (bindings #'()))
            (syntax-case s ()
              ((keyword . rest)
-              (keyword? #'keyword)
+              (keyword? (syntax->datum #'keyword))
               #`(keyword . #,(loop #'rest bindings)))
              ((i . rest)
               (identifier? #'i)
@@ -174,16 +175,42 @@
              (i ; (... . var)
               (identifier? #'i)
               (replacement #'i))
-             (((i . value) . rest)
+             (((i value) . rest)
               ;; 'value' can refer to previous arguments, so add some
               ;; 'let' bindings to correct for the renaming.  (Untested;
               ;; there are no users of this at time of writing.)
               (let ((j (replacement #'i)))
-                #`((#,j (let #,@bindings value))
+                #`((#,j (let #,bindings value))
                    . #,(loop #'rest #`(#,@bindings (i #,j))))))
              (() 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*
+                               #,@(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.