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: Re: Predicate for true lists Date: Mon, 04 Jun 2018 13:12:32 +0100 Message-ID: <87bmcqhhsf.fsf@tcd.ie> References: <87fu3vdjjk.fsf@tcd.ie> NNTP-Posting-Host: blaine.gmane.org Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" X-Trace: blaine.gmane.org 1528114353 29254 195.159.176.226 (4 Jun 2018 12:12:33 GMT) X-Complaints-To: usenet@blaine.gmane.org NNTP-Posting-Date: Mon, 4 Jun 2018 12:12:33 +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 Jun 04 14:12:29 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 1fPoLb-0007UH-HG for ged-emacs-devel@m.gmane.org; Mon, 04 Jun 2018 14:12:27 +0200 Original-Received: from localhost ([::1]:39434 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1fPoNi-0003kO-G3 for ged-emacs-devel@m.gmane.org; Mon, 04 Jun 2018 08:14:38 -0400 Original-Received: from eggs.gnu.org ([2001:4830:134:3::10]:48694) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1fPoLp-0002oV-7r for emacs-devel@gnu.org; Mon, 04 Jun 2018 08:12:43 -0400 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1fPoLl-0006Q3-Rb for emacs-devel@gnu.org; Mon, 04 Jun 2018 08:12:41 -0400 Original-Received: from mail-wm0-x235.google.com ([2a00:1450:400c:c09::235]:55501) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1fPoLl-0006PP-9d for emacs-devel@gnu.org; Mon, 04 Jun 2018 08:12:37 -0400 Original-Received: by mail-wm0-x235.google.com with SMTP id v16-v6so8603384wmh.5 for ; Mon, 04 Jun 2018 05:12:36 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=tcd-ie.20150623.gappssmtp.com; s=20150623; h=from:to:subject:references:date:in-reply-to:message-id:user-agent :mime-version; bh=aQqeW0uQntykvYvxhkKqilrqExYgR67iFGdN5a8WHNA=; b=CvLJD8NbyolXqrK9g6yPnXXm9G7pcgXBSk+vw91e9LJ71qrs+cbcfFHyxWNjUaHiTF T8fK78hMcszEsGGWa8xtrkCYWFZ5sL4mpzH6TjeJhICDldKeMVN+0T3Vab0774+7dwcs ZxAYpI9W6IFpBixyWY2rWLTDyt7b0jlWN3oOraXKNS8Xbsm+1mS29MFa6IKnPr7ILjAv INB9Sjwcr1nWVchLuOHr/v31tK8M+HyLCE5L8k67+ulElv/RVHiyookrAAvzroIgrKm6 4rPm08dvtLIBAuzZYQvFdKJmdvvyn+LKHGSUvgk+9hUCx/PIArl8KI2Wxwtidbgs7W6H Kz3Q== 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:references:date:in-reply-to :message-id:user-agent:mime-version; bh=aQqeW0uQntykvYvxhkKqilrqExYgR67iFGdN5a8WHNA=; b=h1RY/csdH2wUcdFGRNrWwppibKR2ZmgSKAHvE9uHvaQpof9Pf3IEDSP+SnN3DaHsl4 KhmI15TqDIzWreLQcVlFjOPBXcDq1R/jo4OLujSfunARLZ/GFHmmLYsVpNJ7iknDn4wp 2WHTYBK/MB5pL7KZfl+iTwlKOvq3ZpS2lt2+xaTS8laobCGN6l7e4+8+eulivCBZFejR 9RoaoaUOGIUVIyWOEBBmRegpgmRKSSnmHG3PbQyAdyjPnWsFYMyF1Vb1yTnBzeTle4d1 4hNganMIktGro2JlYsHu0Qh+fI+OpU9mYbyjkuLAVJ7dwCZYMF4vETVLmngj1Y4EfwCH emEA== X-Gm-Message-State: ALKqPwcaY22VaFQN+aznqwygrp//oUgQ+3R2WA9OiPbApjxaNmHyx8Wj HyAB5VvNcRrV/t0W3PprP8WfPcEt X-Google-Smtp-Source: ADUXVKKIQbiABZyQNuhf716Wi8VG5FeV8u7nl5zWyZGzpybr6EDDJ/d0NB+228FZJSeV2Ey4ryqi+g== X-Received: by 2002:a50:e441:: with SMTP id e1-v6mr15296904edm.4.1528114355277; Mon, 04 Jun 2018 05:12:35 -0700 (PDT) Original-Received: from localhost ([213.233.149.6]) by smtp.gmail.com with ESMTPSA id m42-v6sm1137616edc.94.2018.06.04.05.12.33 for (version=TLS1_2 cipher=ECDHE-RSA-CHACHA20-POLY1305 bits=256/256); Mon, 04 Jun 2018 05:12:34 -0700 (PDT) In-Reply-To: <87fu3vdjjk.fsf@tcd.ie> (Basil L. Contovounesios's message of "Mon, 16 Apr 2018 20:34:00 +0100") X-detected-operating-system: by eggs.gnu.org: Genre and OS details not recognized. X-Received-From: 2a00:1450:400c:c09::235 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:225989 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 4264c2d5bb40bc5ceb86acb07c0fdc41f6365399 Mon Sep 17 00:00:00 2001 From: "Basil L. Contovounesios" Date: Mon, 4 Jun 2018 12:56:41 +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 1b324986d9..a357d8b0f0 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -561,6 +561,10 @@ manual for more details. * 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 d7e4b4e611..8ad4c053db 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 914112ccef..7090053b5c 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..b7675ec54d 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.1 --=-=-= Content-Type: application/emacs-lisp Content-Disposition: attachment; filename=bench.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* ((reps 100000) (length 64) (true (make-list length 0)) (dotted (append true 0)) (circular (nconc (copy-sequence true) (nthcdr (/ length 2) true))) (lists (list true dotted circular))) (dolist (fn '(list-true-p format-proper-list-p ert--proper-list-p)) (apply #'message "`%s'\n true %s\n dotted %s\n circular %s" fn (mapcar (lambda (list) (garbage-collect) (benchmark-run reps (funcall fn list))) lists)))) --=-=-= Content-Type: text/plain; charset=utf-8 Content-Transfer-Encoding: quoted-printable "Basil L. Contovounesios" writes: > 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/96aeb904a6fd94d9fbcf954= 83fd4f79194e90592/.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. Any interest in or comments on this proposal? Should I submit a wishlist bug report for this instead? Thanks, --=20 Basil --=-=-=--