From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!.POSTED!not-for-mail From: Mark Oteiza Newsgroups: gmane.emacs.bugs Subject: bug#28254: 26.0.50; SRFI-2 and-let* Date: Sun, 27 Aug 2017 16:11:29 -0400 Message-ID: <87a82kdb4e.fsf@holos> NNTP-Posting-Host: blaine.gmane.org Mime-Version: 1.0 Content-Type: text/plain X-Trace: blaine.gmane.org 1503864742 28310 195.159.176.226 (27 Aug 2017 20:12:22 GMT) X-Complaints-To: usenet@blaine.gmane.org NNTP-Posting-Date: Sun, 27 Aug 2017 20:12:22 +0000 (UTC) To: 28254@debbugs.gnu.org Original-X-From: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane.org@gnu.org Sun Aug 27 22:12:18 2017 Return-path: Envelope-to: geb-bug-gnu-emacs@m.gmane.org Original-Received: from lists.gnu.org ([208.118.235.17]) by blaine.gmane.org with esmtp (Exim 4.84_2) (envelope-from ) id 1dm3uj-0006Vi-Nd for geb-bug-gnu-emacs@m.gmane.org; Sun, 27 Aug 2017 22:12:09 +0200 Original-Received: from localhost ([::1]:34875 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1dm3un-0004c2-2V for geb-bug-gnu-emacs@m.gmane.org; Sun, 27 Aug 2017 16:12:13 -0400 Original-Received: from eggs.gnu.org ([2001:4830:134:3::10]:33289) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1dm3ug-0004bm-Pv for bug-gnu-emacs@gnu.org; Sun, 27 Aug 2017 16:12:08 -0400 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1dm3uc-00006B-JC for bug-gnu-emacs@gnu.org; Sun, 27 Aug 2017 16:12:06 -0400 Original-Received: from debbugs.gnu.org ([208.118.235.43]:49645) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1dm3uc-00005v-F1 for bug-gnu-emacs@gnu.org; Sun, 27 Aug 2017 16:12:02 -0400 Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1dm3uc-0002EZ-7I for bug-gnu-emacs@gnu.org; Sun, 27 Aug 2017 16:12:02 -0400 X-Loop: help-debbugs@gnu.org Resent-From: Mark Oteiza Original-Sender: "Debbugs-submit" Resent-CC: bug-gnu-emacs@gnu.org Resent-Date: Sun, 27 Aug 2017 20:12:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: report 28254 X-GNU-PR-Package: emacs X-GNU-PR-Keywords: X-Debbugs-Original-To: bug-gnu-emacs@gnu.org Original-Received: via spool by submit@debbugs.gnu.org id=B.15038647098566 (code B ref -1); Sun, 27 Aug 2017 20:12:02 +0000 Original-Received: (at submit) by debbugs.gnu.org; 27 Aug 2017 20:11:49 +0000 Original-Received: from localhost ([127.0.0.1]:58326 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1dm3uP-0002E6-EF for submit@debbugs.gnu.org; Sun, 27 Aug 2017 16:11:49 -0400 Original-Received: from eggs.gnu.org ([208.118.235.92]:42139) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1dm3uM-0002Dt-Oe for submit@debbugs.gnu.org; Sun, 27 Aug 2017 16:11:47 -0400 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1dm3uG-0008FR-Hf for submit@debbugs.gnu.org; Sun, 27 Aug 2017 16:11:41 -0400 Original-Received: from lists.gnu.org ([2001:4830:134:3::11]:42882) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_256_CBC_SHA1:32) (Exim 4.71) (envelope-from ) id 1dm3uG-0008F5-Et for submit@debbugs.gnu.org; Sun, 27 Aug 2017 16:11:40 -0400 Original-Received: from eggs.gnu.org ([2001:4830:134:3::10]:33005) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1dm3uE-0004Xn-6u for bug-gnu-emacs@gnu.org; Sun, 27 Aug 2017 16:11:40 -0400 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1dm3u9-00085O-UT for bug-gnu-emacs@gnu.org; Sun, 27 Aug 2017 16:11:38 -0400 Original-Received: from mail-qt0-x231.google.com ([2607:f8b0:400d:c0d::231]:38370) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1dm3u9-00082u-M0 for bug-gnu-emacs@gnu.org; Sun, 27 Aug 2017 16:11:33 -0400 Original-Received: by mail-qt0-x231.google.com with SMTP id q53so17589938qtq.5 for ; Sun, 27 Aug 2017 13:11:32 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=udel-edu.20150623.gappssmtp.com; s=20150623; h=from:to:subject:date:message-id:mime-version; bh=SlQ7QbIDMQq0ZOg++ivrJ41neSd8P8aHSCwo83XvHSM=; b=k3cQjqel0sjziZ8aVq3y0KirtNdDKSwMOAKdEabubixQHQl9CvgyPJ3NnOt8itXhgP B4vlO5IzPA5/9Mn1N6Y5QgA2LksBhzhPN04gaOLiHB0bcQOIb2Pbg2fNMJrcYtWSCUV1 Cti6FHhrvzC2nofE60fvGYuPhg+7mjI//Wc8GaU/exUkELreQ3fa78HF3Ko0nSEuxrSP etUOc7gsfrsrucd9mEkHb0LX2YGSbORvOcEB/S/2lxlwWBt6Tqcz/nq47MBIy0i8SqCh pIL7A/dEHVsBnoQkzQYAwGYD3yoUmqX5Nl6jnf7xJ85O6VTXXDn7TohQn36JHfGnP04Z q74w== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20161025; h=x-gm-message-state:from:to:subject:date:message-id:mime-version; bh=SlQ7QbIDMQq0ZOg++ivrJ41neSd8P8aHSCwo83XvHSM=; b=hUG4ejtAAWJGsz6NXvovlljkpJU4+QtsKoHtjU9STm5e2hFeoj6oYeImV04jR+757X AVZdZmDHmUMCqb4+FO1NYQ2hU9WVh5kVuoC33+fYJv61ejQGZr3sNaWb4VuaEPkJgGJJ gpzjxBV4s/JV0hXTd1yreAV7E+L8dY+Goq14bCoo/52qY+d17sSzWw0kKStE0tSK5Lhh BK2fqMy4bGpn0PkJS8J6r9Ciq3YS460ZfWeYKtqL6zzxLbqCNqwbWO5HyZn9C/Dy0PHj 0ZCqofTLtD/FhvnPS1eMN3GYfqBHwzEezM3upJPMXCHNBBSV/b2glSC7OvxORLsidFje tBXA== X-Gm-Message-State: AHYfb5jhZcd9M7dj4fukpxhdrgX9PkQEKGVn+w7o8XAEodyJum+FFU5V BJIHhAiUGbL0b9LsrbykDA== X-Received: by 10.237.33.129 with SMTP id l1mr6497653qtc.279.1503864691155; Sun, 27 Aug 2017 13:11:31 -0700 (PDT) Original-Received: from holos.localdomain (pool-173-64-88-95.bltmmd.fios.verizon.net. [173.64.88.95]) by smtp.gmail.com with ESMTPSA id o13sm7683818qtg.47.2017.08.27.13.11.29 for (version=TLS1_2 cipher=ECDHE-RSA-CHACHA20-POLY1305 bits=256/256); Sun, 27 Aug 2017 13:11:30 -0700 (PDT) Original-Received: by holos.localdomain (Postfix, from userid 1000) id 32BB66B4DB; Sun, 27 Aug 2017 16:11:29 -0400 (EDT) X-detected-operating-system: by eggs.gnu.org: Genre and OS details not recognized. X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.6.x X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.2.x-3.x [generic] X-Received-From: 208.118.235.43 X-BeenThere: bug-gnu-emacs@gnu.org List-Id: "Bug reports for GNU Emacs, the Swiss army knife of text editors" List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane.org@gnu.org Original-Sender: "bug-gnu-emacs" Xref: news.gmane.org gmane.emacs.bugs:136279 Archived-At: Hi, A while ago I aliased and-let* to when-let* in subr-x in be10c00d. Some time later I implemented it and promptly forgot about it. While this could be cleaned up and dropped into subr-x, it could just as well be in its own file--its behavior overlaps with when-let* but each has things the other lacks. https://www.gnu.org/software/guile/manual/html_node/SRFI_002d2.html https://srfi.schemers.org/srfi-2/srfi-2.html (defmacro and-let* (varlist &rest body) "Bind variables according to VARLIST and conditionally eval BODY. Like `when-let*' except if BODY is empty and all the bindings are non-nil, then the result is t. Elements of VARLIST can additionally be of the form (EXPR), which is evaluated and checked for nil." (declare (indent 1) (debug ([&or (&rest &or symbolp atom (symbolp &optional form) (form)) (symbolp form)] body))) (let (res (prev-var t) (i 0)) (dolist (binding varlist) (push (cond ((symbolp binding) (prog1 `(,binding (and ,prev-var ,binding)) (setq prev-var binding))) ((atom binding) binding) ((and (listp binding) (null (cdr binding)) (let ((form (car binding))) (or (listp form) (atom form)))) (let ((new (cl-gensym))) (prog1 `(,new (and ,prev-var ,(car binding))) (setq prev-var new)))) (t (prog1 `(,(car binding) (and ,prev-var ,(cadr binding))) (setq prev-var (car binding))))) res)) `(let* ,(nreverse res) ,(if (null body) prev-var `(when ,prev-var ,@body))))) (ert-deftest srfi-2-test-empty-varlist () (should (equal 1 (and-let* () 1))) (should (equal 2 (and-let* () 1 2))) (should (equal t (and-let* ())))) (ert-deftest srfi-2-test-group-1 () (should (equal nil (let ((x nil)) (and-let* (x))))) (should (equal 1 (let ((x 1)) (and-let* (x))))) (should (equal nil (and-let* ((x nil))))) (should (equal 1 (and-let* ((x 1))))) (should-error (and-let* (nil (x 1))) :type 'setting-constant) (should (equal nil (and-let* ((nil) (x 1))))) (should-error (and-let* (2 (x 1))) :type 'wrong-type-argument) (should (equal 1 (and-let* ((2) (x 1))))) (should (equal 2 (and-let* ((x 1) (2))))) (should (equal nil (let ((x nil)) (and-let* (x) x)))) (should (equal "" (let ((x "")) (and-let* (x) x)))) (should (equal "" (let ((x "")) (and-let* (x))))) (should (equal 2 (let ((x 1)) (and-let* (x) (+ x 1))))) (should (equal nil (let ((x nil)) (and-let* (x) (+ x 1))))) (should (equal 2 (let ((x 1)) (and-let* (((> x 0))) (+ x 1))))) (should (equal t (let ((x 1)) (and-let* (((> x 0))))))) (should (equal nil (let ((x 0)) (and-let* (((> x 0))) (+ x 1))))) (should (equal 3 (let ((x 1)) (and-let* (((> x 0)) (x (+ x 1))) (+ x 1)))))) (ert-deftest srfi-2-test-rebind () (should (equal 4 (let ((x 1)) (and-let* (((> x 0)) (x (+ x 1)) (x (+ x 1))) (+ x 1)))))) (ert-deftest srfi-2-test-group-2 () (should (equal 2 (let ((x 1)) (and-let* (x ((> x 0))) (+ x 1))))) (should (equal 2 (let ((x 1)) (and-let* (((progn x)) ((> x 0))) (+ x 1))))) (should (equal nil (let ((x 0)) (and-let* (x ((> x 0))) (+ x 1))))) (should (equal nil (let ((x nil)) (and-let* (x ((> x 0))) (+ x 1))))) (should (equal nil (let ((x nil)) (and-let* (((progn x)) ((> x 0))) (+ x 1)))))) (ert-deftest srfi-2-test-group-3 () (should (equal nil (let ((x 1)) (and-let* (x (y (- x 1)) ((> y 0))) (/ x y))))) (should (equal nil (let ((x 0)) (and-let* (x (y (- x 1)) ((> y 0))) (/ x y))))) (should (equal nil (let ((x nil)) (and-let* (x (y (- x 1)) ((> y 0))) (/ x y))))) (should (equal (/ 3.0 2) (let ((x 3.0)) (and-let* (x (y (- x 1)) ((> y 0))) (/ x y))))))