From patchwork Mon Feb 24 14:38:07 2025 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Romain GARBAGE X-Patchwork-Id: 39114 Return-Path: X-Original-To: patchwork@mira.cbaines.net Delivered-To: patchwork@mira.cbaines.net Received: by mira.cbaines.net (Postfix, from userid 113) id 3ED7A27BBEA; Mon, 24 Feb 2025 14:40:38 +0000 (GMT) X-Spam-Checker-Version: SpamAssassin 3.4.6 (2021-04-09) on mira.cbaines.net X-Spam-Level: X-Spam-Status: No, score=-7.6 required=5.0 tests=BAYES_00,DKIMWL_WL_HIGH, DKIM_SIGNED,DKIM_VALID,MAILING_LIST_MULTI,RCVD_IN_DNSWL_BLOCKED, RCVD_IN_VALIDITY_CERTIFIED,RCVD_IN_VALIDITY_RPBL,RCVD_IN_VALIDITY_SAFE, SPF_HELO_PASS,URIBL_BLOCKED autolearn=ham autolearn_force=no version=3.4.6 Received: from lists.gnu.org (lists.gnu.org [209.51.188.17]) by mira.cbaines.net (Postfix) with ESMTPS id 9DD8427BBE2 for ; Mon, 24 Feb 2025 14:40:37 +0000 (GMT) Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1tmZcs-0006QT-2G; Mon, 24 Feb 2025 09:40:06 -0500 Received: from eggs.gnu.org ([2001:470:142:3::10]) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1tmZco-0006OW-F3 for guix-patches@gnu.org; Mon, 24 Feb 2025 09:40:02 -0500 Received: from debbugs.gnu.org ([2001:470:142:5::43]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1tmZco-0006gm-5H for guix-patches@gnu.org; Mon, 24 Feb 2025 09:40:02 -0500 DKIM-Signature: v=1; a=rsa-sha256; q=dns/txt; c=relaxed/relaxed; d=debbugs.gnu.org; s=debbugs-gnu-org; h=MIME-Version:References:In-Reply-To:Date:From:To:Subject; bh=w6UjAkouCcw3gN6AWlaFIu9pL/FGYAezoRSZprU3cj8=; b=D6m1zgV4VI8sKOA+nuSUT9IWL4Uoz+FtYgUz1GuxZWGnZdY/MVNUGY+M2eZ0iVmzRzxIIcT0LGLr6GxVhqd7d0VeLYfBL4P9Ahipndq29uVXD/1/pjoBUsSd1/KzLrD96sLywzSbjCPWESXeEapgu7VzO/i1BZObmn1xrnmDzFpZeqXt+vcZa7wD6Wb5jS9GZPdxyhYO7ppKQTxGc2lgEhZl1zyGSFo1MH6u92SpyRgun0G9H7LnHq0i2QtmsjAUPMa9tA3et+/6UT7X3Bq8DkD2gcWshER27ZWn65mJ3p88h1BdcCSoEJtoceHKj/1jarv/NNiRKfnUbfmHh1W9cA==; Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1tmZcn-00012t-TD for guix-patches@gnu.org; Mon, 24 Feb 2025 09:40:01 -0500 X-Loop: help-debbugs@gnu.org Subject: [bug#76474] [PATCH Cuirass v3 2/7] utils: Add ring buffer implementation. Resent-From: Romain GARBAGE Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Mon, 24 Feb 2025 14:40:01 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 76474 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: 76474@debbugs.gnu.org Cc: ludovic.courtes@inria.fr, Romain GARBAGE Received: via spool by 76474-submit@debbugs.gnu.org id=B76474.17404079493840 (code B ref 76474); Mon, 24 Feb 2025 14:40:01 +0000 Received: (at 76474) by debbugs.gnu.org; 24 Feb 2025 14:39:09 +0000 Received: from localhost ([127.0.0.1]:39157 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1tmZbx-0000zn-7U for submit@debbugs.gnu.org; Mon, 24 Feb 2025 09:39:09 -0500 Received: from mail3-relais-sop.national.inria.fr ([192.134.164.104]:10205) by debbugs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.84_2) (envelope-from ) id 1tmZbu-0000zE-BS for 76474@debbugs.gnu.org; Mon, 24 Feb 2025 09:39:07 -0500 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=inria.fr; s=dc; h=from:to:cc:subject:date:message-id:in-reply-to: references:mime-version:content-transfer-encoding; bh=w6UjAkouCcw3gN6AWlaFIu9pL/FGYAezoRSZprU3cj8=; b=cOfFgwVEEq3hsL+N6CR2MQ1aDcljc9y4LVoHXGKVKBJsVOOyV0jqdAE1 ikMEwv1lgbAo8Bkp0Pr5UjFQqeornXA6Zv8OX+P/bU1uMnXKmQ42pugJb drez5lVyK/2O3dXofnRE1Eimztc3pLg7kR7GLnvvamRgMLKPXYmEFIwKb 0=; Authentication-Results: mail3-relais-sop.national.inria.fr; dkim=none (message not signed) header.i=none; spf=SoftFail smtp.mailfrom=romain.garbage@inria.fr; dmarc=fail (p=none dis=none) d=inria.fr X-IronPort-AV: E=Sophos;i="6.13,311,1732575600"; d="scan'208";a="109907807" Received: from unknown (HELO guix-A102.bordeaux.inria.fr) ([193.50.110.221]) by mail3-relais-sop.national.inria.fr with ESMTP/TLS/ECDHE-RSA-AES256-GCM-SHA384; 24 Feb 2025 15:39:00 +0100 From: Romain GARBAGE Date: Mon, 24 Feb 2025 15:38:07 +0100 Message-ID: <20250224143851.5789-2-romain.garbage@inria.fr> X-Mailer: git-send-email 2.48.1 In-Reply-To: <20250224143851.5789-1-romain.garbage@inria.fr> References: <20250224143851.5789-1-romain.garbage@inria.fr> MIME-Version: 1.0 X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-BeenThere: guix-patches@gnu.org List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guix-patches-bounces+patchwork=mira.cbaines.net@gnu.org Sender: guix-patches-bounces+patchwork=mira.cbaines.net@gnu.org X-getmail-retrieved-from-mailbox: Patches * src/cuirass/utils.scm (): New record type. (ring-buffer, ring-buffer-insert, ring-buffer->list): New variables. * tests/utils.scm: Add tests. --- src/cuirass/utils.scm | 67 ++++++++++++++++++++++++++++++++++++++++++- tests/utils.scm | 17 +++++++++++ 2 files changed, 83 insertions(+), 1 deletion(-) diff --git a/src/cuirass/utils.scm b/src/cuirass/utils.scm index c406a84..b06f451 100644 --- a/src/cuirass/utils.scm +++ b/src/cuirass/utils.scm @@ -28,6 +28,7 @@ #:use-module (rnrs bytevectors) #:use-module (system foreign) #:use-module (srfi srfi-1) + #:use-module (srfi srfi-9) #:use-module (srfi srfi-19) #:use-module (srfi srfi-71) #:autoload (guix build utils) (mkdir-p) @@ -60,7 +61,15 @@ open-unix-listening-socket atomic-box-fetch-and-increment! - atomic-box-fetch-and-decrement!)) + atomic-box-fetch-and-decrement! + + ring-buffer + ring-buffer-head + ring-buffer-head-length + ring-buffer-limit + ring-buffer-rear + ring-buffer-insert + ring-buffer->list)) (define-exception-type &cuirass-assertion-failure &assertion-failure make-cuirass-assertion-failure @@ -347,3 +356,59 @@ and store the result inside the BOX." (define (atomic-box-fetch-and-decrement! box) "Atomically decrement the value of the integer stored inside the given BOX." (atomic-box-fetch-and-update! box 1-)) + +;;; +;;; Ring buffer implementation. Copied from GNU Shepherd. +;;; + +;; Helper function needed by ring-buffer->list. +(define (at-most max-length lst) + "If @var{lst} is shorter than @var{max-length}, return it and the empty list; +otherwise return its @var{max-length} first elements and its tail." + (let loop ((len 0) + (lst lst) + (result '())) + (match lst + (() + (values (reverse result) '())) + ((head . tail) + (if (>= len max-length) + (values (reverse result) lst) + (loop (+ 1 len) tail (cons head result))))))) + +;; The poor developer's persistent "ring buffer": it holds between N and 2N +;; elements, but has O(1) insertion. +(define-record-type + (%ring-buffer limit front-length front rear) + ring-buffer? + (limit ring-buffer-limit) + (front-length ring-buffer-front-length) + (front ring-buffer-front) + (rear ring-buffer-rear)) + +(define (ring-buffer size) + "Return an ring buffer that can hold @var{size} elements." + (%ring-buffer size 0 '() '())) + +(define-inlinable (ring-buffer-insert element buffer) + "Insert @var{element} to the front of @var{buffer}. If @var{buffer} is +already full, its oldest element is removed." + (match buffer + (($ limit front-length front rear) + (if (< front-length limit) + (let ((front-length (+ 1 front-length))) + (%ring-buffer limit front-length + (cons element front) + (if (= limit front-length) + '() + rear))) + (%ring-buffer limit 1 + (list element) front))))) + +(define (ring-buffer->list buffer) + "Convert @var{buffer} into a list." + (match buffer + (($ limit front-length front rear) + (if (= limit front-length) + front + (append front (at-most (- limit front-length) rear)))))) diff --git a/tests/utils.scm b/tests/utils.scm index e1ac1b8..4a3b48f 100644 --- a/tests/utils.scm +++ b/tests/utils.scm @@ -83,4 +83,21 @@ (const 42))))) #:to 'value)) +(test-equal "ring-buffer->list 1 element" + '(el) + (let ((buffer (ring-buffer 5))) + (ring-buffer->list (ring-buffer-insert 'el buffer)))) + +(test-equal "ring-buffer->list empty buffer" + '() + (ring-buffer->list (ring-buffer 5))) + +(test-equal "ring-buffer->list full" + '(9 8 7 6 5) + (ring-buffer->list (fold + (lambda (e r) + (pk 'r (ring-buffer-insert e r))) + (ring-buffer 5) + (iota 10)))) + (test-end)