From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!.POSTED!not-for-mail From: "Basil L. Contovounesios" Newsgroups: gmane.emacs.devel Subject: Predicate for true lists Date: Mon, 16 Apr 2018 20:34:00 +0100 Message-ID: <87fu3vdjjk.fsf@tcd.ie> NNTP-Posting-Host: blaine.gmane.org Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" X-Trace: blaine.gmane.org 1523907805 2358 195.159.176.226 (16 Apr 2018 19:43:25 GMT) X-Complaints-To: usenet@blaine.gmane.org NNTP-Posting-Date: Mon, 16 Apr 2018 19:43:25 +0000 (UTC) User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/27.0.50 (gnu/linux) To: Original-X-From: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Mon Apr 16 21:43:20 2018 Return-path: Envelope-to: ged-emacs-devel@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 1f8A24-0000VP-AK for ged-emacs-devel@m.gmane.org; Mon, 16 Apr 2018 21:43:20 +0200 Original-Received: from localhost ([::1]:39391 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1f8A4B-0008FZ-4f for ged-emacs-devel@m.gmane.org; Mon, 16 Apr 2018 15:45:31 -0400 Original-Received: from eggs.gnu.org ([2001:4830:134:3::10]:48976) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1f8A24-00077Q-KI for emacs-devel@gnu.org; Mon, 16 Apr 2018 15:43:22 -0400 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1f8A20-0000hl-Jl for emacs-devel@gnu.org; Mon, 16 Apr 2018 15:43:20 -0400 Original-Received: from mail-wr0-x22d.google.com ([2a00:1450:400c:c0c::22d]:43367) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1f8A20-0000fe-1r for emacs-devel@gnu.org; Mon, 16 Apr 2018 15:43:16 -0400 Original-Received: by mail-wr0-x22d.google.com with SMTP id y7so29215089wrh.10 for ; Mon, 16 Apr 2018 12:43:14 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=tcd-ie.20150623.gappssmtp.com; s=20150623; h=from:to:subject:date:mail-followup-to:message-id:user-agent :mime-version; bh=WvphakyGn2IpmlHEiVrmBBRmGr9KR3GDLQj82W8N93g=; b=XOuA52udHMSsEF2iXILp+KItWCij4GeaKTe6MYY5r2sHmzno6mkZbxRQQAQITET4hk 4gu8i5wWvEQAVF1iLZ71Ir6Eya5LeXyUJAJlKXOcYf5yT1/QeQUjdXhEaLvkuKZjBb7v HyfTDNr/VrkvK9UtisoxqurrNpZa2pIUfjBKDgznuq9LZw+0QEWU5+BvheBiC6W3apxW +USScami5LrOWec2i4RDMsW9YCBEs1+58tNpMGNMGvHos/n3h91kEkmdnRIMboOkiafI wT0H24/DOWQPxRJ9vsPnwroTlUXr5hGgDI6lXE7tLubB8/e47vAzdrhLx96FiL0H4hXY AZNg== 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:mail-followup-to:message-id :user-agent:mime-version; bh=WvphakyGn2IpmlHEiVrmBBRmGr9KR3GDLQj82W8N93g=; b=loidJvaXWetVlfhq+xo4mEIGvDpCu6Ya5+CzTojKltnNYLM0tc7ENhQ6/Pm5hlseRm OaFeMrMBzBwMMrv92kJiYuDoMNWDVrXez7cw59sU+UmZXKqEusdb9WFus25mDETaieJs WSHD0Xm5MgTQy/wZvgcHBYsR6sZvGRi+QaFF2ZIprTYIDjxpZhV4QePy7WyDZ4TpBv3w Zo1y2ZBzMSxfjk44gcFiccbD9TXRe6Teu/DIKSlKpkSEX6f9Gjs7FaepREA/cLi80deN xyvAw9rXszhCEiq3mwSlnWKe5M6iUy6aitQJUSvFAvk58ZWQBLzWoNpjBFTBOo0LKLBw HvAw== X-Gm-Message-State: ALQs6tB2e8904Ngp2N3IjzA8qzMr32jPI3Xxp9JFFRjTRaDTPZ6jvZYO oAIlXr8rMMp1R27O5qlcsnHdQcht X-Google-Smtp-Source: AIpwx4+0cIL8OQLazZoyZMRfHdY6iIAY9xWF9D7wP5pcagwrQhC60TCr2fLTnIoPyTLsemr0GLA4pA== X-Received: by 10.80.204.8 with SMTP id m8mr11862728edi.116.1523907793503; Mon, 16 Apr 2018 12:43:13 -0700 (PDT) Original-Received: from localhost ([89.100.107.149]) by smtp.gmail.com with ESMTPSA id w1sm7585158edk.82.2018.04.16.12.43.12 for (version=TLS1_2 cipher=ECDHE-RSA-CHACHA20-POLY1305 bits=256/256); Mon, 16 Apr 2018 12:43:12 -0700 (PDT) Mail-Followup-To: X-detected-operating-system: by eggs.gnu.org: Genre and OS details not recognized. X-Received-From: 2a00:1450:400c:c0c::22d X-BeenThere: emacs-devel@gnu.org X-Mailman-Version: 2.1.21 Precedence: list List-Id: "Emacs development discussions." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Original-Sender: "Emacs-devel" Xref: news.gmane.org gmane.emacs.devel:224671 Archived-At: --=-=-= Content-Type: text/x-diff Content-Disposition: attachment; filename=0001-Add-predicate-list-true-p.patch Content-Description: Add predicate 'list-true-p' >From 15a5e9f48543dc114c2a9fe69fabddd0d41ec24c Mon Sep 17 00:00:00 2001 From: "Basil L. Contovounesios" Date: Mon, 16 Apr 2018 17:47:22 +0100 Subject: [PATCH] Add predicate 'list-true-p' * lisp/subr.el (list-true-p): New function. * doc/lispref/lists.texi (List-related Predicates): * etc/NEWS: Mention it. * lisp/emacs-lisp/byte-opt.el (byte-optimize-if): * lisp/emacs-lisp/cl-macs.el (cl--make-usage-args): * lisp/org/ob-core.el (org-babel-insert-result): Use it. * lisp/format.el (format-proper-list-p): Remove. (format-annotate-single-property-change): Use list-true-p instead. * lisp/emacs-lisp/ert.el (ert--proper-list-p): Remove. (ert--explain-equal-rec): Use list-true-p instead. * test/lisp/emacs-lisp/ert-tests.el (ert-test-proper-list-p): Move from here... * test/lisp/subr-tests.el (subr-tests--list-true-p): ...to here, mutatis mutandis. --- doc/lispref/lists.texi | 16 ++++++++++++ etc/NEWS | 4 +++ lisp/emacs-lisp/byte-opt.el | 3 +-- lisp/emacs-lisp/cl-macs.el | 2 +- lisp/emacs-lisp/ert.el | 22 ++++------------ lisp/format.el | 12 ++------- lisp/org/ob-core.el | 5 ++-- lisp/subr.el | 6 +++++ test/lisp/emacs-lisp/ert-tests.el | 42 ------------------------------- test/lisp/subr-tests.el | 18 +++++++++++++ 10 files changed, 55 insertions(+), 75 deletions(-) diff --git a/doc/lispref/lists.texi b/doc/lispref/lists.texi index 761750eb20..62c14e963a 100644 --- a/doc/lispref/lists.texi +++ b/doc/lispref/lists.texi @@ -153,6 +153,22 @@ List-related Predicates @end example @end defun +@defun list-true-p object +This function returns @code{t} if OBJECT is a true list, @code{nil} +otherwise. In addition to satistying @code{listp}, a true list is +neither circular nor dotted. + +@example +@group +(list-true-p '(1 2 3)) + @result{} t +@end group +@group +(list-true-p '(1 2 . 3)) + @result{} nil +@end group +@end example +@end defun @node List Elements @section Accessing Elements of Lists diff --git a/etc/NEWS b/etc/NEWS index 5aa92e2991..c20b9ade97 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -487,6 +487,10 @@ x-lost-selection-hooks, x-sent-selection-hooks * Lisp Changes in Emacs 27.1 ++++ +** New function 'list-true-p' returns t for true lists which are +neither circular nor dotted. + +++ ** New function assoc-delete-all. diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el index 3bc4c438d6..d62ee2b95c 100644 --- a/lisp/emacs-lisp/byte-opt.el +++ b/lisp/emacs-lisp/byte-opt.el @@ -982,8 +982,7 @@ byte-optimize-if ;; (if nil) ==> (if ) (let ((clause (nth 1 form))) (cond ((and (eq (car-safe clause) 'progn) - ;; `clause' is a proper list. - (null (cdr (last clause)))) + (list-true-p clause)) (if (null (cddr clause)) ;; A trivial `progn'. (byte-optimize-if `(if ,(cadr clause) ,@(nthcdr 2 form))) diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el index 9600230c07..2ed8347ba8 100644 --- a/lisp/emacs-lisp/cl-macs.el +++ b/lisp/emacs-lisp/cl-macs.el @@ -498,7 +498,7 @@ cl--make-usage-args ;; `&aux' args aren't arguments, so let's just drop them from the ;; usage info. (setq arglist (cl-subseq arglist 0 aux)))) - (if (cdr-safe (last arglist)) ;Not a proper list. + (if (not (list-true-p arglist)) (let* ((last (last arglist)) (tail (cdr last))) (unwind-protect diff --git a/lisp/emacs-lisp/ert.el b/lisp/emacs-lisp/ert.el index 32bb367cdb..4134511f5d 100644 --- a/lisp/emacs-lisp/ert.el +++ b/lisp/emacs-lisp/ert.el @@ -472,18 +472,6 @@ ert--should-error-handle-error ;; buffer. Perhaps explanations should be reported through `ert-info' ;; rather than as part of the condition. -(defun ert--proper-list-p (x) - "Return non-nil if X is a proper list, nil otherwise." - (cl-loop - for firstp = t then nil - for fast = x then (cddr fast) - for slow = x then (cdr slow) do - (when (null fast) (cl-return t)) - (when (not (consp fast)) (cl-return nil)) - (when (null (cdr fast)) (cl-return t)) - (when (not (consp (cdr fast))) (cl-return nil)) - (when (and (not firstp) (eq fast slow)) (cl-return nil)))) - (defun ert--explain-format-atom (x) "Format the atom X for `ert--explain-equal'." (pcase x @@ -498,12 +486,12 @@ ert--explain-equal-rec `(different-types ,a ,b) (pcase-exhaustive a ((pred consp) - (let ((a-proper-p (ert--proper-list-p a)) - (b-proper-p (ert--proper-list-p b))) - (if (not (eql (not a-proper-p) (not b-proper-p))) + (let ((a-proper-p (list-true-p a)) + (b-proper-p (list-true-p b))) + (if (not (eq (not a-proper-p) (not b-proper-p))) `(one-list-proper-one-improper ,a ,b) (if a-proper-p - (if (not (equal (length a) (length b))) + (if (/= (length a) (length b)) `(proper-lists-of-different-length ,(length a) ,(length b) ,a ,b first-mismatch-at @@ -523,7 +511,7 @@ ert--explain-equal-rec (cl-assert (equal a b) t) nil)))))))) ((pred arrayp) - (if (not (equal (length a) (length b))) + (if (/= (length a) (length b)) `(arrays-of-different-length ,(length a) ,(length b) ,a ,b ,@(unless (char-table-p a) diff --git a/lisp/format.el b/lisp/format.el index 2f198e3eb7..e5bc60712b 100644 --- a/lisp/format.el +++ b/lisp/format.el @@ -539,14 +539,6 @@ format-make-relatively-unique (setq tail next))) (cons acopy bcopy))) -(defun format-proper-list-p (list) - "Return t if LIST is a proper list. -A proper list is a list ending with a nil cdr, not with an atom " - (when (listp list) - (while (consp list) - (setq list (cdr list))) - (null list))) - (defun format-reorder (items order) "Arrange ITEMS to follow partial ORDER. Elements of ITEMS equal to elements of ORDER will be rearranged @@ -1005,8 +997,8 @@ format-annotate-single-property-change ;; If either old or new is a list, have to treat both that way. (if (and (or (listp old) (listp new)) (not (get prop 'format-list-atomic-p))) - (if (or (not (format-proper-list-p old)) - (not (format-proper-list-p new))) + (if (not (and (list-true-p old) + (list-true-p new))) (format-annotate-atomic-property-change prop-alist old new) (let* ((old (if (listp old) old (list old))) (new (if (listp new) new (list new))) diff --git a/lisp/org/ob-core.el b/lisp/org/ob-core.el index 5d5faaa6fd..f931bb3c31 100644 --- a/lisp/org/ob-core.el +++ b/lisp/org/ob-core.el @@ -2310,10 +2310,9 @@ org-babel-insert-result (lambda (r) ;; Non-nil when result R can be turned into ;; a table. - (and (listp r) - (null (cdr (last r))) + (and (list-true-p r) (cl-every - (lambda (e) (or (atom e) (null (cdr (last e))))) + (lambda (e) (or (atom e) (list-true-p e))) result))))) ;; insert results based on type (cond diff --git a/lisp/subr.el b/lisp/subr.el index 9cf7d596cd..4a0ab321bc 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -548,6 +548,12 @@ nbutlast (if (> n 0) (setcdr (nthcdr (- (1- m) n) list) nil)) list)))) +(defun list-true-p (object) + "Return t if OBJECT is a true list. +A true list is neither circular nor dotted (i.e., its last `cdr' +is nil)." + (null (nthcdr (safe-length object) object))) + (defun zerop (number) "Return t if NUMBER is zero." ;; Used to be in C, but it's pointless since (= 0 n) is faster anyway because diff --git a/test/lisp/emacs-lisp/ert-tests.el b/test/lisp/emacs-lisp/ert-tests.el index e92b434274..cb957bd9fd 100644 --- a/test/lisp/emacs-lisp/ert-tests.el +++ b/test/lisp/emacs-lisp/ert-tests.el @@ -496,48 +496,6 @@ ert-test--which-file ;;; Tests for utility functions. -(ert-deftest ert-test-proper-list-p () - (should (ert--proper-list-p '())) - (should (ert--proper-list-p '(1))) - (should (ert--proper-list-p '(1 2))) - (should (ert--proper-list-p '(1 2 3))) - (should (ert--proper-list-p '(1 2 3 4))) - (should (not (ert--proper-list-p 'a))) - (should (not (ert--proper-list-p '(1 . a)))) - (should (not (ert--proper-list-p '(1 2 . a)))) - (should (not (ert--proper-list-p '(1 2 3 . a)))) - (should (not (ert--proper-list-p '(1 2 3 4 . a)))) - (let ((a (list 1))) - (setf (cdr (last a)) a) - (should (not (ert--proper-list-p a)))) - (let ((a (list 1 2))) - (setf (cdr (last a)) a) - (should (not (ert--proper-list-p a)))) - (let ((a (list 1 2 3))) - (setf (cdr (last a)) a) - (should (not (ert--proper-list-p a)))) - (let ((a (list 1 2 3 4))) - (setf (cdr (last a)) a) - (should (not (ert--proper-list-p a)))) - (let ((a (list 1 2))) - (setf (cdr (last a)) (cdr a)) - (should (not (ert--proper-list-p a)))) - (let ((a (list 1 2 3))) - (setf (cdr (last a)) (cdr a)) - (should (not (ert--proper-list-p a)))) - (let ((a (list 1 2 3 4))) - (setf (cdr (last a)) (cdr a)) - (should (not (ert--proper-list-p a)))) - (let ((a (list 1 2 3))) - (setf (cdr (last a)) (cddr a)) - (should (not (ert--proper-list-p a)))) - (let ((a (list 1 2 3 4))) - (setf (cdr (last a)) (cddr a)) - (should (not (ert--proper-list-p a)))) - (let ((a (list 1 2 3 4))) - (setf (cdr (last a)) (cl-cdddr a)) - (should (not (ert--proper-list-p a))))) - (ert-deftest ert-test-parse-keys-and-body () (should (equal (ert--parse-keys-and-body '(foo)) '(nil (foo)))) (should (equal (ert--parse-keys-and-body '(:bar foo)) '((:bar foo) nil))) diff --git a/test/lisp/subr-tests.el b/test/lisp/subr-tests.el index 52b61d9fb9..63fe7ee139 100644 --- a/test/lisp/subr-tests.el +++ b/test/lisp/subr-tests.el @@ -306,6 +306,24 @@ subr-test--frames-1 (should (eq (string-to-char (symbol-name (gensym))) ?g)) (should (eq (string-to-char (symbol-name (gensym "X"))) ?X))) +(ert-deftest subr-tests--list-true-p () + "Test `list-true-p' behavior." + (dotimes (length 4) + ;; True and dotted lists + (let ((list (make-list length 0))) + (should (list-true-p list)) + (should (not (list-true-p (nconc list 0))))) + ;; Circular lists + (dotimes (n (1+ length)) + (let ((circle (make-list (1+ length) 0))) + (should (not (list-true-p (nconc circle (nthcdr n circle)))))))) + ;; Atoms + (should (not (list-true-p 0))) + (should (not (list-true-p ""))) + (should (not (list-true-p []))) + (should (not (list-true-p (make-bool-vector 0 nil)))) + (should (not (list-true-p (make-symbol "a"))))) + (ert-deftest subr-tests--assq-delete-all () "Test `assq-delete-all' behavior." (cl-flet ((new-list-fn -- 2.17.0 --=-=-= Content-Type: application/emacs-lisp Content-Disposition: attachment; filename=bench-list-true-p.el Content-Transfer-Encoding: quoted-printable Content-Description: Benchmark for 'list-true-p' (require 'ert) (setq lexical-binding t) (defun list-true-p (object) "Return t if OBJECT is a true list. A true list is neither circular nor dotted (i.e., its last `cdr' is nil)." (null (nthcdr (safe-length object) object))) (byte-compile #'list-true-p) (let* ((length 64) (reps 100000) (true (make-list length 0)) (dotted (append true 0)) (circular (nconc (copy-sequence true) (nthcdr (/ length 2) true))) (lists (list true dotted circular)) (format "`%s'\n true %s\n dotted %s\n circular %s") (bench (lambda (fn) (apply #'message format fn (mapcar (lambda (list) (benchmark-run reps (funcall fn list))) lists))))) (garbage-collect) (mapc bench (list #'format-proper-list-p #'ert--proper-list-p #'list-true-p))) --=-=-= Content-Type: text/plain; charset=utf-8 Content-Transfer-Encoding: quoted-printable A while ago, I added a little convenience function to my init file[1] to determine whether a given object is a true list (as opposed to a circular or dotted one): (null (nthcdr (safe-length object) object)) [1]: https://github.com/basil-conto/dotfiles/blob/96aeb904a6fd94d9fbcf95483= fd4f79194e90592/.emacs.d/lisp/blc-lib.el#L46-L49 Since then, I have noticed variations of this predicate/condition strewn around the Emacs sources, albeit usually implemented less efficiently. Would such a predicate be a welcome addition to, say, subr.el or subr-x.el? I attach a first draft of a patch targeting subr.el for your consideration. Also attached is a toy benchmark comparing the new function list-true-p with the existing format-proper-list-p and ert--proper-list-p when given, in turn, a true, dotted, and circular list as argument. It prints the following, after a couple of runs: =E2=80=98format-proper-list-p=E2=80=99 true (0.16966186900000002 0 0.0) dotted (0.168859839 0 0.0) circular (0.244791363 0 0.0) =E2=80=98ert--proper-list-p=E2=80=99 true (0.622797443 0 0.0) dotted (0.621622385 0 0.0) circular (0.9150398590000001 0 0.0) =E2=80=98list-true-p=E2=80=99 true (0.042970005000000006 0 0.0) dotted (0.04294060500000001 0 0.0) circular (0.057346661 0 0.0) P.S. What is the preferred way of formatting car/cdr in docstrings? The manuals seem to use small caps CAR/CDR and subr.el seems to alternate between no quotes and `car'/`cdr'. I have gone with the latter for the docstring of list-true-p, at least for now. Thanks, --=20 Basil --=-=-=--