From 712fda3af8675a921d6ca8586b1faef933a363c4 Mon Sep 17 00:00:00 2001 From: Hans Dijkema Date: Mon, 29 Jun 2026 00:17:13 +0200 Subject: [PATCH] Internal definitions other --- main.rkt | 98 ++++++++++++++++++++++++++++++++------------------------ 1 file changed, 56 insertions(+), 42 deletions(-) diff --git a/main.rkt b/main.rkt index c06aace..300458b 100644 --- a/main.rkt +++ b/main.rkt @@ -3,6 +3,7 @@ (require (for-syntax racket/syntax) racket/date racket-sprintf + racket/async-channel data/queue ) @@ -44,7 +45,8 @@ (set! log-level 'debug) (define max-log-queue-len 1000) -(define log-queue (make-queue)) +(define log-queue (make-async-channel)) +(define buffer-queue (make-queue)) (define (sl-set-log-level l) (if (or @@ -81,52 +83,64 @@ (l (hash-ref log-hash level 6))) (>= l ll))) +(define logger-thread + (thread + (λ () (let loop () + (let* ((v (sync log-queue)) + (level (vector-ref v 0)) + (msg (vector-ref v 1)) + (data (vector-ref v 2)) + (dt (car data)) + (topic (cadr data)) + (lc log-callbacks) + ) + + (when (string=? msg "@@SYNC@@") + (let ((sem (hash-ref sync-sems topic #f))) + (if (eq? sem #f) + (begin + (set! msg (format "Cannot synchronize on topic ~a" topic)) + (set! level 'error)) + (begin + (semaphore-post sem) + (set! msg (format "Synchronization received on topic ~a" topic)) + (set! level 'info) + ) + ))) + + (if (null? lc) + (enqueue! buffer-queue (list topic level dt msg)) + (begin + (when (> (queue-length buffer-queue) 0) + (for-each (λ (log-entry) + (when (needs-logging (cadr log-entry)) + (for-each (λ (e) + (let ((callback (cdr e))) + (apply callback log-entry))) + lc))) + (queue->list buffer-queue)) + (set! buffer-queue (make-queue))) + (when (needs-logging level) + (for-each (λ (e) + (let ((callback (cdr e))) + (callback topic level dt msg))) + lc)) + ) + ) + + (loop)))) + ) + ) + (define (log-to* receiver log-callbacks) (void (thread (λ () (let loop () - (let* ((v (sync receiver)) - (level (vector-ref v 0)) - (msg (vector-ref v 1)) - (data (vector-ref v 2)) - (dt (car data)) - (topic (cadr data)) - (lc (log-callbacks)) - ) - - (when (string=? msg "@@SYNC@@") - (let ((sem (hash-ref sync-sems topic #f))) - (if (eq? sem #f) - (begin - (set! msg (format "Cannot synchronize on topic ~a" topic)) - (set! level 'error)) - (begin - (semaphore-post sem) - (set! msg (format "Synchronization received on topic ~a" topic)) - (set! level 'info) - ) - ))) - - (enqueue! log-queue (list topic level dt msg)) - (unless (null? lc) - (for-each (λ (log-entry) - (when (needs-logging (cadr log-entry)) - (for-each (λ (e) - (let ((callback (cdr e))) - (apply callback log-entry))) - lc)) - ) - (queue->list log-queue)) - (set! log-queue (make-queue))) - (when (> (queue-length log-queue) max-log-queue-len) - (dequeue! log-queue)) - ) + (let* ((v (sync receiver))) + (async-channel-put log-queue v)) (loop) - ) - ) - ) - ) - ) + ))) + )) (define-syntax sl-log-to (syntax-rules (log-callbacks)