From patchwork Fri Feb 21 15:40:11 2025 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Romain GARBAGE X-Patchwork-Id: 38916 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 62F3E27BBEA; Fri, 21 Feb 2025 15:42:34 +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 C567527BBE2 for ; Fri, 21 Feb 2025 15:42:33 +0000 (GMT) Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1tlVAF-0000uf-0g; Fri, 21 Feb 2025 10:42:07 -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 1tlVAD-0000uS-Fq for guix-patches@gnu.org; Fri, 21 Feb 2025 10:42:05 -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 1tlVAD-0002Rz-6x for guix-patches@gnu.org; Fri, 21 Feb 2025 10:42:05 -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=U8EC4UKXxwT9xJTtOTq+j6NnqQ/O0+1PhJhYSkAMyCr+somqfptA8W1uQBxOcNCtY0Esv7AjwSxSIzhisSKd30he7rjNrQgi1x/bMdb4e9bhxZh2UUk2C4AnarQTOqeRYZxwLNtoU6lNlkCrvoBPxHWPpJ/uR3TgRiyY809bCsL2SB94d1WFzuA5Y0ZcfZF5dhVOjoTMJC+qFlBCIstYA0W0LiOwajjU2DoGfw3vek8w8DiShobXctN91QFoLg5fAbRgakXiBO1fAsaIG+HRICSeM0zO39GlJYujuuAFNPxAIrGsbQ9IIQF+pwPcTamfaFUPdyHlAl7/2ien1b6Kjg==; Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1tlVAD-0001qz-0y for guix-patches@gnu.org; Fri, 21 Feb 2025 10:42:05 -0500 X-Loop: help-debbugs@gnu.org Subject: [bug#76474] [PATCH Cuirass 2/6] utils: Add ring buffer implementation. Resent-From: Romain GARBAGE Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Fri, 21 Feb 2025 15:42:04 +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.17401524976860 (code B ref 76474); Fri, 21 Feb 2025 15:42:04 +0000 Received: (at 76474) by debbugs.gnu.org; 21 Feb 2025 15:41:37 +0000 Received: from localhost ([127.0.0.1]:33097 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1tlV9k-0001mU-KD for submit@debbugs.gnu.org; Fri, 21 Feb 2025 10:41:37 -0500 Received: from mail3-relais-sop.national.inria.fr ([192.134.164.104]:63151) by debbugs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.84_2) (envelope-from ) id 1tlV9X-0001j2-7b for 76474@debbugs.gnu.org; Fri, 21 Feb 2025 10:41:24 -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=mIvtSEsVE8w7FSN0GXiS242UfMrVd4eYOz/Ah5xntk9kdIUf+ePlNLTi qh58usHT+9JslvP6u60h4sHOyDjUL9Th/sVEfr6LJaP5pniSuHyq2sSlC Tffxv0mOvyLeTZWpBL8IlsLTfVgCN/IEQhsdJmzuRGY8vC0BfMznQ9KJx M=; 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,305,1732575600"; d="scan'208";a="109734822" Received: from 91-160-179-8.subs.proxad.net (HELO localhost.localdomain) ([91.160.179.8]) by mail3-relais-sop.national.inria.fr with ESMTP/TLS/ECDHE-RSA-AES256-GCM-SHA384; 21 Feb 2025 16:41:14 +0100 From: Romain GARBAGE Date: Fri, 21 Feb 2025 16:40:11 +0100 Message-ID: <20250221154108.16375-2-romain.garbage@inria.fr> X-Mailer: git-send-email 2.48.1 In-Reply-To: <20250221154108.16375-1-romain.garbage@inria.fr> References: <20250221154108.16375-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)