From unknown Fri Jun 20 07:21:07 2025 Content-Disposition: inline Content-Transfer-Encoding: quoted-printable MIME-Version: 1.0 X-Mailer: MIME-tools 5.509 (Entity 5.509) Content-Type: text/plain; charset=utf-8 From: bug#74696 <74696@debbugs.gnu.org> To: bug#74696 <74696@debbugs.gnu.org> Subject: Status: [PATCH 1/1] srfi-1: map!: Re-use cons cells of first argument. Reply-To: bug#74696 <74696@debbugs.gnu.org> Date: Fri, 20 Jun 2025 14:21:07 +0000 retitle 74696 [PATCH 1/1] srfi-1: map!: Re-use cons cells of first argument. reassign 74696 guile submitter 74696 Juliana Sims severity 74696 normal tag 74696 patch thanks From debbugs-submit-bounces@debbugs.gnu.org Wed Dec 04 14:22:27 2024 Received: (at submit) by debbugs.gnu.org; 4 Dec 2024 19:22:27 +0000 Received: from localhost ([127.0.0.1]:36916 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1tIux8-0002e6-Im for submit@debbugs.gnu.org; Wed, 04 Dec 2024 14:22:26 -0500 Received: from lists.gnu.org ([209.51.188.17]:59688) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1tIux6-0002dy-75 for submit@debbugs.gnu.org; Wed, 04 Dec 2024 14:22:24 -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 1tIux5-0000KO-Pi for bug-guile@gnu.org; Wed, 04 Dec 2024 14:22:23 -0500 Received: from out-172.mta0.migadu.com ([2001:41d0:1004:224b::ac]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1tIuwu-0000Qe-OV for bug-guile@gnu.org; Wed, 04 Dec 2024 14:22:15 -0500 X-Report-Abuse: Please report any abuse attempt to abuse@migadu.com and include these headers. DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=incana.org; s=key1; t=1733340124; h=from:from:reply-to:subject:subject:date:date:message-id:message-id: to:to:cc:cc:mime-version:mime-version: content-transfer-encoding:content-transfer-encoding; bh=S5V/zMlt9Cfza74leMutuOAeOBU58GMCEophjf9hqmM=; b=w9g67Q8jivdacYak4Ja2MD+p815AFUInbZ686mSUrmHVUV8HdvlkXx60g28A9BMjambxK6 H0DKBcJDlJHgpkaokPZxbaMEdhdA+p6tiXnU9IpluINT9D6TsZP69QjMg+liSTbM2XcGop t7/ZSYq0lNE6aR/QR6UB8NQ5BZPf509HTLrj4gL/p5+aBq3asgMYZ8BkLyjJPwtoei1qTF qOFVC2C7vmPSI6eB18wu3hyJH801wCEtsiIlXEabn/RNwauovICEly6hkztlY0gbkVTOBb zV3O2upgEOPKTDzA/esLA1KN7IkPV+2fqPIvHjSleHsZgjJH5/D/Nshwcyk3Nw== From: Juliana Sims To: bug-guile@gnu.org Subject: [PATCH 1/1] srfi-1: map!: Re-use cons cells of first argument. Date: Wed, 4 Dec 2024 14:20:55 -0500 Message-ID: <20241204192055.30996-1-juli@incana.org> MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Migadu-Flow: FLOW_OUT Received-SPF: pass client-ip=2001:41d0:1004:224b::ac; envelope-from=juli@incana.org; helo=out-172.mta0.migadu.com X-Spam_score_int: -20 X-Spam_score: -2.1 X-Spam_bar: -- X-Spam_report: (-2.1 / 5.0 requ) BAYES_00=-1.9, DKIM_SIGNED=0.1, DKIM_VALID=-0.1, DKIM_VALID_AU=-0.1, DKIM_VALID_EF=-0.1, SPF_HELO_PASS=-0.001, SPF_PASS=-0.001 autolearn=ham autolearn_force=no X-Spam_action: no action X-Spam-Score: -1.4 (-) X-Debbugs-Envelope-To: submit Cc: Juliana Sims X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -2.4 (--) * module/srfi/srfi-1.scm (map!): Re-use cons cells of first argument. --- Hello, This patch rewrites map! to update its first argument in-place. I based the implementation on the description in the Guile manual. Most of the code is copied from regular map with different argument checking logic. I wasn't entirely sure of the conventions around scm-error so let me know if that's not the appropriate key. Best, Juli module/srfi/srfi-1.scm | 58 ++++++++++++++++++++++++++++++++++++++++-- 1 file changed, 56 insertions(+), 2 deletions(-) diff --git a/module/srfi/srfi-1.scm b/module/srfi/srfi-1.scm index b46f7be5f..c0018b188 100644 --- a/module/srfi/srfi-1.scm +++ b/module/srfi/srfi-1.scm @@ -791,8 +791,62 @@ has just one element then that's the return value." (define (append-map! f clist1 . rest) (concatenate! (apply map f clist1 rest))) -;; OPTIMIZE-ME: Re-use cons cells of list1 -(define map! map) +(define map! + (case-lambda + ((f lst) + (check-arg procedure? f map!) + (check-arg list? lst map!) + (let map1 ((l lst)) + (if (pair? l) + (begin + (set-car! l (f (car l))) + (map1 (cdr l))) + lst))) + + ((f lst1 lst2) + (check-arg procedure? f map!) + (check-arg list? lst1 map!) + (let* ((len1 (length lst1)) + (len2 (length+ lst2)) + ;; Ensure either that all lists after the first are circular or that + ;; they are at least as long as the first + (len (and (or (not len2) + (<= len1 len2)) + len1))) + (unless len + (scm-error 'misc-error "map!" + "All argument lists must be at least as long as first: ~S" + (list (list lst1 lst2)) #f)) + (let map2 ((l1 lst1) (l2 lst2) (len len)) + (if (zero? len) + lst1 + (begin + (set-car! l1 (f (car l1) (car l2))) + (map2 (cdr l1) (cdr l2) (1- len))))))) + + ((f lst1 . rest) + (check-arg procedure? f map!) + (check-arg list? lst1 map!) + ;; Ensure either that all lists after the first are circular or that + ;; they are at least as long as the first + (let ((len (fold (lambda (ls len) + (let ((ls-len (length+ ls))) + (and len + (or (not ls-len) + (<= len ls-len)) + len))) + (length lst1) + rest))) + (unless len + (scm-error 'misc-error "map!" + "All argument lists must be at least as long as first: ~S" + (list (cons lst1 rest)) #f)) + (let mapn ((l1 lst1) (rest rest) (len len)) + (if (zero? len) + lst1 + (begin + (set-car! l1 (apply f (car l1) (map car rest))) + (mapn (cdr l1) (map cdr rest) (1- len))))))))) (define (filter-map proc list1 . rest) "Apply PROC to the elements of LIST1... and return a list of the -- 2.46.0 From debbugs-submit-bounces@debbugs.gnu.org Sun Dec 22 16:45:35 2024 Received: (at 74696) by debbugs.gnu.org; 22 Dec 2024 21:45:35 +0000 Received: from localhost ([127.0.0.1]:52237 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1tPTlW-0003Hu-UC for submit@debbugs.gnu.org; Sun, 22 Dec 2024 16:45:35 -0500 Received: from eggs.gnu.org ([209.51.188.92]:47568) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1tPTlU-0003Hd-Nd for 74696@debbugs.gnu.org; Sun, 22 Dec 2024 16:45:33 -0500 Received: from fencepost.gnu.org ([2001:470:142:3::e]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1tPTlO-0001xI-PK; Sun, 22 Dec 2024 16:45:26 -0500 DKIM-Signature: v=1; a=rsa-sha256; q=dns/txt; c=relaxed/relaxed; d=gnu.org; s=fencepost-gnu-org; h=MIME-Version:Date:References:In-Reply-To:Subject:To: From; bh=Hyn7fs448Oqu2MLzhIuk8JZu41fzhzv9iXDmz7nhy/s=; b=f4FJLjGRqg+z+59kNf5u zCFE/ygotBvL30p0AdifB/g+IkyJTqgmaSDK5SWV5PQbm9D5ZESOz1ojonRStCQY9B29K0HFT5Qww X9t0hqU/jSu6rbwFYRQiP1VcI00EWQsp4tRlnNQOrXXXI7tRsYsDhwUO+8woBOAR0taysAOB3er2O 1O4P+Ri5tcEUQIUWyCBmG6BEEKIfPt9MNhId6/PvIfOcrguEuVlAcbslLAGh78X+FIo6M3flgpnYp 7fo8sL1xlat5mYAWUk5haBRmd1eEy+/be3pRKCNIIMrmjFE94do5U8THeOj1ZXESiDtI+W/JWWaE/ 1qEjuzskkV0p9w==; From: =?utf-8?Q?Ludovic_Court=C3=A8s?= To: Juliana Sims Subject: Re: bug#74696: [PATCH 1/1] srfi-1: map!: Re-use cons cells of first argument. In-Reply-To: <20241204192055.30996-1-juli@incana.org> (Juliana Sims's message of "Wed, 4 Dec 2024 14:20:55 -0500") References: <20241204192055.30996-1-juli@incana.org> Date: Sun, 22 Dec 2024 22:45:24 +0100 Message-ID: <877c7rfl3f.fsf@gnu.org> User-Agent: Gnus/5.13 (Gnus v5.13) MIME-Version: 1.0 Content-Type: text/plain; charset=utf-8 Content-Transfer-Encoding: quoted-printable X-Spam-Score: -2.3 (--) X-Debbugs-Envelope-To: 74696 Cc: 74696@debbugs.gnu.org X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -3.3 (---) Hi Juliana, Juliana Sims skribis: > * module/srfi/srfi-1.scm (map!): Re-use cons cells of first argument. Could you add a couple of tests under =E2=80=98test-suite/tests/srfi-1.test= =E2=80=99? Apart from that it looks good to me. Thank you! Ludo=E2=80=99. From debbugs-submit-bounces@debbugs.gnu.org Fri Jan 31 05:22:57 2025 Received: (at 74696) by debbugs.gnu.org; 31 Jan 2025 10:22:57 +0000 Received: from localhost ([127.0.0.1]:50099 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1tdoAr-0001EL-0j for submit@debbugs.gnu.org; Fri, 31 Jan 2025 05:22:57 -0500 Received: from out-185.mta1.migadu.com ([95.215.58.185]:58579) by debbugs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.84_2) (envelope-from ) id 1tdoAo-0001E6-U6 for 74696@debbugs.gnu.org; Fri, 31 Jan 2025 05:22:55 -0500 X-Report-Abuse: Please report any abuse attempt to abuse@migadu.com and include these headers. DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=incana.org; s=key1; t=1738318968; h=from:from:reply-to:subject:subject:date:date:message-id:message-id: to:to:cc:cc:mime-version:mime-version: content-transfer-encoding:content-transfer-encoding: in-reply-to:in-reply-to:references:references; bh=kOJmm8AiZ0jG3KNVLhuO4h1n4z7NTMRlPzHfxPZ0YC4=; b=L3A3PxP8J9gEY7QrufbXyLm3lJUGDJ+JUlXZmVid1KP0T0UEHUF5DfCXJQG/K2MyQTyNur XKf4zExT9Itpn9t+/sywIX+WcXRPUPNDQOwxbBKvit0z2/gLaCbWj4tIYIf6XakJuxxlZB jx8y+O90cvsFAOKepf/mZz75pzBt76Y4y8+MXgQBDzszJHTmEW8Uv2y73onk+ec+harvRk R6iDl219jewlc2ettpXsRRLKzVv4nvIaTA+qmPzz5TJJIWRZ6f9EfJ2zg0N8HF4WsogjBs VAmBG4+6JBLJjTyiRE15NujLzJJyIcaeMFoX/LhIhILLesDbqiYL3QX+u++HTg== From: Juliana Sims To: 74696@debbugs.gnu.org Subject: [PATCH] srfi-1: map!: Re-use cons cells of first argument. Date: Fri, 31 Jan 2025 05:20:46 -0500 Message-ID: <20250131102209.16074-1-juli@incana.org> In-Reply-To: <877c7rfl3f.fsf@gnu.org> References: <877c7rfl3f.fsf@gnu.org> MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Migadu-Flow: FLOW_OUT X-Spam-Score: -0.7 (/) X-Debbugs-Envelope-To: 74696 Cc: ludo@gnu.org, Juliana Sims X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -1.7 (-) * module/srfi/srfi-1.scm (map!): Re-use cons cells of first argument. * test-suite/tests/srfi-1.test: Test map!. --- Hi Ludo, Thanks for your patience in getting this together. I've added some tests for map!. Let me know if you think there are more cases that should be tested. As a sidenote, it looks like regular map isn't directly tested. Maybe if I get time I'll copy these tests for it :) Thanks, Juli module/srfi/srfi-1.scm | 58 ++++++++++++++++++++++++++++++++++-- test-suite/tests/srfi-1.test | 38 +++++++++++++++++++++++ 2 files changed, 94 insertions(+), 2 deletions(-) diff --git a/module/srfi/srfi-1.scm b/module/srfi/srfi-1.scm index b46f7be5f..c0018b188 100644 --- a/module/srfi/srfi-1.scm +++ b/module/srfi/srfi-1.scm @@ -791,8 +791,62 @@ has just one element then that's the return value." (define (append-map! f clist1 . rest) (concatenate! (apply map f clist1 rest))) -;; OPTIMIZE-ME: Re-use cons cells of list1 -(define map! map) +(define map! + (case-lambda + ((f lst) + (check-arg procedure? f map!) + (check-arg list? lst map!) + (let map1 ((l lst)) + (if (pair? l) + (begin + (set-car! l (f (car l))) + (map1 (cdr l))) + lst))) + + ((f lst1 lst2) + (check-arg procedure? f map!) + (check-arg list? lst1 map!) + (let* ((len1 (length lst1)) + (len2 (length+ lst2)) + ;; Ensure either that all lists after the first are circular or that + ;; they are at least as long as the first + (len (and (or (not len2) + (<= len1 len2)) + len1))) + (unless len + (scm-error 'misc-error "map!" + "All argument lists must be at least as long as first: ~S" + (list (list lst1 lst2)) #f)) + (let map2 ((l1 lst1) (l2 lst2) (len len)) + (if (zero? len) + lst1 + (begin + (set-car! l1 (f (car l1) (car l2))) + (map2 (cdr l1) (cdr l2) (1- len))))))) + + ((f lst1 . rest) + (check-arg procedure? f map!) + (check-arg list? lst1 map!) + ;; Ensure either that all lists after the first are circular or that + ;; they are at least as long as the first + (let ((len (fold (lambda (ls len) + (let ((ls-len (length+ ls))) + (and len + (or (not ls-len) + (<= len ls-len)) + len))) + (length lst1) + rest))) + (unless len + (scm-error 'misc-error "map!" + "All argument lists must be at least as long as first: ~S" + (list (cons lst1 rest)) #f)) + (let mapn ((l1 lst1) (rest rest) (len len)) + (if (zero? len) + lst1 + (begin + (set-car! l1 (apply f (car l1) (map car rest))) + (mapn (cdr l1) (map cdr rest) (1- len))))))))) (define (filter-map proc list1 . rest) "Apply PROC to the elements of LIST1... and return a list of the diff --git a/test-suite/tests/srfi-1.test b/test-suite/tests/srfi-1.test index 558934df4..4263b5ac1 100644 --- a/test-suite/tests/srfi-1.test +++ b/test-suite/tests/srfi-1.test @@ -1921,6 +1921,44 @@ '(1) '(2)) good))) +;; +;; map! +;; + +(with-test-prefix "map!" + + (pass-if-exception "no args" exception:wrong-num-args + (map!)) + + (pass-if-exception "one arg" exception:wrong-num-args + (map! (lambda _ #t))) + + (pass-if-exception "non-procedure first arg" exception:wrong-type-arg + (map! 'not-a-proc '(1 2 3))) + + (pass-if-exception "non-list second arg" exception:wrong-type-arg + (map! identity '(1 2 3))) + + (pass-if "1+ (1 2 3)" + (let ((lst '(1 2 3))) + (and (eq? lst (map! 1+ lst)) + (equal? '(2 3 4) lst)))) + + (pass-if "+ (1 2 3) (3 2 1)" + (let ((l1 '(1 2 3)) + (l2 '(3 2 1))) + (and (eq? l1 (map! + l1 l2)) + (not (eq? l1 l2)) + (equal? '(4 4 4) l1)))) + + (pass-if "+ (1 1 1) (2 2 2) (3 3 3)" + (let ((l1 '(1 1 1)) + (l2 '(2 2 2)) + (l3 '(3 3 3))) + (and (eq? l1 (map! + l1 l2 l3)) + (not (eq? l1 l2 l3)) + (equal? '(6 6 6) l1))))) + ;; ;; member ;; -- 2.48.1 From debbugs-submit-bounces@debbugs.gnu.org Fri Feb 28 15:59:57 2025 Received: (at 74696) by debbugs.gnu.org; 28 Feb 2025 20:59:57 +0000 Received: from localhost ([127.0.0.1]:53723 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1to7Se-0002Qk-I0 for submit@debbugs.gnu.org; Fri, 28 Feb 2025 15:59:56 -0500 Received: from eggs.gnu.org ([2001:470:142:3::10]:33246) by debbugs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.84_2) (envelope-from ) id 1to7Sb-0002Pv-Kc for 74696@debbugs.gnu.org; Fri, 28 Feb 2025 15:59:54 -0500 Received: from fencepost.gnu.org ([2001:470:142:3::e]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1to7SV-0006kc-29; Fri, 28 Feb 2025 15:59:47 -0500 DKIM-Signature: v=1; a=rsa-sha256; q=dns/txt; c=relaxed/relaxed; d=gnu.org; s=fencepost-gnu-org; h=MIME-Version:Date:References:In-Reply-To:Subject:To: From; bh=NmJTq7pZExw9Jja+TUGlpmPwhv29BGL05cshgXAhq78=; b=Z0e1rhfKiLM5UamC1oWs cucWYc4a7Hd2jiu7do8i8MUuIX/Yv3EefIrA10rzzuqbxRdx8GUV2Xki+ZDX5SjQysUC1VE4pAre3 eFDx6Oqw96Rt4h1cnOv06CZ6W82pV70w8Dm8ECImhnJlyb20bWHX4Lk8McsrNlEj/MsTTbYzdx/ad Xr+tgnsB0576XYy+1greCkZDxGLJTG6jXPQy01MugccgPAA69i0jgXcVtFqHKg38tgZbFLKQ2p37u MUYpWzYKzbSPhspWHQlIyZMV1B/aZyhwnUPdioV8rfGc+bZyWseukk07uDBGpJS+Jhw9DAXQalSQW B1B3Ln2w8yoa1g==; From: =?utf-8?Q?Ludovic_Court=C3=A8s?= To: Juliana Sims Subject: Re: bug#74696: [PATCH] srfi-1: map!: Re-use cons cells of first argument. In-Reply-To: <20250131102209.16074-1-juli@incana.org> (Juliana Sims's message of "Fri, 31 Jan 2025 05:20:46 -0500") References: <877c7rfl3f.fsf@gnu.org> <20250131102209.16074-1-juli@incana.org> Date: Fri, 28 Feb 2025 21:59:44 +0100 Message-ID: <87zfi5oke7.fsf@gnu.org> User-Agent: Gnus/5.13 (Gnus v5.13) MIME-Version: 1.0 Content-Type: text/plain; charset=utf-8 Content-Transfer-Encoding: quoted-printable X-Spam-Score: -2.3 (--) X-Debbugs-Envelope-To: 74696 Cc: 74696@debbugs.gnu.org X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -3.3 (---) Hello! Juliana Sims skribis: > * module/srfi/srfi-1.scm (map!): Re-use cons cells of first argument. > * test-suite/tests/srfi-1.test: Test map!. This LGTM but it leads to a bunch of unrelated test failures. Could you check on your side? Thanks, Ludo=E2=80=99.