diff options
Diffstat (limited to 'lisp')
| -rw-r--r-- | lisp/emacs-lisp/byte-opt.el | 3 | ||||
| -rw-r--r-- | lisp/emacs-lisp/cl-macs.el | 2 | ||||
| -rw-r--r-- | lisp/emacs-lisp/ert.el | 28 | ||||
| -rw-r--r-- | lisp/format.el | 12 | ||||
| -rw-r--r-- | lisp/org/ob-core.el | 5 | ||||
| -rw-r--r-- | lisp/subr.el | 6 |
6 files changed, 20 insertions, 36 deletions
diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el index 3bc4c438d6a..5c0b5e340bb 100644 --- a/lisp/emacs-lisp/byte-opt.el +++ b/lisp/emacs-lisp/byte-opt.el @@ -982,8 +982,7 @@ ;; (if <test> <then> nil) ==> (if <test> <then>) (let ((clause (nth 1 form))) (cond ((and (eq (car-safe clause) 'progn) - ;; `clause' is a proper list. - (null (cdr (last clause)))) + (proper-list-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 b50961adac9..011965acb54 100644 --- a/lisp/emacs-lisp/cl-macs.el +++ b/lisp/emacs-lisp/cl-macs.el @@ -498,7 +498,7 @@ its argument list allows full Common Lisp conventions." ;; `&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 (proper-list-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 32bb367cdb3..cad21044f15 100644 --- a/lisp/emacs-lisp/ert.el +++ b/lisp/emacs-lisp/ert.el @@ -472,18 +472,6 @@ Errors during evaluation are caught and handled like nil." ;; 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 @@ -494,17 +482,17 @@ Errors during evaluation are caught and handled like nil." (defun ert--explain-equal-rec (a b) "Return a programmer-readable explanation of why A and B are not `equal'. Returns nil if they are." - (if (not (equal (type-of a) (type-of b))) + (if (not (eq (type-of a) (type-of b))) `(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-length (proper-list-p a)) + (b-length (proper-list-p b))) + (if (not (eq (not a-length) (not b-length))) `(one-list-proper-one-improper ,a ,b) - (if a-proper-p - (if (not (equal (length a) (length b))) - `(proper-lists-of-different-length ,(length a) ,(length b) + (if a-length + (if (/= a-length b-length) + `(proper-lists-of-different-length ,a-length ,b-length ,a ,b first-mismatch-at ,(cl-mismatch a b :test 'equal)) @@ -523,7 +511,7 @@ Returns nil if they are." (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 2f198e3eb71..1222abbf658 100644 --- a/lisp/format.el +++ b/lisp/format.el @@ -539,14 +539,6 @@ Compare using `equal'." (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 @@ either strings, or lists of the form (PARAMETER VALUE)." ;; 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 (proper-list-p old) + (proper-list-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 5d5faaa6fd0..a5449fe35e9 100644 --- a/lisp/org/ob-core.el +++ b/lisp/org/ob-core.el @@ -2310,10 +2310,9 @@ INFO may provide the values of these header arguments (in the (lambda (r) ;; Non-nil when result R can be turned into ;; a table. - (and (listp r) - (null (cdr (last r))) + (and (proper-list-p r) (cl-every - (lambda (e) (or (atom e) (null (cdr (last e))))) + (lambda (e) (or (atom e) (proper-list-p e))) result))))) ;; insert results based on type (cond diff --git a/lisp/subr.el b/lisp/subr.el index ca184d8fc81..c1d90e3fb18 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -555,6 +555,12 @@ If N is omitted or nil, remove the last element." (declare (compiler-macro (lambda (_) `(= 0 ,number)))) (= 0 number)) +(defun proper-list-p (object) + "Return OBJECT's length if it is a proper list, nil otherwise. +A proper list is neither circular nor dotted (i.e., its last cdr +is nil)." + (and (listp object) (ignore-errors (length object)))) + (defun delete-dups (list) "Destructively remove `equal' duplicates from LIST. Store the result in LIST and return it. LIST must be a proper list. |