[gnunet-scheme] 08/42: nse/client: Simplify state passing with a new subtype of <loop>.

[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 6ce548df62c9cea109371bae77efc4a175c1195e
Author: Maxime Devos <maximedevos@telenet.be>
AuthorDate: Thu Sep 8 21:12:13 2022 +0200

    nse/client: Simplify state passing with a new subtype of <loop>.
    
    * gnu/gnunet/nse/client.scm
    (<loop:nse>): New record type, containing 'updated' and 'estimate/box'.
    (make-message-handlers): Adjust to new subtype, dropping some
    arguments.
    (make-error-handler*): Likewise.
    (control-message-handler): Likewise.
---
 gnu/gnunet/nse/client.scm | 68 ++++++++++++++++++++++++-----------------------
 1 file changed, 35 insertions(+), 33 deletions(-)

diff --git a/gnu/gnunet/nse/client.scm b/gnu/gnunet/nse/client.scm
index fea7b72..3df15eb 100644
--- a/gnu/gnunet/nse/client.scm
+++ b/gnu/gnunet/nse/client.scm
@@ -49,7 +49,7 @@
          (only (gnu extractor enum)
                symbol-value value->index)
          (only (guile)
-               define*)
+               lambda* define*)
          (only (gnu gnunet concurrency lost-and-found)
                losable-lost-and-found)
          (only (gnu gnunet util struct)
@@ -70,7 +70,7 @@
                server-control-channel
                make-error-handler
                handle-control-message!
-               make-loop run-loop
+               <loop> run-loop
                loop:connected loop:disconnected
                loop:control-channel loop:terminal-condition)
           (only (gnu gnunet nse struct)
@@ -124,6 +124,15 @@ timestamp."
     (define disconnect!
       (make-disconnect! 'network-size server:nse?))
 
+    (define-record-type (<loop:nse> make-loop:nse loop:nse?)
+      (parent <loop>)
+      (fields (immutable updated loop:updated)
+             (immutable estimate/box loop:estimate/box))
+      (protocol
+       (lambda (%make)
+        (lambda* (#:key updated estimate/box #:allow-other-keys #:rest r)
+          ((apply %make r) updated estimate/box)))))
+
     ;; See 'connect'.  TODO: gc test fails
     (define* (handle-estimate! estimate-slice estimate/box updated)
       (define estimate
@@ -134,8 +143,7 @@ timestamp."
       (atomic-box-set! estimate/box estimate)
       (updated estimate))
 
-    (define* (make-message-handlers _ #:key estimate/box updated
-                                   #:allow-other-keys)
+    (define (make-message-handlers loop)
       (message-handlers
        (message-handler
        (type (symbol-value message-type msg:nse:estimate))
@@ -152,9 +160,10 @@ timestamp."
                     (read% /:msg:nse:estimate '(std-deviation) slice)))
                (or (>= stddev 0)
                    (nan? stddev)))))
-       ((handle! slice) (handle-estimate! slice estimate/box updated)))))
+       ((handle! slice) (handle-estimate! slice (loop:estimate/box loop)
+                                          (loop:updated loop))))))
 
-    (define* (make-error-handler* state . rest)
+    (define (make-error-handler* state)
       (make-error-handler (loop:connected state) (loop:disconnected state)
                          (loop:terminal-condition state)
                          (loop:control-channel state)))
@@ -169,23 +178,18 @@ timestamp."
       (send-message! message-queue s))
 
     (define* (control-message-handler message control control*
-                                     loop
-                                     #:key message-queue
-                                     updated
-                                     estimate/box
-                                     #:allow-other-keys
-                                     #:rest rest)
+                                     loop #:key message-queue)
       (define (k/reconnect!)
-       (run-loop loop #:updated updated #:estimate/box estimate/box))
+       (run-loop loop))
       (match message
         (('resend-old-operations!)
         (send-start! message-queue)
-        (apply control loop rest)) ; continue
+        (control loop #:message-queue message-queue)) ; continue
        (('lost . _)
         ;; We lost ourselves, that means the server became unreachable.
         ;; The presence of this line is tested by the "garbage collectable"
         ;; test.
-        (apply control* '(disconnect!) loop rest))
+        (control* '(disconnect!) loop #:message-queue message-queue))
        (rest
         (handle-control-message! message message-queue
                                  (loop:terminal-condition loop) 
k/reconnect!))))
@@ -205,21 +209,19 @@ shortly after calling @var{disconnected}.
 The procedures @var{updated}, @var{connected} and @var{disconnected} are 
optional."
       (define server (%make-server))
       (define loop
-       (make-loop #:make-message-handlers make-message-handlers
-                  #:make-error-handler* make-error-handler*
-                  #:control-message-handler control-message-handler
-                  #:service-name "nse"
-                  #:terminal-condition (server-terminal-condition server)
-                  #:configuration config
-                  #:control-channel (server-control-channel server)
-                  #:lost-and-found (losable-lost-and-found server)
-                  #:connected connected
-                  #:disconnected disconnected
-                  #:spawn spawn))
-      (spawn-procedure spawn loop
-                      #:estimate/box (server-estimate/box server)
-                      #:updated updated)
-      server)
-
-    (define (spawn-procedure spawn . rest)
-      (spawn (lambda () (apply run-loop rest))))))
+       (make-loop:nse
+        #:make-message-handlers make-message-handlers
+        #:make-error-handler* make-error-handler*
+        #:control-message-handler control-message-handler
+        #:service-name "nse"
+        #:terminal-condition (server-terminal-condition server)
+        #:configuration config
+        #:control-channel (server-control-channel server)
+        #:lost-and-found (losable-lost-and-found server)
+        #:connected connected
+        #:disconnected disconnected
+        #:spawn spawn
+        #:estimate/box (server-estimate/box server)
+        #:updated updated))
+      (spawn (lambda () (run-loop loop)))
+      server)))

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