[gnunet-scheme] 01/03: Make uses of 'set%!' less verbose.

[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 81447e9b38e3dbee59709d71c0b571be13bfd4f9
Author: Maxime Devos <maximedevos@telenet.be>
AuthorDate: Fri Feb 11 14:59:38 2022 +0000

    Make uses of 'set%!' less verbose.
    
    * gnu/gnunet/utils/cut-syntax.scm: New module.
    * Makefile.am: Add it.
    * gnu/gnunet/dht/client.scm: Use it.
    * tests/mq.scm: Likewise.
    * tests/network-size.scm: Likewise.
---
 Makefile.am                     |  1 +
 gnu/gnunet/dht/client.scm       | 66 ++++++++++++++++++++---------------------
 gnu/gnunet/utils/cut-syntax.scm | 38 ++++++++++++++++++++++++
 tests/mq.scm                    | 26 ++++++++--------
 tests/network-size.scm          | 21 +++++++------
 5 files changed, 96 insertions(+), 56 deletions(-)

diff --git a/Makefile.am b/Makefile.am
index b42b6cc..dc4b207 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -60,6 +60,7 @@ modules = \
   \
   gnu/gnunet/utils/bv-slice.scm \
   gnu/gnunet/utils/hat-let.scm \
+  gnu/gnunet/utils/cut-syntax.scm \
   gnu/gnunet/utils/netstruct.scm \
   gnu/gnunet/utils/platform-enum.scm \
   gnu/gnunet/utils/tokeniser.scm \
diff --git a/gnu/gnunet/dht/client.scm b/gnu/gnunet/dht/client.scm
index 95aedc8..12bd9d7 100644
--- a/gnu/gnunet/dht/client.scm
+++ b/gnu/gnunet/dht/client.scm
@@ -103,11 +103,13 @@
                slice-length slice/read-only make-slice/read-write slice-copy!
                slice-slice verify-slice-readable)
          (gnu gnunet utils hat-let)
+         (only (gnu gnunet utils cut-syntax)
+               cut-syntax)
          (only (rnrs base)
                and >= = quote * / + - define begin ... let*
                quote case else values apply let cond if >
                <= expt assert exact? integer? lambda for-each
-               not expt min max div-and-mod positive?)
+               not expt min max div-and-mod positive? define-syntax)
          (only (rnrs control)
                unless when)
          (only (rnrs records syntactic)
@@ -399,15 +401,16 @@ slices in @var{old} do not impact the new search result."
       "Create a new @code{/:msg:dht:client:get} message for the query object
  @var{query}, with @var{unique-id} as ‘unique id’ and @var{options} as 
options."
       (define s (make-slice/read-write (sizeof /:msg:dht:client:get '())))
-      (set%! /:msg:dht:client:get '(header size) s (slice-length s))
-      (set%! /:msg:dht:client:get '(header type) s
-            (value->index (symbol-value message-type msg:dht:client:get)))
-      (set%! /:msg:dht:client:get '(options) s options)
-      (set%! /:msg:dht:client:get '(desired-replication-level) s
-            (query-desired-replication-level query))
-      (set%! /:msg:dht:client:get '(type) s (query-type query))
+      (define-syntax set%!/get (cut-syntax set%! /:msg:dht:client:get <> s <>))
+      (set%!/get '(header size) (slice-length s))
+      (set%!/get '(header type)
+                (value->index (symbol-value message-type msg:dht:client:get)))
+      (set%!/get '(options) options)
+      (set%!/get '(desired-replication-level)
+                (query-desired-replication-level query))
+      (set%!/get '(type) (query-type query))
       (slice-copy! (query-key query) (select /:msg:dht:client:get '(key) s))
-      (set%! /:msg:dht:client:get '(unique-id) s unique-id)
+      (set%!/get '(unique-id) unique-id)
       s)
 
     (define* (construct-client-put insertion #:optional (options 0))
@@ -421,17 +424,17 @@ object insertion with @var{options} as options."
         (+ size/header (slice-length (datum-value datum)))))
       (define header (slice-slice message 0 size/header))
       (define rest (slice-slice message size/header))
-      (set%! /:msg:dht:client:put '(header type) header
-            (value->index (symbol-value message-type msg:dht:client:put)))
-      (set%! /:msg:dht:client:put '(header size) header size)
-      (set%! /:msg:dht:client:put '(type) header (datum-type datum))
-      (set%! /:msg:dht:client:put '(option) header options)
-      (set%! /:msg:dht:client:put '(desired-replication-level) header
-            (insertion-desired-replication-level insertion))
-      (set%! /:msg:dht:client:put '(expiration) header (datum-expiration 
datum))
+      (define-syntax set%!/put (cut-syntax set%! /:msg:dht:client:put <> 
header <>))
+      (set%!/put '(header type)
+                (value->index (symbol-value message-type msg:dht:client:put)))
+      (set%!/put '(header size) size)
+      (set%!/put '(type) (datum-type datum))
+      (set%!/put '(option) options)
+      (set%!/put '(desired-replication-level)
+                (insertion-desired-replication-level insertion))
+      (set%!/put '(expiration) (datum-expiration datum))
       ;; Copy key-data pair to insert into the DHT.
-      (slice-copy! (datum-key datum)
-                  (select /:msg:dht:client:put '(key) header))
+      (slice-copy! (datum-key datum) (select /:msg:dht:client:put '(key) 
header))
       (slice-copy! (datum-value datum) rest)
       message)
 
@@ -459,20 +462,17 @@ result object @var{search-result}, with @var{unique-id} 
as ‘unique id’"
             (! message (make-slice/read-write size))
             (! header (slice-slice message 0 size/header))
             (! rest (slice-slice message size/header)))
-           (set%! /:msg:dht:client:result '(header type)
-                  header
-                  (value->index
-                   (symbol-value message-type msg:dht:client:result)))
-           (set%! /:msg:dht:client:result '(header size)
-                  header
-                  size)
-           (set%! /:msg:dht:client:result '(type) header type)
-           (set%! /:msg:dht:client:result '(get-path-length)
-                  header get-path-length)
-           (set%! /:msg:dht:client:result '(put-path-length)
-                  header put-path-length)
-           (set%! /:msg:dht:client:result '(unique-id) header unique-id)
-           (set%! /:msg:dht:client:result '(expiration) header expiration)
+           (define-syntax set%!/result
+             (cut-syntax set%! /:msg:dht:client:result <> header <>))
+           (set%!/result '(header type)
+                         (value->index
+                          (symbol-value message-type msg:dht:client:result)))
+           (set%!/result '(header size) size)
+           (set%!/result '(type) type)
+           (set%!/result '(get-path-length) get-path-length)
+           (set%!/result '(put-path-length) put-path-length)
+           (set%!/result '(unique-id) unique-id)
+           (set%!/result '(expiration) expiration)
            (slice-copy! key (select /:msg:dht:client:result '(key) header))
            ;; TODO: get-path and put path!
            (slice-copy! value rest)
diff --git a/gnu/gnunet/utils/cut-syntax.scm b/gnu/gnunet/utils/cut-syntax.scm
new file mode 100644
index 0000000..bc4ee9d
--- /dev/null
+++ b/gnu/gnunet/utils/cut-syntax.scm
@@ -0,0 +1,38 @@
+;; This file is part of Scheme-GNUnet
+;; Copyright © 2022 GNUnet e.V.
+;;
+;; Scheme-GNUnet is free software: you can redistribute it and/or modify it
+;; under the terms of the GNU Affero General Public License as published
+;; by the Free Software Foundation, either version 3 of the License,
+;; or (at your option) any later version.
+;;
+;; Scheme-GNUnet is distributed in the hope that it will be useful, but
+;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;; Affero General Public License for more details.
+;;
+;; You should have received a copy of the GNU Affero General Public License
+;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
+;;
+;; SPDX-License-Identifier: AGPL-3.0-or-later
+
+;; TODO: eliminate (gnu gnunet netstruct syntactic), use a compiler pass 
instead
+;; for inlining, then ‘cut-syntax’ can be deprecated in favour of a ‘cut’.
+(define-library (gnu gnunet utils cut-syntax)
+  (export cut-syntax)
+  (import (only (rnrs base) ... begin define-syntax syntax-rules))
+  (begin
+    (define-syntax substitute
+      (syntax-rules (<>)
+       ((_ (substituted ...) (<> . foos) (bar . bars))
+        (substitute (substituted ... bar) foos bars))
+       ((_ (substituted ...) (foo . foos) bars)
+        (substitute (substituted ... foo) foos bars))
+       ((_ (substituted ...) () ())
+        (substituted ...))))
+
+    (define-syntax cut-syntax
+      (syntax-rules ()
+       ((_ . foos)
+        (syntax-rules ()
+          ((_ . bars) (substitute () foos bars))))))))
diff --git a/tests/mq.scm b/tests/mq.scm
index 14d2a27..8d456ac 100644
--- a/tests/mq.scm
+++ b/tests/mq.scm
@@ -1,5 +1,5 @@
 ;; This file is part of GNUnet.
-;; Copyright (C) 2012, 2018, 2021 GNUnet e.V.
+;; Copyright (C) 2012, 2018, 2021, 2022 GNUnet e.V.
 ;;
 ;; GNUnet is free software: you can redistribute it and/or modify it
 ;; under the terms of the GNU Affero General Public License as published
@@ -46,6 +46,7 @@
             (gnu gnunet util struct)
             (gnu gnunet utils bv-slice)
             (gnu gnunet utils hat-let)
+            (gnu gnunet utils cut-syntax)
             ((gnu extractor enum)
              #:select (symbol-value value->index))
             (gnu gnunet message protocols)
@@ -82,11 +83,11 @@ Then each time the index is increased.")
 (define (index->dummy i)
   (let ((s (make-slice/read-write
            (sizeof /:msg:our-test:dummy '()))))
-    (set%! /:msg:our-test:dummy '(header type) s
-          (value->index (symbol-value message-type msg:util:dummy)))
-    (set%! /:msg:our-test:dummy '(header size) s
-          (sizeof /:msg:our-test:dummy '()))
-    (set%! /:msg:our-test:dummy '(index) s i)
+    (define-syntax set%!/dummy (cut-syntax set%! /:msg:our-test:dummy <> s <>))
+    (set%!/dummy '(header type)
+                (value->index (symbol-value message-type msg:util:dummy)))
+    (set%!/dummy '(header size) (sizeof /:msg:our-test:dummy '()))
+    (set%!/dummy '(index) i)
     s))
 
 (define (dummy->index s)
@@ -341,12 +342,13 @@ Then each time the index is increased.")
 (define (make-thread-message thread-index i)
   (let ((s (make-slice/read-write
            (sizeof /:msg:our-test:concurrency '()))))
-    (set%! /:msg:our-test:concurrency '(header type) s
-          (value->index (symbol-value message-type msg:util:dummy)))
-    (set%! /:msg:our-test:concurrency '(header size) s
-          (sizeof /:msg:our-test:concurrency '()))
-    (set%! /:msg:our-test:concurrency '(index) s i)
-    (set%! /:msg:our-test:concurrency '(thread) s thread-index)
+    (define-syntax set%!/concurrency
+      (cut-syntax set%! /:msg:our-test:concurrency <> s <>))
+    (set%!/concurrency
+     '(header type) (value->index (symbol-value message-type msg:util:dummy)))
+    (set%!/concurrency '(header size) (sizeof /:msg:our-test:concurrency '()))
+    (set%!/concurrency '(index) i)
+    (set%!/concurrency '(thread) thread-index)
     s))
 
 (define (decode-thread-message s)
diff --git a/tests/network-size.scm b/tests/network-size.scm
index 0b27d29..8f8e6bb 100644
--- a/tests/network-size.scm
+++ b/tests/network-size.scm
@@ -23,6 +23,7 @@
        (gnu extractor enum)
        (gnu gnunet message protocols)
        (gnu gnunet config db)
+       (gnu gnunet utils cut-syntax)
        (only (rnrs base)
              assert)
        (prefix (gnu gnunet nse client) #{nse:}#)
@@ -103,19 +104,17 @@
   (define (send! estimate)
     (define s (make-slice/read-write
               (sizeof /:msg:nse:estimate '())))
+    (define-syntax set%!/estimate
+      (cut-syntax set%! /:msg:nse:estimate <> s <>))
     ;; Set the headers
-    (set%! /:msg:nse:estimate '(header size) s
-          (sizeof /:msg:nse:estimate '()))
-    (set%! /:msg:nse:estimate '(header type) s
-          (value->index
-           (symbol-value message-type msg:nse:estimate)))
+    (set%!/estimate '(header size) (sizeof /:msg:nse:estimate '()))
+    (set%!/estimate '(header type)
+                   (value->index
+                    (symbol-value message-type msg:nse:estimate)))
     ;; Set the data
-    (set%! /:msg:nse:estimate '(timestamp) s
-          (list-ref estimate 3))
-    (set%! /:msg:nse:estimate '(size-estimate) s
-          (list-ref estimate 0))
-    (set%! /:msg:nse:estimate '(std-deviation) s
-          (list-ref estimate 2))
+    (set%!/estimate '(timestamp) (list-ref estimate 3))
+    (set%!/estimate '(size-estimate) (list-ref estimate 0))
+    (set%!/estimate '(std-deviation) (list-ref estimate 2))
     ;; Send the estimate
     (send-message! mq s))
   (for-each send! %estimates))

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