Re: [PATCH] Add new lisp function length= with bytecode support

[Gdobbins <gdobbins@protonmail.com>]

[-- Attachment #1.1: Type: text/plain, Size: 502 bytes --]

Attached is a new patch which implements length= and the <, >, <=, >= variants in lisp. They aren't as efficient as the length= from the previous patch, especially in cases like (length= list1 list2). Since these functions can't share a bytecode with their non-length counterparts I don't know whether the trade off of a compiler macro for them is worth it. With the lisp functions the resulting bytecode would be both larger, and if none of the sequences are lists, slower as well.


-- Graham Dobbins

[-- Attachment #1.2: Type: text/html, Size: 655 bytes --]

[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-Add-new-lisp-functions-length-and-related.patch --]
[-- Type: text/x-patch; name="0001-Add-new-lisp-functions-length-and-related.patch", Size: 3580 bytes --]

From 93d18bb9a66d2a8c07552daadab62dc5b7885fb9 Mon Sep 17 00:00:00 2001
From: Graham Dobbins <gdobbins@protonmail.com>
Date: Mon, 6 Mar 2017 19:13:12 -0500
Subject: [PATCH] Add new lisp functions length= and related

* lisp/subr.el (length=, length<, length>, length<=, length>=): define new
functions.
---
 etc/NEWS     |  4 ++++
 lisp/subr.el | 51 +++++++++++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 55 insertions(+)

diff --git a/etc/NEWS b/etc/NEWS
index 8f7356f3e0..33873cc076 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -997,6 +997,10 @@ that does not exist.
 operating recursively and when some other process deletes the directory
 or its files before 'delete-directory' gets to them.
 
+---
+** The new functions 'length=', 'length<', 'length>', 'length<=', and
+'length>=' allow for comparison of sequence lengths with numbers.
+
 ** Changes in Frame- and Window- Handling
 
 +++
diff --git a/lisp/subr.el b/lisp/subr.el
index 6b0403890c..0dd293bb7b 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -533,6 +533,57 @@ nbutlast
 	   (if (> n 0) (setcdr (nthcdr (- (1- m) n) list) nil))
 	   list))))
 
+(defmacro internal--length-compare (comparison tail-compare-or-swap
+                                    &optional tail-adjust)
+  `(defun ,(intern (concat "length" (symbol-name comparison)))
+       (&rest sequences)
+     ,(concat "Compare the lengths of sequences with numbers.
+Return t if the length of each sequence or number is `"
+              (symbol-name comparison)
+              "' to all\nfollowing sequences or numbers, otherwise nil.
+
+This function is more efficient if its "
+              (if (symbolp tail-compare-or-swap) "last" "first")
+              " argument is a non-list.")
+     ,(if (symbolp tail-compare-or-swap)
+          `(apply #',(intern (concat "length" (symbol-name tail-compare-or-swap)))
+                (nreverse sequences))
+        `(let* ((val (pop sequences))
+                (val (if (numberp val)
+                         val
+                       (length val)))
+                (res t)
+                ,@(when tail-adjust
+                    '((num (length sequences)))))
+           (dolist (seq sequences res)
+             (when res
+               ,@(when tail-adjust
+                   '((setq num (1- num))))
+               (setq res
+                     (cond
+                       ((numberp seq)
+                        (prog1 (,comparison val seq)
+                          (setq val seq)))
+                       ((consp seq)
+                        (let ((tail (nthcdr (1- val) seq)))
+                          ,(if tail-adjust
+                               `(prog1
+                                    ,tail-compare-or-swap
+                                  (when (> num 0)
+                                    ,tail-adjust))
+                             tail-compare-or-swap)))
+                       (t (let ((len (length seq)))
+                            (prog1 (,comparison val len)
+                              (setq val len))))))))))))
+
+(internal--length-compare = (and (consp tail) (not (cdr tail))))
+(internal--length-compare < (and (consp tail) (consp (cdr tail)))
+                          (setq val (+ val (1- (length tail)))))
+(internal--length-compare > <)
+(internal--length-compare <= (consp tail)
+                          (setq val (+ val (1- (length tail)))))
+(internal--length-compare >= <=)
+
 (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
-- 
2.12.0