From e237b49bb04a0156fc2c31bb2ca92e68120994f3 Mon Sep 17 00:00:00 2001 From: Tony Garnock-Jones Date: Sat, 9 Aug 2014 19:05:38 -0700 Subject: [PATCH] Message deduplicator --- minimart/deduplicator.rkt | 36 ++++++++++++++++++++++++++++++++++++ 1 file changed, 36 insertions(+) create mode 100644 minimart/deduplicator.rkt diff --git a/minimart/deduplicator.rkt b/minimart/deduplicator.rkt new file mode 100644 index 0000000..f90abf3 --- /dev/null +++ b/minimart/deduplicator.rkt @@ -0,0 +1,36 @@ +#lang racket/base + +(provide (struct-out deduplicator) + make-deduplicator + deduplicator-accept + deduplicator-expire) + +(require racket/set) +(require racket/match) +(require "functional-queue.rkt") + +(struct deduplicator (queue table ttl) #:transparent) + +(define (make-deduplicator [ttl 10000]) + (deduplicator (make-queue) (set) ttl)) + +(define (deduplicator-expire d) + (define now (current-inexact-milliseconds)) + (let loop ((d d)) + (match-define (deduplicator queue table ttl) d) + (if (queue-empty? queue) + d + (let-values (((v q1) (dequeue queue))) + (if (<= (car v) now) + (loop (deduplicator q1 (set-remove table (cdr v)) ttl)) + d))))) + +(define (deduplicator-accept d incoming) + (let* ((d (deduplicator-expire d))) + (match-define (deduplicator queue table ttl) d) + (if (set-member? table incoming) + (values #f d) + (values #t (deduplicator (enqueue queue + (cons (+ (current-inexact-milliseconds) ttl) incoming)) + (set-add table incoming) + ttl)))))