[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[gnunet-scheme] 16/42: cadet/client: Avoid (mutating) hash tables.
From: |
gnunet |
Subject: |
[gnunet-scheme] 16/42: cadet/client: Avoid (mutating) hash tables. |
Date: |
Sat, 10 Sep 2022 19:08:09 +0200 |
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 a5969fcdf965abe18f701d4a7eed6cb1dc90787e
Author: Maxime Devos <maximedevos@telenet.be>
AuthorDate: Fri Sep 9 15:09:33 2022 +0200
cadet/client: Avoid (mutating) hash tables.
real 0m10,590s
user 0m18,427s
sys 0m1,969s
Fits better in (gnu gnunet server) that way.
* gnu/gnunet/cadet/client.scm (reconnect): Use a bbtree instead of a
hash table, without mutation.
(connect): Adjust appropriately.
---
gnu/gnunet/cadet/client.scm | 77 ++++++++++++++++++++++++---------------------
1 file changed, 41 insertions(+), 36 deletions(-)
diff --git a/gnu/gnunet/cadet/client.scm b/gnu/gnunet/cadet/client.scm
index bc1b8b8..af58f32 100644
--- a/gnu/gnunet/cadet/client.scm
+++ b/gnu/gnunet/cadet/client.scm
@@ -88,12 +88,12 @@
let^)
(only (rnrs base)
begin define lambda assert quote cons apply values
- case else = define-syntax + expt - let* let and >
- not if eq?)
+ case else = define-syntax + expt - let and >
+ not if eq? <)
(only (rnrs control)
when unless)
- (only (rnrs hashtables)
- make-eqv-hashtable hashtable-ref hashtable-set!)
+ (only (pfds bbtrees)
+ bbtree-set make-bbtree bbtree-ref)
(only (rnrs records syntactic) define-record-type)
(only (ice-9 control) let/ec)
(only (ice-9 match) match)
@@ -104,6 +104,8 @@
signal-condition!)
(only (fibers operations)
wrap-operation choice-operation perform-operation)
+ (only (srfi srfi-26)
+ cut)
(only (srfi srfi-45)
delay force))
(begin
@@ -150,6 +152,8 @@
((%make (losable-lost-and-found server)) server
destination options #false #false message-queue 0)))))
+ (define empty-bbtree (make-bbtree <))
+
(define* (connect config #:key (connected values) (disconnected values)
(spawn spawn-fiber))
"Asynchronuously connect to the CADET service, using the configuration
@@ -160,17 +164,15 @@
(server-control-channel server)
connected disconnected spawn
(losable-lost-and-found server)
- ;; integers cannot be compares with eq?,
- ;; but they can be with eqv?
- (make-eqv-hashtable))
+ empty-bbtree)
server)
;; TODO: reduce duplication with (gnu gnunet dht client)
(define (spawn-procedure spawn . rest)
(spawn (lambda () (apply reconnect rest))))
- ;; channel-number->channel-hash-map:
- ;; A hash map from channel numbers to their corresponding
+ ;; channel-number->channel-map:
+ ;; A 'bbtree' from channel numbers to their corresponding
;; <channel> object, or nothing if the control loop
;; has not processes 'open-channel!' yet or if the channel
;; has been closed.
@@ -179,7 +181,7 @@
(define (reconnect config terminal-condition control-channel
connected disconnected spawn
lost-and-found
- channel-number->channel-hash-map)
+ channel-number->channel-map)
(define loop-operation
(choice-operation
(get-operation control-channel)
@@ -222,13 +224,13 @@
control-channel))
(define mq (connect/fibers config "cadet" handlers error-handler
#:spawn spawn))
- (define (k/reconnect!)
+ (define (k/reconnect! channel-number->channel-map)
(reconnect config terminal-condition control-channel connected
disconnected spawn lost-and-found
- channel-number->channel-hash-map))
- (define (control next-free-channel-number)
+ channel-number->channel-map))
+ (define (control channel-number->channel-map next-free-channel-number)
"The main event loop."
- (control* next-free-channel-number
+ (control* channel-number->channel-map next-free-channel-number
(perform-operation loop-operation)))
(define (close-if-possible! channel)
;; Pre-conditions:
@@ -242,11 +244,13 @@
(channel-channel-number channel)))
;; We don't need the envelope.
(values)))
- (define (control* next-free-channel-number message)
+ (define (control* channel-number->channel-map next-free-channel-number
+ message)
(define (continue)
- (control next-free-channel-number))
+ (control channel-number->channel-map next-free-channel-number))
(define (continue* message)
- (control* next-free-channel-number message))
+ (control* channel-number->channel-map next-free-channel-number
+ message))
;; TODO: what about closed channels?
(define (send-channel-stuff! channel)
;; Send messages one-by-one, keeping in mind that we might not be able
@@ -317,17 +321,17 @@
(close-if-possible! channel)))
(match message
(('open-channel! channel)
- (let* ((channel-number next-free-channel-number)
+ (let^ ((! channel-number next-free-channel-number)
;; TODO: handle overflow, and respect bounds
- (next-free-channel-number (+ 1 next-free-channel-number)))
- (set-channel-channel-number! channel channel-number)
- ;; Keep track of the new <channel> object; it will be required
- ;; later by 'acknowledgement'.
- (hashtable-set! channel-number->channel-hash-map
- channel-number
- channel)
- (send-local-channel-create! mq channel)
- (control next-free-channel-number)))
+ (! next-free-channel-number (+ 1 next-free-channel-number))
+ (_ (set-channel-channel-number! channel channel-number))
+ ;; Keep track of the new <channel> object; it will be required
+ ;; later by 'acknowledgement'.
+ (! channel-number->channel-map
+ (bbtree-set channel-number->channel-map channel-number
+ channel)))
+ (send-local-channel-create! mq channel)
+ (control channel-number->channel-map
next-free-channel-number)))
(('close-channel! channel)
;; 'close-channel!' can only be sent after the <channel> object
;; was returned by the procedure 'open-channel!', because only
@@ -358,11 +362,9 @@
;; so for now nothing can be done.
(continue))
(('acknowledgement channel-number)
- (let^ ((! channel (hashtable-ref channel-number->channel-hash-map
- channel-number
- #false))
- (? (not channel)
- ???))
+ ;; TODO: failure case
+ (let^ ((! channel
+ (bbtree-ref channel-number->channel-map channel-number)))
;; The service is allowing us to send another message;
;; update the number of allowed messages.
(set-channel-allow-send!
@@ -377,8 +379,8 @@
;; Respond to a query of the msg:cadet:local:data message handler.
(('channel answer-box channel-number)
(answer answer-box
- (hashtable-ref channel-number->channel-hash-map
- channel-number #false))
+ (bbtree-ref channel-number->channel-map
+ channel-number (lambda () #false)))
(continue))
(('lost . lost)
(let loop ((lost lost))
@@ -391,9 +393,12 @@
(loop rest))
((? server:cadet? lost)
(continue* '(disconnect!))))))))
- (rest (handle-control-message! rest mq terminal-condition
k/reconnect!))))
+ (rest
+ (handle-control-message!
+ rest mq terminal-condition
+ (cut k/reconnect! channel-number->channel-map)))))
;; Start the main event loop.
- (control %minimum-local-channel-id))
+ (control channel-number->channel-map %minimum-local-channel-id))
(define-record-type (<cadet-address> make-cadet-address cadet-address?)
(fields (immutable peer cadet-address-peer)
--
To stop receiving notification emails like this one, please contact
gnunet@gnunet.org.
- [gnunet-scheme] 14/42: server: Deduplicate make-error-handler*., (continued)
- [gnunet-scheme] 14/42: server: Deduplicate make-error-handler*., gnunet, 2022/09/10
- [gnunet-scheme] 19/42: cadet/client: Minimise imports., gnunet, 2022/09/10
- [gnunet-scheme] 21/42: server: Unify loop spawning., gnunet, 2022/09/10
- [gnunet-scheme] 29/42: doc/service-communication: Document <server>., gnunet, 2022/09/10
- [gnunet-scheme] 20/42: server: Add default arguments to 'make-loop'., gnunet, 2022/09/10
- [gnunet-scheme] 25/42: server: Re-indent., gnunet, 2022/09/10
- [gnunet-scheme] 31/42: doc/service-communication: Document spawn-server-loop., gnunet, 2022/09/10
- [gnunet-scheme] 11/42: dht: Use <loop> for state where possible., gnunet, 2022/09/10
- [gnunet-scheme] 13/42: dht/client: Rewrite in terms of (gnu gnunet server)., gnunet, 2022/09/10
- [gnunet-scheme] 12/42: Revert "server: Only accept a single 'state' argument.", gnunet, 2022/09/10
- [gnunet-scheme] 16/42: cadet/client: Avoid (mutating) hash tables.,
gnunet <=
- [gnunet-scheme] 05/42: dht/client: Bring API of reconnect mostly in line with (gnu gnunet server)., gnunet, 2022/09/10
- [gnunet-scheme] 28/42: server: Inline primitive-disconnect!., gnunet, 2022/09/10
- [gnunet-scheme] 15/42: server: New procedure for making the arguments to make-loop., gnunet, 2022/09/10
- [gnunet-scheme] 17/42: cadet/client: Use <loop> for various objects where possible., gnunet, 2022/09/10
- [gnunet-scheme] 27/42: cadet/client: Simplify more., gnunet, 2022/09/10
- [gnunet-scheme] 23/42: dht/client: Re-indent., gnunet, 2022/09/10
- [gnunet-scheme] 22/42: nse/indent: Re-indent., gnunet, 2022/09/10
- [gnunet-scheme] 26/42: server: Inline single-use server->loop-arguments., gnunet, 2022/09/10
- [gnunet-scheme] 24/42: cadet/client: Re-indent., gnunet, 2022/09/10
- [gnunet-scheme] 33/42: server: Document 'make-loop'., gnunet, 2022/09/10