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

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

[Constantin Kulikov]

[-- Attachment #1: Type: text/plain, Size: 487 bytes --]

Why not `length-cmp' which will -1 if less, 0 if equal, 1 if greater?

(defun length-cmp (seq n)
  (let* ((len (if seq (if (consp seq)
                          (let ((tlen 0))
                            (while (and seq (< tlen (1+ n)))
                              (incf tlen) (setq seq (cdr seq)))
                            tlen)
                        (length seq))
                0)))
    (if (< len n) -1 (if (> len n) 1 0))))


All other functions can be build on top of it.

[-- Attachment #2: Type: text/html, Size: 1275 bytes --]

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

[Gdobbins]

[-- Attachment #1: Type: text/plain, Size: 3063 bytes --]

> Why not `length-cmp' which will -1 if less, 0 if equal, 1 if greater?

Traversing lists on the lisp side with cdr is much slower than the nthcdr approach. I'm also not sure what using a helper function gains, the macro I wrote in the last patch defines all of them directly.

This is beginning to feel like bike-shedding. Would one of the maintainers like to make a decision about how to implement this? I've already spent far more time than I wanted implementing this minor bit of functionality 3 different ways, I'd like it if one could be picked and then if necessary minor corrections to it can then be made. As I see it there are 4 ways of going about this:

1. Implement length= and related in C. With the accompanying modifications to the byte-interpreter and compiler, this would be the most efficient in terms of faster execution and smaller bytecode.

2.. Implement everything in lisp. This wouldn't be nearly as efficient since the changes to the byte-interpreter can't be made, but would be an improvement for cases like (length= number list). Cases like (length= list1 list2) will suffer the most from a lisp definition. I don't think a compiler macro for = and related would be a good idea in this case since it would increase the size of .elc files and would be slower if none of the arguments are lists.

3. Implement the two argument forms (like length_eqlsign2 in the patch before last) in C and change the bytecode interpreter to use them, but implement the &rest forms in lisp like in the last patch. This would give most of the benefits of the first option while also having a lisp definition of the functions but letting byte-compiled code be transformed into the faster C version. The major drawback of this approach would be having two different implementations of the same functionality in different places, potentially making the code harder to maintain and debug. But with appropriate comments in place at both locations and proper tests for both I think this can be made negligible.

4. As in option 3 but length_eqlsign2 could be promoted to a full-fledged lisp function (with the prefix internal--) and the &rest form could be defined in lisp in terms of it. This would mitigate the major drawback of option 3 at the cost of exposing a C defined function into lisp, even if it is only for internal use. As in option 3 this option would be less efficient than option 1 only for forms with more than two arguments like (length< list1 list2 list3).

To summarize:
Option 1 will result in the overall fastest execution time.
Option 3 will result in most of that improvement and satisfy the condition of not defining any new lisp functions in C.
Option 4 has the same amount of improvement as 3 but defines an internally used lisp function in C to possibly mitigate bugs.
Option 2 is the slowest by far with the only benefit being no changes at all to the C sources.

Option 3 would seem to best accommodate everyone's desires. I'm happy to implement it, but only after I get confirmation that it will be acceptable.


-- Graham Dobbins

[-- Attachment #2: Type: text/html, Size: 3577 bytes --]

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

[Stefan Monnier]

> This is beginning to feel like bike-shedding.

Indeed.  I guess part of the problem is a lack of direction: is there
some benchmark or test case that drives your desire to add that bytecode?

You say that you've found a large proportion of calls to `length` where
the result is then compared to a number, so it could be sped up.  I do
not doubt that it is the case, but the question is whether this speed up
makes a difference in practice.  If it does, then we can compare the
different options.

BTW, AFAIK there are 4 options (in order of increasing performance):
- leave things as they are.
- implement length= in Elisp.
- implement length= in C (but without dedicating a bytecode to it).
- implement length= as a bytecode.


        Stefan

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

[Gdobbins]

[-- Attachment #1: Type: text/plain, Size: 1849 bytes --]

> is there some benchmark or test case that drives your desire to add that bytecode?

I don't have a specific benchmark in mind, but I did some tests with `benchmark-run` before I submitted the first patch to see how much faster it was. I remember the break even point between length= in C without a bytecode and just using = and length in byte-compiled code being somewhat high, on the order of 100. It is also necessarily slower when none of the arguments are lists. So it is difficult to know whether converting such cases to length= with a compiler macro is worth while since I don't know the average length of lists which are being compared this way, but I suspect it isn't. Compounding the issue would be the increase in size of the .elc files.

> but without dedicating a bytecode to it

I didn't actually add a bytecode. Instead I re-purposed the = bytecode to handle both cases, since (= list1 list2) isn't acceptable anyway. Because of this you actually get a bytecode for length= for free. Done this way length= always beats = and length separately. Plus, the .elc files actually get smaller since two bytecodes (= and length) are replaced with one (= alone).

The only real downside to overloading this bytecode is a loss of type-checking to =. To compensate and aid in debugging any issues caused by this I made the compiler surround all the arguments to = with nonsense additions of 0 to regain the type-checking when `byte-compile-delete-errors` was nil. Consequently I changed that variables default value to t, otherwise you've lost more than you've gained by doing this.

So I suppose the first real issue is whether or not that change to `byte-compile-delete-errors` is acceptable, or using some alternative option which defaults to allowing = to be byte-compiled with this loss of type-checking is acceptable.


-- Graham Dobbins

[-- Attachment #2: Type: text/html, Size: 2141 bytes --]

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

[Stefan Monnier]

>> is there some benchmark or test case that drives your desire to add
>> that bytecode?
> I don't have a specific benchmark in mind, but I did some tests with
> `benchmark-run` before I submitted the first patch to see how much
> faster it was.

I don't doubt it is faster in some tests, but that doesn't mean it will
make any difference to real world code.

> I didn't actually add a bytecode. Instead I re-purposed the = bytecode to
> handle both cases, since (= list1 list2) isn't acceptable anyway.

So you haven't really introduced a new `length=` but instead you've
changed the `=` function to (conceptually) coerce lists to their length.

> The only real downside to overloading this bytecode is a loss of
> type-checking to =.

You mean, the downside is that's an incompatible change.

> To compensate and aid in debugging any issues caused by
> this I made the compiler surround all the arguments to = with nonsense
> additions of 0 to regain the type-checking when `byte-compile-delete-errors`
> was nil. Consequently I changed that variables default value to t, otherwise
> you've lost more than you've gained by doing this.

These sound like ugly hacks.  I think it's better to take
your change upfront: make an incompatible change to `=` such that
`length` is automatically called on each argument if it's a list.

After all, we already coerce markers to ints, so it's not completely out
of place to coerce lists to ints (in the form of their length).

Furthermore, this could be seen as an improvement for package authors
(by making `=` more powerful), so it has merit regardless of whether or
not it makes a measurable difference to efficiency.

> So I suppose the first real issue is whether or not that change to
> `byte-compile-delete-errors` is acceptable,

It's not even the right question: your change modifies the behavior of
code compiled on earlier Emacsen as well and no amount of setting
byte-compile-delete-error will let the user recover the previous
behavior (at least until she recompiles the code).

If the backward-incompatible change of `=` is not considered acceptable,
then you'll either need a new bytecode, or live with a non-bytecode
C function.


        Stefan

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

[Gdobbins]

[-- Attachment #1: Type: text/plain, Size: 1963 bytes --]

> I think it's better to take
> your change upfront: make an incompatible change to `=` such that
> `length` is automatically called on each argument if it's a list.

That's a judgement call I can't make. I will point out though that it is more incompatible than the change I've proposed, since there wouldn't be any way to get the old behavior back (even if it took recompiling). There was also contention with my original length= for accepting markers and floats, citing confusion. Personally I would think coercing sequences to their lengths in = would be even more confusing.

> Furthermore, this could be seen as an improvement for package authors
> (by making `=` more powerful), so it has merit regardless of whether or
> not it makes a measurable difference to efficiency.

I guess, but is it really any more powerful than a separate length=? If length= were to go back to accepting floats and markers it would then be an = which coerces lengths to ints. What about the other comparison operators <,> etc. that were previously asked for, should they be changed as well? My original intention with this patch was just to port length= from CL which I already do find useful.

> If the backward-incompatible change of `=` is not considered acceptable,
> then you'll either need a new bytecode, or live with a non-bytecode
> C function.

It really doesn't matter to me. I expected there to be objections to that change, which is why I put them in a separate commit from defining length= in the original patch I submitted. Since most of my first message was about the changes to the bytecode and no-one mentioned anything about it I assumed it was acceptable.

Since it's being discussed, a single new bytecode should be able to encompass all of the length=, length<, etc. functions if it's decided to go that route. As I've stated previously around 50% of all calls to length are then fed straight into =, <.>, etc., so it may be worth it.


-- Graham Dobbins

[-- Attachment #2: Type: text/html, Size: 2544 bytes --]

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

[Stefan Monnier]

>> I think it's better to take
>> your change upfront: make an incompatible change to `=` such that
>> `length` is automatically called on each argument if it's a list.
> That's a judgement call I can't make. I will point out though that it is
> more incompatible than the change I've proposed, since there wouldn't be any
> way to get the old behavior back (even if it took recompiling).

Indeed, it's a bit more incompatible.  But it's easier to describe the
incompatibility: in your case it occurs in some cases and not in others,
depending a whether something is byte-compiled or not and with which
Emacs and which value of some fairly obscure compilation flag.

> Personally I would think coercing sequences to their lengths in =
> would be even more confusing.

Could be, indeed.  But in any case, that's what your code does, so
better be prepared to defend this choice ;-)

>> Furthermore, this could be seen as an improvement for package authors
>> (by making `=` more powerful), so it has merit regardless of whether or
>> not it makes a measurable difference to efficiency.
> I guess, but is it really any more powerful than a separate length=?

I don't know.  I didn't mean to promote this change.  I was just
pointing out that (as maintainer) I'd be more willing to accept such an
upfront change, than one that introduces an incompatibility in more
sneaky ways.  I'm not sure I'd accept either of them.

> Since it's being discussed, a single new bytecode should be able to
> encompass all of the length=, length<, etc. functions if it's decided to go
> that route. As I've stated previously around 50% of all calls to length are
> then fed straight into =, <.>, etc., so it may be worth it.

That might be a better option, with more visible effects.  The issue is
that bytecode space is limited (and very difficult to recover later on),
so I'd be reluctant to add new bytecodes without some clear benefit.
So some real-life measurements of speed up would go a long way.


        Stefan

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

[Gdobbins]

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

The attatched patch has two commits. The first implements a new lisp function, length=, which acts the same as the function of the same name from the Common Lisp package Alexandria. Namely it compares the length of sequences with numbers. The second modifies the byte interpreter to treat = the same as length=, and the byte compiler to generate the appropriate code. By greping the Emacs repo's *.el files and comparing to *.elc files after compiling with the compiler-macro in the second commit of this patch, I estimate 14% of all calls to length in Emacs are then simply compared via =. This makes length= quite useful, and since a large amount of linked list traversal can be avoided, potentially more efficient.

Part of that efficiency comes from modifying the byte interpreter, the downside of which is the loss of some type checking in calls to equal. The type checking is therefore done in the byte code itself if byte-compile-delete-errors is null. For this reason I have changed that var to be t by default and changed one of its uses to rely instead on byte-compile-warnings. Incidentally some of the MELPA packages I have installed are (perhaps improperly) globally setting byte-compile-delete-errors to t, resulting in all of my installed packages to be compiled with that setting.

If it is decided that byte-compile-delete-errors should not be changed, then I don't think the other changes in the second commit are worth while unless a separate option which allows the change is used instead. Otherwise the resulting byte code for = would be larger and calls to it would be slower, and = is used about 10 times more often than length= would be in the Emacs repo.


-- Graham Dobbins

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

[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: length=.patch --]
[-- Type: text/x-patch; name="length=.patch", Size: 16892 bytes --]

From 8e287237218b0c8c98e76ffb413a9056aa564e97 Mon Sep 17 00:00:00 2001
From: Graham Dobbins <gdobbins@protonmail.com>
Date: Sun, 26 Feb 2017 13:06:50 -0500
Subject: [PATCH 1/2] Add new lisp function length=

* src/fns.c (Flength_eqlsign): define length= function.
* test/src/fns-tests.el: add tests.
---
 etc/NEWS              |   4 ++
 src/fns.c             | 104 ++++++++++++++++++++++++++++++++++++++++++++++++++
 test/src/fns-tests.el |  17 +++++++++
 3 files changed, 125 insertions(+)

diff --git a/etc/NEWS b/etc/NEWS
index 31b7e4789e..6abcda729b 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -970,6 +970,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 function 'length=' compares the lengths of sequences and
+numbers.
+
 ** Changes in Frame- and Window- Handling
 
 +++
diff --git a/src/fns.c b/src/fns.c
index 0b694529c5..8de7495841 100644
--- a/src/fns.c
+++ b/src/fns.c
@@ -137,6 +137,109 @@ which is at least the number of distinct elements.  */)
   return make_fixnum_or_float (len);
 }
 
+DEFUN ("length=", Flength_eqlsign, Slength_eqlsign, 1, MANY, 0,
+       doc: /* Each element of SEQUENCES may be any type accepted by
+`length' or `='.  True if the length of each sequence is equal to each
+number, otherwise returns nil.
+usage: (length= &rest SEQUENCES) */)
+  (ptrdiff_t nargs, Lisp_Object *args)
+{
+
+  Lisp_Object val = Qnil;
+
+  Lisp_Object temp_list = Qnil;
+  ptrdiff_t temp_list_i = 0;
+
+  /* First check non list sequences, length stored in val or bail if
+     inconsistency found.  */
+  for (ptrdiff_t argnum = 0; argnum < nargs; argnum++)
+    {
+      if (Fnumber_or_marker_p (args[argnum]))
+	{
+	  if (NILP (val))
+	    {
+	      val = args[argnum];
+	      CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (val);
+	    }
+	  else if (! CALLN (Feqlsign, val, args[argnum]))
+	    return Qnil;
+
+	  args[argnum] = Qnil;
+	}
+      else if (CONSP (args[argnum]))
+	{
+	  if (NILP (temp_list))
+	    {
+	      temp_list = args[argnum];
+	      temp_list_i = argnum;
+	    }
+	}
+      else
+	{
+	  if (NILP (val))
+	    val = Flength (args[argnum]);
+	  else if (! CALLN (Feqlsign, val, Flength (args[argnum])))
+	    return Qnil;
+
+	  args[argnum] = Qnil;
+	}
+    }
+
+  /* Now jointly iterate over the lists if there are any.  Bail if any
+     lengths don't match.  */
+  if (CONSP (temp_list))
+    {
+      temp_list_i++;
+
+      intptr_t n = 0;
+      if (NILP (val))
+	n = MOST_POSITIVE_FIXNUM;
+      else if (FLOATP (val))
+	if (XFLOAT_DATA (val) - (intptr_t) XFLOAT_DATA (val) == 0)
+	  n = (XFLOAT_DATA (val));
+	else
+	  return Qnil;
+      else
+	n = XINT (val);
+
+      int done = 0;
+      intptr_t i = 0;
+      FOR_EACH_TAIL (temp_list)
+	{
+	  i++;
+	  if (done || i > n)
+	    return Qnil;
+	  for (ptrdiff_t argnum = temp_list_i; argnum < nargs; argnum++)
+	    {
+	      if (! NILP (args[argnum]))
+		{
+		  args[argnum] = (XCDR (args[argnum]));
+		  if (! CONSP (args[argnum]))
+		    {
+		      CHECK_LIST_END (args[argnum], args[argnum]);
+		      done = 1;
+		    }
+		}
+	    }
+	}
+      if (i != n && ! NILP (val))
+	return Qnil;
+      for (ptrdiff_t argnum = temp_list_i; argnum < nargs; argnum++)
+	{
+	  if (! NILP (args[argnum]))
+	    return Qnil;
+	}
+      CHECK_LIST_END (temp_list, temp_list);
+      if (NILP (val))
+	return Qt;
+    }
+
+  if (! NILP (val))
+    val = Qt;
+
+  return val;
+}
+
 DEFUN ("string-bytes", Fstring_bytes, Sstring_bytes, 1, 1, 0,
        doc: /* Return the number of bytes in STRING.
 If STRING is multibyte, this may be greater than the length of STRING.  */)
@@ -5073,6 +5176,7 @@ this variable.  */);
   defsubr (&Sidentity);
   defsubr (&Srandom);
   defsubr (&Slength);
+  defsubr (&Slength_eqlsign);
   defsubr (&Ssafe_length);
   defsubr (&Sstring_bytes);
   defsubr (&Sstring_equal);
diff --git a/test/src/fns-tests.el b/test/src/fns-tests.el
index a1b48a643e..5661ef2019 100644
--- a/test/src/fns-tests.el
+++ b/test/src/fns-tests.el
@@ -246,6 +246,13 @@ fns-tests--collate-enabled-p
     (should (equal (mapcan #'identity data) '(foo bar)))
     (should (equal data                     '((foo bar) (bar))))))
 
+(ert-deftest fns-tests-length= ()
+  (should (length= 2 '(3 4) (vector 5 6)))
+  (should (length= '(1 2) '(3 4)))
+  (should-not (length= 3 '(1 2)))
+  (should-not (length= '(1 2) '(1 2 3)))
+  (should-not (length= '(1 2) 2.1)))
+
 ;; Test handling of cyclic and dotted lists.
 
 (defun cyc1 (a)
@@ -284,6 +291,16 @@ dot2
   (should (= 10 (safe-length (dot1 1))))
   (should (= 20 (safe-length (dot2 1 2)))))
 
+(ert-deftest test-cycle-length= ()
+  (should-error (length= (cyc1 1)) :type 'circular-list)
+  (should-error (length= (cyc2 1 2)) :type 'circular-list)
+  (should-error (length= (dot1 1)) :type 'wrong-type-argument)
+  (should-error (length= (dot2 1 2)) :type 'wrong-type-argument)
+  (should-error (length= 100 (cyc1 1)) :type 'circular-list)
+  (should-error (length= 10000 (cyc2 1 2)) :type 'circular-list)
+  (should-error (length= 100 (dot1 1)) :type 'wrong-type-argument)
+  (should-error (length= 100 (dot2 1 2)) :type 'wrong-type-argument))
+
 (ert-deftest test-cycle-member ()
   (let ((c1 (cyc1 1))
         (c2 (cyc2 1 2))
-- 
2.11.1


From 1d319882af723b02f702e00dd056ccf29a1f71f4 Mon Sep 17 00:00:00 2001
From: Graham Dobbins <gdobbins@protonmail.com>
Date: Sun, 26 Feb 2017 14:16:51 -0500
Subject: [PATCH 2/2] Add bytecode support for length= by co-opting ='s
 bytecode

length= behaves the same as = when given types appropriate for =.
* src/fns.c (length_eqlsign2): define function for case of 2 args to length=
* src/bytecode.c (exec_byte_code): change byte interpreter case for = opcode
 to use previous function
* src/lisp.h (length_eqlsign2): add prototype for length_eqlsign2
* lisp/emacs-lisp/bytecomp.el: make length= compile to the same opcode as =,
 change byte-compile-delete-errors to default to t, make = compile in a
 discarded + operation in order to check types when previous var is null,
 change byte-compile-warning-types to include an 'unused' option, add a
 compiler macro for = to change to length= when appropriate.
* lisp/emacs-lisp/byte-opt.el (byte-optimize-form-code-walker): change
 warning to depend on 'unused' option of byte-compile-warning-types, add
 length= to side-effect-free-fns.
* test/lisp/emacs-lisp/bytecomp-tests.el: add tests for above functionality.
---
 etc/NEWS                               |  5 ++
 lisp/emacs-lisp/byte-opt.el            |  4 +-
 lisp/emacs-lisp/bytecomp.el            | 41 +++++++++++++++--
 src/bytecode.c                         | 15 +-----
 src/fns.c                              | 83 ++++++++++++++++++++++++++++++++++
 src/lisp.h                             |  1 +
 test/lisp/emacs-lisp/bytecomp-tests.el | 20 ++++++++
 7 files changed, 150 insertions(+), 19 deletions(-)

diff --git a/etc/NEWS b/etc/NEWS
index 6abcda729b..642f1fdcfc 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -325,6 +325,11 @@ always restricting the margin to a quarter of the window.
 ** Emacsclient has a new option -u/--suppress-output.  The option
 suppresses display of return values from the server process.
 
+** 'byte-compile-warnings' has a new element 'unused'
+
++++
+** 'byte-compile-delete-errors' now defaults to t
+
 \f
 * Editing Changes in Emacs 26.1
 
diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el
index 004f2e2865..5ec1a2c6d2 100644
--- a/lisp/emacs-lisp/byte-opt.el
+++ b/lisp/emacs-lisp/byte-opt.el
@@ -545,7 +545,7 @@ byte-optimize-form-code-walker
 	   form)
 
 	  ((and for-effect (setq tmp (get fn 'side-effect-free))
-		(or byte-compile-delete-errors
+		(or (not (byte-compile-warning-enabled-p 'unused))
 		    (eq tmp 'error-free)
 		    (progn
 		      (byte-compile-warn "value returned from %s is unused"
@@ -1199,7 +1199,7 @@ byte-optimize-set
 	 hash-table-count
 	 int-to-string intern-soft
 	 keymap-parent
-	 length local-variable-if-set-p local-variable-p log log10 logand
+	 length length= local-variable-if-set-p local-variable-p log log10 logand
 	 logb logior lognot logxor lsh langinfo
 	 make-list make-string make-symbol marker-buffer max member memq min
 	 minibuffer-selected-window minibuffer-window
diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el
index 25513bd024..5c4a1d0cba 100644
--- a/lisp/emacs-lisp/bytecomp.el
+++ b/lisp/emacs-lisp/bytecomp.el
@@ -217,7 +217,7 @@ byte-optimize
 		 (const :tag "source-level" source)
 		 (const :tag "byte-level" byte)))
 
-(defcustom byte-compile-delete-errors nil
+(defcustom byte-compile-delete-errors t
   "If non-nil, the optimizer may delete forms that may signal an error.
 This includes variable references and calls to functions such as `car'."
   :group 'bytecomp
@@ -286,8 +286,9 @@ byte-compile-error-on-warn
 
 (defconst byte-compile-warning-types
   '(redefine callargs free-vars unresolved
-	     obsolete noruntime cl-functions interactive-only
-	     make-local mapcar constants suspicious lexical)
+    obsolete noruntime cl-functions interactive-only
+    make-local mapcar constants suspicious lexical
+    unused)
   "The list of warning types used when `byte-compile-warnings' is t.")
 (defcustom byte-compile-warnings t
   "List of warnings that the byte-compiler should issue (t for all).
@@ -311,6 +312,8 @@ byte-compile-warnings
   mapcar      mapcar called for effect.
   constants   let-binding of, or assignment to, constants/nonvariables.
   suspicious  constructs that usually don't do what the coder wanted.
+  unused      forms are present where the return value is unused
+               and they have no side effects.
 
 If the list begins with `not', then the remaining elements specify warnings to
 suppress.  For example, (not mapcar) will suppress warnings about mapcar."
@@ -3442,7 +3445,6 @@ byte-defop-compiler-1
 (byte-defop-compiler cons		2)
 (byte-defop-compiler aref		2)
 (byte-defop-compiler set		2)
-(byte-defop-compiler (= byte-eqlsign)	2-and)
 (byte-defop-compiler (< byte-lss)	2-and)
 (byte-defop-compiler (> byte-gtr)	2-and)
 (byte-defop-compiler (<= byte-leq)	2-and)
@@ -3658,6 +3660,8 @@ byte-compile-associative
 (byte-defop-compiler-1 - byte-compile-minus)
 (byte-defop-compiler (/ byte-quo) byte-compile-quo)
 (byte-defop-compiler nconc)
+(byte-defop-compiler (= byte-eqlsign))
+(byte-defop-compiler (length= byte-eqlsign))
 
 ;; Is this worth it?  Both -before and -after are written in C.
 (defun byte-compile-char-before (form)
@@ -3822,6 +3826,22 @@ byte-compile-insert
 	   (if (cdr form)
 	       (byte-compile-discard))))))
 
+(defun byte-compile-length= (form)
+  (if (length= 2 (cdr form))
+      (byte-compile-two-args form)
+    (byte-compile-normal-call form)))
+
+(defun byte-compile-= (form)
+  ;; Add an unused addition prior to checking for equality in order to
+  ;; ensure correct types since the bytecode interpreter handles = as
+  ;; length=.
+  (unless byte-compile-delete-errors
+    ;; The optimizer is smart enough to remove this when
+    ;; byte-compile-delete-errors is t, but why make it?
+    (byte-compile-form `(+ ,@(cdr form)))
+    (byte-compile-discard))
+  (byte-compile-and-folded form))
+
 \f
 (byte-defop-compiler-1 setq)
 (byte-defop-compiler-1 setq-default)
@@ -5051,6 +5071,19 @@ batch-byte-recompile-directory
            (eval form)
          form)))
 
+(put '= 'compiler-macro
+     (lambda (form &rest args)
+       (cl-loop for f in args
+          when #1=(and (consp f)
+                       (eq 'length (car f)))
+          return
+            `(length=
+              ,@(cl-loop for f in args
+                   if #1# collect (cadr f) into lens
+                   else collect f into nums
+                   finally return (nconc nums lens)))
+          finally return form)))
+
 (provide 'byte-compile)
 (provide 'bytecomp)
 
diff --git a/src/bytecode.c b/src/bytecode.c
index 4414b077bb..c32662ec36 100644
--- a/src/bytecode.c
+++ b/src/bytecode.c
@@ -991,19 +991,8 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
 
 	CASE (Beqlsign):
 	  {
-	    Lisp_Object v2 = POP, v1 = TOP;
-	    CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (v1);
-	    CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (v2);
-	    bool equal;
-	    if (FLOATP (v1) || FLOATP (v2))
-	      {
-		double f1 = FLOATP (v1) ? XFLOAT_DATA (v1) : XINT (v1);
-		double f2 = FLOATP (v2) ? XFLOAT_DATA (v2) : XINT (v2);
-		equal = f1 == f2;
-	      }
-	    else
-	      equal = XINT (v1) == XINT (v2);
-	    TOP = equal ? Qt : Qnil;
+	    Lisp_Object v1 = POP;
+	    TOP = length_eqlsign2 (TOP, v1);
 	    NEXT;
 	  }
 
diff --git a/src/fns.c b/src/fns.c
index 8de7495841..b0247c81c4 100644
--- a/src/fns.c
+++ b/src/fns.c
@@ -137,6 +137,86 @@ which is at least the number of distinct elements.  */)
   return make_fixnum_or_float (len);
 }
 
+/* length= of 2 is separated out to use in the bytecode interpreter */
+Lisp_Object
+length_eqlsign2 (Lisp_Object s1, Lisp_Object s2)
+{
+  Lisp_Object val = Qnil;
+
+  if (Fnumber_or_marker_p (s1))
+    CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (s1);
+  else if (! CONSP (s1))
+    s1 = Flength (s1);
+
+  if (Fnumber_or_marker_p (s2))
+    CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (s2);
+  else if (! CONSP (s2))
+    s2 = Flength (s2);
+
+  if (! CONSP (s1) && ! CONSP (s2))
+    {
+      int equal = 0;
+      if (FLOATP (s1) || FLOATP (s2))
+	{
+	  double f1 = FLOATP (s1) ? XFLOAT_DATA (s1) : XINT (s1);
+	  double f2 = FLOATP (s2) ? XFLOAT_DATA (s2) : XINT (s2);
+	  equal = f1 == f2;
+	}
+      else
+	equal = XINT (s1) == XINT (s2);
+      val = equal ? Qt : Qnil;
+    }
+  else if (CONSP (s1) && CONSP (s2))
+    {
+      int done = 0;
+      FOR_EACH_TAIL (s2)
+	{
+	  if (done)
+	    return Qnil;
+	  s1 = XCDR (s1);
+	  if (! CONSP (s1))
+	    done = 1;
+	}
+      CHECK_LIST_END (s2, s2);
+      if (! CONSP (s1))
+	{
+	  CHECK_LIST_END (s1, s1);
+	  val = Qt;
+	}
+    }
+  else
+    {
+      if (CONSP (s1))
+	{
+	  Lisp_Object temp = s1;
+	  s1 = s2;
+	  s2 = temp;
+	}
+      intptr_t n = 0;
+      if (FLOATP (s1))
+	{
+	  if (XFLOAT_DATA (s1) - (intptr_t) XFLOAT_DATA (s1) == 0)
+	    n = XFLOAT_DATA (s1);
+	  else
+	    return Qnil;
+	}
+      else
+	n = XINT (s1);
+      intptr_t i = 0;
+      FOR_EACH_TAIL (s2)
+	{
+	  i++;
+	  if (i > n)
+	    return Qnil;
+	}
+      CHECK_LIST_END (s2, s2);
+      if (i == n)
+	val = Qt;
+    }
+
+  return val;
+}
+
 DEFUN ("length=", Flength_eqlsign, Slength_eqlsign, 1, MANY, 0,
        doc: /* Each element of SEQUENCES may be any type accepted by
 `length' or `='.  True if the length of each sequence is equal to each
@@ -145,6 +225,9 @@ usage: (length= &rest SEQUENCES) */)
   (ptrdiff_t nargs, Lisp_Object *args)
 {
 
+  if (nargs == 2)
+    return length_eqlsign2 (args[0], args[1]);
+
   Lisp_Object val = Qnil;
 
   Lisp_Object temp_list = Qnil;
diff --git a/src/lisp.h b/src/lisp.h
index e048011a86..836becac8a 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -3343,6 +3343,7 @@ extern void init_syntax_once (void);
 extern void syms_of_syntax (void);
 
 /* Defined in fns.c.  */
+extern Lisp_Object length_eqlsign2 (Lisp_Object, Lisp_Object);
 enum { NEXT_ALMOST_PRIME_LIMIT = 11 };
 extern EMACS_INT next_almost_prime (EMACS_INT) ATTRIBUTE_CONST;
 extern Lisp_Object larger_vector (Lisp_Object, ptrdiff_t, ptrdiff_t);
diff --git a/test/lisp/emacs-lisp/bytecomp-tests.el b/test/lisp/emacs-lisp/bytecomp-tests.el
index d0b9790738..4c38d8aec8 100644
--- a/test/lisp/emacs-lisp/bytecomp-tests.el
+++ b/test/lisp/emacs-lisp/bytecomp-tests.el
@@ -244,6 +244,18 @@ byte-opt-testsuite-arith-data
     (let ((a 3) (b 2) (c 1.0)) (/ a b c 0))
     (let ((a 3) (b 2) (c 1.0)) (/ a b c 1))
     (let ((a 3) (b 2) (c 1.0)) (/ a b c -1))
+
+    ;; Since the = opcode is overloaded with length=, ensure it works
+    (let ((a 3) (b 2) (c 1.0)) (= 1 c))
+    (let ((a 3) (b 2) (c 1.0)) (= 2 b))
+    (let ((a 3) (b 2) (c 1.0)) (= a 0))
+    (let ((a 3) (b 2) (c 1.0)) (= a))
+    (let ((a 3) (b 2) (c 1.0)) (= 2.0))
+    (let ((a 3) (b 2) (c 1.0)) (= 2.0 b (+ a c)))
+    (let ((a 3) (b 2) (c 1.0)) (= a 0))
+    (let ((a 3) (b 2) (c 1.0)) (= a 0.0))
+    (let ((a 3) (b 2) (c 1.0)) (= 0 a b c))
+
     ;; Test switch bytecode
     (let ((a 3)) (cond ((eq a 1) 'one) ((eq a 2) 'two) ((eq a 3) 'three) (t t)))
     (let ((a 'three)) (cond ((eq a 'one) 1) ((eq a 2) 'two) ((eq a 'three) 3)
@@ -500,6 +512,14 @@ bytecomp-lexbind-explain-1
   (dolist (pat bytecomp-lexbind-tests)
     (should (bytecomp-lexbind-check-1 pat))))
 
+(ert-deftest bytecomp-tests-=-typing ()
+  "Test that `=' checks for correct typing when
+`byte-compile-delete-errors' is null."
+  (let (byte-compile-delete-errors)
+    (should-error
+     (funcall (byte-compile (lambda (x y) (= x y))) 2 '(1 2))
+     :type 'wrong-type-argument)))
+
 ;; Local Variables:
 ;; no-byte-compile: t
 ;; End:
-- 
2.11.1

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

[Eli Zaretskii]

> Date: Sun, 26 Feb 2017 17:04:26 -0500
> From: Gdobbins <gdobbins@protonmail.com>
>
> The attatched patch has two commits. The first implements a new lisp function, length=, which acts the same
> as the function of the same name from the Common Lisp package Alexandria. Namely it compares the length
> of sequences with numbers. The second modifies the byte interpreter to treat = the same as length=, and the
> byte compiler to generate the appropriate code. By greping the Emacs repo's *.el files and comparing to *.elc
> files after compiling with the compiler-macro in the second commit of this patch, I estimate 14% of all calls to
> length in Emacs are then simply compared via =. This makes length= quite useful, and since a large amount
> of linked list traversal can be avoided, potentially more efficient.

Thanks.  Please allow me a few comments.

> diff --git a/etc/NEWS b/etc/NEWS
> index 31b7e4789e..6abcda729b 100644
> --- a/etc/NEWS
> +++ b/etc/NEWS
> @@ -970,6 +970,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 function 'length=' compares the lengths of sequences and
> +numbers.

The "+++" marker means that the following entry is already described
in the appropriate manual.  But your changeset doesn't include any
changes for the manuals.  Were they forgotten?

> +DEFUN ("length=", Flength_eqlsign, Slength_eqlsign, 1, MANY, 0,
> +       doc: /* Each element of SEQUENCES may be any type accepted by
> +`length' or `='.  True if the length of each sequence is equal to each
> +number, otherwise returns nil.
> +usage: (length= &rest SEQUENCES) */)
> +  (ptrdiff_t nargs, Lisp_Object *args)

IMO, this doc string needs to be clarified, and will probably benefit
from an example.  E.g., you refer to "number", but the list of
arguments doesn't seem to describe any numbers.  So the semantics of
this function remains unclear after reading the doc string.

> +      if (Fnumber_or_marker_p (args[argnum]))

It would be more efficient to call NUMBERP and MARKERP directly.

> +	  else if (! CALLN (Feqlsign, val, args[argnum]))

Not sure why you call Feqlsign here.  The arguments are either numbers
or markers, so their direct comparison should be much more efficient,
right?

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

[Gdobbins]

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

I looked in the manual for a place where length= should be documented, but didn't find one. I thought the docstring was sufficient. Perhaps I was mistaken. As for improving the docstring, the following is what CL Alexandria uses:

"Takes any number of sequences or integers in any order. Returns true iff the length of all the sequences and the integers are equal."

I tried to be as clear as possible without plagiarizing. An example would probably help.

The change of Fnumber_or_markerp makes sense. The call to Feqlsign was left to avoid more code duplication in light of length_eqlsign2. I found less than ten calls to length= which had more than two arguments, so the full function call to Flength_eqlsign should rarely happen, and when it does the primary time sink of the call will be to linked list traversal. But changing it is straightforward.

The attached patch implements the changes you've asked for.


-- Graham Dobbins



-------- Original Message --------
Subject: Re: [PATCH] Add new lisp function length= with bytecode support
Local Time: February 27, 2017 11:14 AM
UTC Time: February 27, 2017 4:14 PM
From: eliz@gnu.org
To: Gdobbins <gdobbins@protonmail.com>
emacs-devel@gnu.org

> Date: Sun, 26 Feb 2017 17:04:26 -0500
> From: Gdobbins <gdobbins@protonmail.com>
>
> The attatched patch has two commits. The first implements a new lisp function, length=, which acts the same
> as the function of the same name from the Common Lisp package Alexandria. Namely it compares the length
> of sequences with numbers. The second modifies the byte interpreter to treat = the same as length=, and the
> byte compiler to generate the appropriate code. By greping the Emacs repo's *.el files and comparing to *.elc
> files after compiling with the compiler-macro in the second commit of this patch, I estimate 14% of all calls to
> length in Emacs are then simply compared via =. This makes length= quite useful, and since a large amount
> of linked list traversal can be avoided, potentially more efficient.

Thanks. Please allow me a few comments.

> diff --git a/etc/NEWS b/etc/NEWS
> index 31b7e4789e..6abcda729b 100644
> --- a/etc/NEWS
> +++ b/etc/NEWS
> @@ -970,6 +970,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 function 'length=' compares the lengths of sequences and
> +numbers.

The "+++" marker means that the following entry is already described
in the appropriate manual. But your changeset doesn't include any
changes for the manuals. Were they forgotten?

> +DEFUN ("length=", Flength_eqlsign, Slength_eqlsign, 1, MANY, 0,
> + doc: /* Each element of SEQUENCES may be any type accepted by
> +`length' or `='. True if the length of each sequence is equal to each
> +number, otherwise returns nil.
> +usage: (length= &rest SEQUENCES) */)
> + (ptrdiff_t nargs, Lisp_Object *args)

IMO, this doc string needs to be clarified, and will probably benefit
from an example. E.g., you refer to "number", but the list of
arguments doesn't seem to describe any numbers. So the semantics of
this function remains unclear after reading the doc string.

> + if (Fnumber_or_marker_p (args[argnum]))

It would be more efficient to call NUMBERP and MARKERP directly.

> + else if (! CALLN (Feqlsign, val, args[argnum]))

Not sure why you call Feqlsign here. The arguments are either numbers
or markers, so their direct comparison should be much more efficient,
right?

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

[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-Open-code-numberp-and-markerp-and-calls-in-length.patch --]
[-- Type: text/x-patch; name="0001-Open-code-numberp-and-markerp-and-calls-in-length.patch", Size: 2715 bytes --]

From 727c335ead7d9fb09c82ea742fcb4839dfc9055f Mon Sep 17 00:00:00 2001
From: Graham Dobbins <gdobbins@protonmail.com>
Date: Mon, 27 Feb 2017 13:29:34 -0500
Subject: [PATCH] Open-code numberp and markerp and = calls in length=

* src/fns.c (length_eqlsign2, Flength_eqlsign): Add example to docstring and
  open-code calls to numberp and markerp and =.
---
 etc/NEWS  |  1 -
 src/fns.c | 18 ++++++++++++++----
 2 files changed, 14 insertions(+), 5 deletions(-)

diff --git a/etc/NEWS b/etc/NEWS
index 642f1fdcfc..16a48ef188 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -975,7 +975,6 @@ 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 function 'length=' compares the lengths of sequences and
 numbers.
 
diff --git a/src/fns.c b/src/fns.c
index b0247c81c4..78a9353b27 100644
--- a/src/fns.c
+++ b/src/fns.c
@@ -143,12 +143,12 @@ length_eqlsign2 (Lisp_Object s1, Lisp_Object s2)
 {
   Lisp_Object val = Qnil;
 
-  if (Fnumber_or_marker_p (s1))
+  if (NUMBERP (s1) || MARKERP (s1))
     CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (s1);
   else if (! CONSP (s1))
     s1 = Flength (s1);
 
-  if (Fnumber_or_marker_p (s2))
+  if (NUMBERP (s2) || MARKERP (s2))
     CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (s2);
   else if (! CONSP (s2))
     s2 = Flength (s2);
@@ -221,6 +221,8 @@ DEFUN ("length=", Flength_eqlsign, Slength_eqlsign, 1, MANY, 0,
        doc: /* Each element of SEQUENCES may be any type accepted by
 `length' or `='.  True if the length of each sequence is equal to each
 number, otherwise returns nil.
+
+For example (length= 2 \\='(1 2) [3 4]) returns t.
 usage: (length= &rest SEQUENCES) */)
   (ptrdiff_t nargs, Lisp_Object *args)
 {
@@ -229,6 +231,7 @@ usage: (length= &rest SEQUENCES) */)
     return length_eqlsign2 (args[0], args[1]);
 
   Lisp_Object val = Qnil;
+  double val_n = 0;
 
   Lisp_Object temp_list = Qnil;
   ptrdiff_t temp_list_i = 0;
@@ -237,14 +240,21 @@ usage: (length= &rest SEQUENCES) */)
      inconsistency found.  */
   for (ptrdiff_t argnum = 0; argnum < nargs; argnum++)
     {
-      if (Fnumber_or_marker_p (args[argnum]))
+      if (NUMBERP (args[argnum]) || MARKERP (args[argnum]))
 	{
 	  if (NILP (val))
 	    {
 	      val = args[argnum];
 	      CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (val);
+	      val_n = FLOATP (val) ? XFLOAT_DATA (val) : XINT (val);
+	    }
+	  else if (FLOATP (args[argnum]))
+	    {
+	      double f1 = XFLOAT_DATA (args[argnum]);
+              if (f1 != val_n)
+		return Qnil;
 	    }
-	  else if (! CALLN (Feqlsign, val, args[argnum]))
+	  else if (XINT (args[argnum]) != val_n)
 	    return Qnil;
 
 	  args[argnum] = Qnil;
-- 
2.11.1

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

[Paul Eggert]

On 02/27/2017 10:43 AM, Gdobbins wrote:
> I looked in the manual for a place where length= should be documented, 
> but didn't find one. I thought the docstring was sufficient. Perhaps I 
> was mistaken.

It should be documented in doc/lispref/sequences.texi, no?

As the intended use of length= is to compare lengths, it's confusing 
that it also accepts markers and floats, plus that makes the 
implementation a bit slower as it can't use EQ to compare lengths. It 
would be cleaner and simpler for length= to accept only sequences and 
integers, as Alexandria does.

I assume that markers and floats were put in only so that the 
byte-compiler could optimize expressions like (= (length FOO) BAR) 
without worrying about incompatibilities in the very-unlikely case where 
BAR is a float or a marker. In that case, perhaps the the byte-compiler 
should use a specialized length= function that is not visible to the 
user, so that the user-visible function (if any) can be kept cleaner.

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

[Gdobbins]

[-- Attachment #1: Type: text/plain, Size: 1893 bytes --]

> It should be documented in doc/lispref/sequences.texi, no?

Yes, of course. Sorry about that.

> As the intended use of length= is to compare lengths, it's confusing
> that it also accepts markers and floats, plus that makes the
> implementation a bit slower as it can't use EQ to compare lengths. It
> would be cleaner and simpler for length= to accept only sequences and
> integers, as Alexandria does.

I'm not sure I understand how EQ can be used to compare lengths. Do you mean using EQ to compare the numbers in the way I was using Feqlsign?

> I assume that markers and floats were put in only so that the
> byte-compiler could optimize expressions like (= (length FOO) BAR)
> without worrying about incompatibilities in the very-unlikely case where
> BAR is a float or a marker. In that case, perhaps the the byte-compiler
> should use a specialized length= function that is not visible to the
> user, so that the user-visible function (if any) can be kept cleaner.

length= accepts floats and markers so that the byte-code for = can be changed to actually call length=, since as it is currently defined length= returns the same result as = when given arguments appropriate for =. In this way both = and length= can be byte-compiled without the need for a new byte-code. The function length_eqlsign2 could be left this way and the full Flength_eqlsign could be changed to accept only integers. This should accommodate also the case you mention of BAR being a float or marker, provided the compiler macro be changed as necessary. I found less than ten cases where = was used to compare more than two sequences/numbers anyway.

I'm happy to make these changes and submit a new squashed patch, but first I'd like to know the consensus on whether or not my changes to the byte-compiler are acceptable. Otherwise these patches of patches are likely to become unwieldy.


-- Graham Dobbins

[-- Attachment #2: Type: text/html, Size: 2444 bytes --]

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

[Andreas Schwab]

On Feb 26 2017, Gdobbins <gdobbins@protonmail.com> wrote:

> --- a/src/fns.c
> +++ b/src/fns.c
> @@ -137,6 +137,109 @@ which is at least the number of distinct elements.  */)
>    return make_fixnum_or_float (len);
>  }
>  
> +DEFUN ("length=", Flength_eqlsign, Slength_eqlsign, 1, MANY, 0,
> +       doc: /* Each element of SEQUENCES may be any type accepted by

The first line of the docstring should be a full sentence, and describe
the function's purpose.  Also, don't refer to the function arguments as
an element of the &rest variable, that could be interpreted as if the
function takes a single list as argument.

Andreas.

-- 
Andreas Schwab, schwab@linux-m68k.org
GPG Key fingerprint = 58CA 54C7 6D53 942B 1756  01D3 44D5 214B 8276 4ED5
"And now for something completely different."

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

[Gdobbins]

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

I have attached a new patch which incorporates all of the requested changes. length= now accepts only integers, not markers or floats. The doc string has been updated and a manual entry written. I included all of the bytecode changes as well since there were no objections. Those changes have been improved to account for various edge cases.


-- Graham Dobbins



-------- Original Message --------
Subject: Re: [PATCH] Add new lisp function length= with bytecode support
Local Time: February 28, 2017 4:24 AM
UTC Time: February 28, 2017 9:24 AM
From: schwab@linux-m68k.org
To: Gdobbins <gdobbins@protonmail.com>
emacs-devel@gnu.org <emacs-devel@gnu.org>

On Feb 26 2017, Gdobbins <gdobbins@protonmail.com> wrote:

> --- a/src/fns.c
> +++ b/src/fns.c
> @@ -137,6 +137,109 @@ which is at least the number of distinct elements. */)
> return make_fixnum_or_float (len);
> }
>
> +DEFUN ("length=", Flength_eqlsign, Slength_eqlsign, 1, MANY, 0,
> + doc: /* Each element of SEQUENCES may be any type accepted by

The first line of the docstring should be a full sentence, and describe
the function's purpose. Also, don't refer to the function arguments as
an element of the &rest variable, that could be interpreted as if the
function takes a single list as argument.

Andreas.

--
Andreas Schwab, schwab@linux-m68k.org
GPG Key fingerprint = 58CA 54C7 6D53 942B 1756 01D3 44D5 214B 8276 4ED5
"And now for something completely different."

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

[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-Add-new-lisp-function-length-with-bytecode-support.patch --]
[-- Type: text/x-patch; name="0001-Add-new-lisp-function-length-with-bytecode-support.patch", Size: 17756 bytes --]

From e8359a9d0b5b8722858295681a1eaa004e37ff67 Mon Sep 17 00:00:00 2001
From: Graham Dobbins <gdobbins@protonmail.com>
Date: Sun, 5 Mar 2017 20:52:24 -0500
Subject: [PATCH] Add new lisp function length= with bytecode support

* src/fns.c (Flength_eqlsign, length_eqlsign2): Define length= and
length_eqlsign2 for use in the bytecode interpreter.
* src/lisp.h: Export length_eqlsign2.
* src/bytecode.c (exec_byte_code): Modify bytecode interpreter to handle
length= by overloading the = bytecode.
* lisp/emacs-lisp/bytecomp.el: Change bytecompiler to handle length= and
alter how = is handled to accomodate it. Change byte-compile-delete-errors to
default to t. Add new 'unused option to byte-compile-warning-types.
* lisp/emacs-lisp/byte-opt.el: Use new unused option for deleting unused
forms.
* test/src/fns-tests.el:
* test/lisp/emacs-lisp/bytecomp-tests.el: Add tests for new functionality.
* doc/lispref/sequences.texi: Document length=.
---
 doc/lispref/sequences.texi             |  28 ++++++
 etc/NEWS                               |   8 ++
 lisp/emacs-lisp/byte-opt.el            |   4 +-
 lisp/emacs-lisp/bytecomp.el            |  49 +++++++++-
 src/bytecode.c                         |  17 ++--
 src/fns.c                              | 163 +++++++++++++++++++++++++++++++++
 src/lisp.h                             |   1 +
 test/lisp/emacs-lisp/bytecomp-tests.el |  20 ++++
 test/src/fns-tests.el                  |  34 +++++++
 9 files changed, 312 insertions(+), 12 deletions(-)

diff --git a/doc/lispref/sequences.texi b/doc/lispref/sequences.texi
index 2c88ee38cb..4740a35766 100644
--- a/doc/lispref/sequences.texi
+++ b/doc/lispref/sequences.texi
@@ -113,6 +113,34 @@ Sequence Functions
 since @code{length} only counts the number of characters, but does not
 account for the display width of each character.
 
+@defun length= &rest sequences
+This function takes any number of sequences or integers. The length of
+each sequence is computed in the same manner as @code{length}. If
+these lengths and any provided numbers are all equal this function
+returns t, otherwise it returns nil. In addition to convenience, this
+function is more efficient than computing the @code{length} and
+comparing with @code{=} when one or more of the sequences is a list.
+
+@example
+@group
+(length= '(1 2) '(3 4))
+    @result{} t
+@end group
+@group
+(length= 3 '(1 2 3))
+    @result{} t
+@end group
+@group
+(length= 2 '(1 2 3))
+    @result{} nil
+@end group
+@group
+(length= '(1 2 3) "foo" [1 2 3])
+    @result{} t
+@end group
+@end example
+@end defun
+
 @defun elt sequence index
 @anchor{Definition of elt}
 @cindex elements of sequences
diff --git a/etc/NEWS b/etc/NEWS
index 8f7356f3e0..04533f1317 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -325,6 +325,10 @@ always restricting the margin to a quarter of the window.
 ** Emacsclient has a new option -u/--suppress-output.  The option
 suppresses display of return values from the server process.
 
+** 'byte-compile-warnings' has a new element 'unused'
+
+** 'byte-compile-delete-errors' now defaults to t
+
 \f
 * Editing Changes in Emacs 26.1
 
@@ -997,6 +1001,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 function 'length=' compares the lengths of sequences with
+integers.
+
 ** Changes in Frame- and Window- Handling
 
 +++
diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el
index 004f2e2865..5ec1a2c6d2 100644
--- a/lisp/emacs-lisp/byte-opt.el
+++ b/lisp/emacs-lisp/byte-opt.el
@@ -545,7 +545,7 @@ byte-optimize-form-code-walker
 	   form)
 
 	  ((and for-effect (setq tmp (get fn 'side-effect-free))
-		(or byte-compile-delete-errors
+		(or (not (byte-compile-warning-enabled-p 'unused))
 		    (eq tmp 'error-free)
 		    (progn
 		      (byte-compile-warn "value returned from %s is unused"
@@ -1199,7 +1199,7 @@ byte-optimize-set
 	 hash-table-count
 	 int-to-string intern-soft
 	 keymap-parent
-	 length local-variable-if-set-p local-variable-p log log10 logand
+	 length length= local-variable-if-set-p local-variable-p log log10 logand
 	 logb logior lognot logxor lsh langinfo
 	 make-list make-string make-symbol marker-buffer max member memq min
 	 minibuffer-selected-window minibuffer-window
diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el
index 25513bd024..ab611fb458 100644
--- a/lisp/emacs-lisp/bytecomp.el
+++ b/lisp/emacs-lisp/bytecomp.el
@@ -217,7 +217,7 @@ byte-optimize
 		 (const :tag "source-level" source)
 		 (const :tag "byte-level" byte)))
 
-(defcustom byte-compile-delete-errors nil
+(defcustom byte-compile-delete-errors t
   "If non-nil, the optimizer may delete forms that may signal an error.
 This includes variable references and calls to functions such as `car'."
   :group 'bytecomp
@@ -286,8 +286,9 @@ byte-compile-error-on-warn
 
 (defconst byte-compile-warning-types
   '(redefine callargs free-vars unresolved
-	     obsolete noruntime cl-functions interactive-only
-	     make-local mapcar constants suspicious lexical)
+    obsolete noruntime cl-functions interactive-only
+    make-local mapcar constants suspicious lexical
+    unused)
   "The list of warning types used when `byte-compile-warnings' is t.")
 (defcustom byte-compile-warnings t
   "List of warnings that the byte-compiler should issue (t for all).
@@ -311,6 +312,8 @@ byte-compile-warnings
   mapcar      mapcar called for effect.
   constants   let-binding of, or assignment to, constants/nonvariables.
   suspicious  constructs that usually don't do what the coder wanted.
+  unused      forms are present where the return value is unused
+               and they have no side effects.
 
 If the list begins with `not', then the remaining elements specify warnings to
 suppress.  For example, (not mapcar) will suppress warnings about mapcar."
@@ -3442,7 +3445,6 @@ byte-defop-compiler-1
 (byte-defop-compiler cons		2)
 (byte-defop-compiler aref		2)
 (byte-defop-compiler set		2)
-(byte-defop-compiler (= byte-eqlsign)	2-and)
 (byte-defop-compiler (< byte-lss)	2-and)
 (byte-defop-compiler (> byte-gtr)	2-and)
 (byte-defop-compiler (<= byte-leq)	2-and)
@@ -3658,6 +3660,8 @@ byte-compile-associative
 (byte-defop-compiler-1 - byte-compile-minus)
 (byte-defop-compiler (/ byte-quo) byte-compile-quo)
 (byte-defop-compiler nconc)
+(byte-defop-compiler (= byte-eqlsign))
+(byte-defop-compiler (length= byte-eqlsign))
 
 ;; Is this worth it?  Both -before and -after are written in C.
 (defun byte-compile-char-before (form)
@@ -3822,6 +3826,25 @@ byte-compile-insert
 	   (if (cdr form)
 	       (byte-compile-discard))))))
 
+(defun byte-compile-length= (form)
+  (if (and
+       byte-compile-delete-errors
+       (length= 3 form))
+      (progn
+        (when (numberp (caddr form))
+          (cl-rotatef (cadr form) (caddr form)))
+        (byte-compile-two-args form))
+    (byte-compile-normal-call form)))
+
+(defun byte-compile-= (form)
+  ;; Add an unused addition prior to checking for equality in order to
+  ;; ensure correct types since the bytecode interpreter handles = as
+  ;; length=.
+  (byte-compile-and-folded
+   (if byte-compile-delete-errors
+       form
+     (cons (car form) (mapcar (lambda (x) `(+ ,x 0)) (cdr form))))))
+
 \f
 (byte-defop-compiler-1 setq)
 (byte-defop-compiler-1 setq-default)
@@ -5051,6 +5074,24 @@ batch-byte-recompile-directory
            (eval form)
          form)))
 
+(put '= 'compiler-macro
+     (lambda (form &rest args)
+       (if (and byte-compile-delete-errors
+                (length= 2 args))
+           (let ((len1 (eq 'length (car-safe (car args))))
+                 (len2 (eq 'length (car-safe (cadr args)))))
+             (cond
+               ((and len1 len2)
+                `(length= ,(cadar args) ,(cadadr args)))
+               (len1
+                (let ((sym (cl-gensym)))
+                  `(let ((,sym ,(cadar args)))
+                     (length= ,(cadr args) ,sym))))
+               (len2
+                `(length= ,(car args) ,(cadadr args)))
+               (t form)))
+         form)))
+
 (provide 'byte-compile)
 (provide 'bytecomp)
 
diff --git a/src/bytecode.c b/src/bytecode.c
index e781a87d16..eaad24576f 100644
--- a/src/bytecode.c
+++ b/src/bytecode.c
@@ -992,14 +992,19 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
 	CASE (Beqlsign):
 	  {
 	    Lisp_Object v2 = POP, v1 = TOP;
+	    /* The = byte code has been overloaded to handle length= as well */
 	    if (FLOATP (v1) || FLOATP (v2))
-	      TOP = arithcompare (v1, v2, ARITH_EQUAL);
-	    else
-	      {
-		CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (v1);
-		CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (v2);
-		TOP = EQ (v1, v2) ? Qt : Qnil;
+              {
+		/* The compiler macro for = makes sure the sequence
+		   will be in POP. Since length= doesn't accept
+		   floats, only POP can be a non-number. Since this
+		   should be a rare case, just compute the length. */
+		if (__builtin_expect (!(NUMBERP (v2) || MARKERP (v2)), 0))
+		  v2 = Flength (v2);
+		TOP = arithcompare (v1, v2, ARITH_EQUAL);
 	      }
+	    else
+	      TOP = length_eqlsign2 (v1, v2);
 	    NEXT;
 	  }
 
diff --git a/src/fns.c b/src/fns.c
index 10653558eb..93d90a8d7e 100644
--- a/src/fns.c
+++ b/src/fns.c
@@ -137,6 +137,168 @@ which is at least the number of distinct elements.  */)
   return make_fixnum_or_float (len);
 }
 
+/* length= of 2 is separated out to use in the bytecode interpreter */
+Lisp_Object
+length_eqlsign2 (Lisp_Object s1, Lisp_Object s2)
+{
+  Lisp_Object val = Qnil;
+
+  if (! CONSP (s1) && ! CONSP (s2))
+    {
+      if (MARKERP (s1))
+	XSETFASTINT (s1, marker_position (s1));
+      else if (!INTEGERP (s1))
+	s1 = Flength (s1);
+
+      if (MARKERP (s2))
+	XSETFASTINT (s2, marker_position (s2));
+      else if (!INTEGERP (s2))
+	s2 = Flength (s2);
+
+      val = EQ (s1, s2) ? Qt : Qnil;
+    }
+  else if (CONSP (s1) && CONSP (s2))
+    {
+      int done = 0;
+      FOR_EACH_TAIL (s2)
+	{
+	  if (done)
+	    return Qnil;
+	  s1 = XCDR (s1);
+	  if (! CONSP (s1))
+	    done = 1;
+	}
+      CHECK_LIST_END (s2, s2);
+      if (! CONSP (s1))
+	{
+	  CHECK_LIST_END (s1, s1);
+	  val = Qt;
+	}
+    }
+  else
+    {
+      if (CONSP (s1))
+	{
+	  Lisp_Object temp = s1;
+	  s1 = s2;
+	  s2 = temp;
+	}
+      if (__builtin_expect (MARKERP (s1), 0))
+	XSETFASTINT (s1, marker_position (s1));
+      else if (! INTEGERP (s1))
+	s1 = Flength (s1);
+      intptr_t n = XINT (s1);
+      intptr_t i = 0;
+      FOR_EACH_TAIL (s2)
+	{
+	  i++;
+	  if (i > n)
+	    return Qnil;
+	}
+      CHECK_LIST_END (s2, s2);
+      if (i == n)
+	val = Qt;
+    }
+
+  return val;
+}
+
+DEFUN ("length=", Flength_eqlsign, Slength_eqlsign, 1, MANY, 0,
+       doc: /* Compare the lengths of sequences with integers.
+Return t if they are all equal, otherwise nil. Arguments may either be
+integers or any type acceptable to `length'.
+
+For example (length= 2 \\='(1 2) [3 4]) returns t.
+usage: (length= &rest SEQUENCES) */)
+  (ptrdiff_t nargs, Lisp_Object *args)
+{
+
+  /* if (nargs == 2) */
+  /*   return length_eqlsign2 (args[0], args[1]); */
+  /* Don't call length_eqlsign2 since it allows markers. Calls of two
+     args should be byte compiled to length_eqlsign2 anyway. The full
+     call for such cases only happens when the option to keep type
+     checks and errors is set. */
+  Lisp_Object val = Qnil;
+
+  Lisp_Object temp_list = Qnil;
+  ptrdiff_t temp_list_i = 0;
+
+  /* First check non list sequences, length stored in val or bail if
+     inconsistency found.  */
+  for (ptrdiff_t argnum = 0; argnum < nargs; argnum++)
+    {
+      if (CONSP (args[argnum]))
+	{
+	  if (NILP (temp_list))
+	    {
+	      temp_list = args[argnum];
+	      temp_list_i = argnum;
+	    }
+	  continue;
+	}
+      else if (!INTEGERP (args[argnum]))
+	args[argnum] = Flength (args[argnum]);
+
+      if (NILP (val))
+	val = args[argnum];
+      else if (!EQ (val, args[argnum]))
+	return Qnil;
+
+      args[argnum] = Qnil;
+    }
+
+  /* Now jointly iterate over the lists if there are any.  Bail if any
+     lengths don't match.  */
+  if (CONSP (temp_list))
+    {
+      temp_list_i++;
+
+      intptr_t n = 0;
+      if (NILP (val))
+	n = MOST_POSITIVE_FIXNUM;
+      else
+	n = XINT (val);
+
+      int done = 0;
+      intptr_t i = 0;
+      FOR_EACH_TAIL (temp_list)
+	{
+	  i++;
+	  if (done || i > n)
+	    return Qnil;
+	  for (ptrdiff_t argnum = temp_list_i; argnum < nargs; argnum++)
+	    {
+	      if (! NILP (args[argnum]))
+		{
+		  args[argnum] = (XCDR (args[argnum]));
+		  if (! CONSP (args[argnum]))
+		    done = 1;
+		}
+	    }
+	}
+      CHECK_LIST_END (temp_list, temp_list);
+      if (i != n && ! NILP (val))
+	return Qnil;
+      for (ptrdiff_t argnum = temp_list_i; argnum < nargs; argnum++)
+	{
+	  if (! NILP (args[argnum]))
+	    {
+	      if (! CONSP (args[argnum]))
+		CHECK_LIST_END (args[argnum], args[argnum]);
+	      return Qnil;
+	    }
+	}
+      if (NILP (val))
+	return Qt;
+    }
+
+  if (! NILP (val))
+    val = Qt;
+
+  return val;
+}
+
 DEFUN ("string-bytes", Fstring_bytes, Sstring_bytes, 1, 1, 0,
        doc: /* Return the number of bytes in STRING.
 If STRING is multibyte, this may be greater than the length of STRING.  */)
@@ -5070,6 +5232,7 @@ this variable.  */);
   defsubr (&Sidentity);
   defsubr (&Srandom);
   defsubr (&Slength);
+  defsubr (&Slength_eqlsign);
   defsubr (&Ssafe_length);
   defsubr (&Sstring_bytes);
   defsubr (&Sstring_equal);
diff --git a/src/lisp.h b/src/lisp.h
index 6d0b528335..91febbc4ca 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -3341,6 +3341,7 @@ extern void init_syntax_once (void);
 extern void syms_of_syntax (void);
 
 /* Defined in fns.c.  */
+extern Lisp_Object length_eqlsign2 (Lisp_Object, Lisp_Object);
 enum { NEXT_ALMOST_PRIME_LIMIT = 11 };
 extern EMACS_INT next_almost_prime (EMACS_INT) ATTRIBUTE_CONST;
 extern Lisp_Object larger_vector (Lisp_Object, ptrdiff_t, ptrdiff_t);
diff --git a/test/lisp/emacs-lisp/bytecomp-tests.el b/test/lisp/emacs-lisp/bytecomp-tests.el
index d0b9790738..4c38d8aec8 100644
--- a/test/lisp/emacs-lisp/bytecomp-tests.el
+++ b/test/lisp/emacs-lisp/bytecomp-tests.el
@@ -244,6 +244,18 @@ byte-opt-testsuite-arith-data
     (let ((a 3) (b 2) (c 1.0)) (/ a b c 0))
     (let ((a 3) (b 2) (c 1.0)) (/ a b c 1))
     (let ((a 3) (b 2) (c 1.0)) (/ a b c -1))
+
+    ;; Since the = opcode is overloaded with length=, ensure it works
+    (let ((a 3) (b 2) (c 1.0)) (= 1 c))
+    (let ((a 3) (b 2) (c 1.0)) (= 2 b))
+    (let ((a 3) (b 2) (c 1.0)) (= a 0))
+    (let ((a 3) (b 2) (c 1.0)) (= a))
+    (let ((a 3) (b 2) (c 1.0)) (= 2.0))
+    (let ((a 3) (b 2) (c 1.0)) (= 2.0 b (+ a c)))
+    (let ((a 3) (b 2) (c 1.0)) (= a 0))
+    (let ((a 3) (b 2) (c 1.0)) (= a 0.0))
+    (let ((a 3) (b 2) (c 1.0)) (= 0 a b c))
+
     ;; Test switch bytecode
     (let ((a 3)) (cond ((eq a 1) 'one) ((eq a 2) 'two) ((eq a 3) 'three) (t t)))
     (let ((a 'three)) (cond ((eq a 'one) 1) ((eq a 2) 'two) ((eq a 'three) 3)
@@ -500,6 +512,14 @@ bytecomp-lexbind-explain-1
   (dolist (pat bytecomp-lexbind-tests)
     (should (bytecomp-lexbind-check-1 pat))))
 
+(ert-deftest bytecomp-tests-=-typing ()
+  "Test that `=' checks for correct typing when
+`byte-compile-delete-errors' is null."
+  (let (byte-compile-delete-errors)
+    (should-error
+     (funcall (byte-compile (lambda (x y) (= x y))) 2 '(1 2))
+     :type 'wrong-type-argument)))
+
 ;; Local Variables:
 ;; no-byte-compile: t
 ;; End:
diff --git a/test/src/fns-tests.el b/test/src/fns-tests.el
index a1b48a643e..2547643935 100644
--- a/test/src/fns-tests.el
+++ b/test/src/fns-tests.el
@@ -246,6 +246,30 @@ fns-tests--collate-enabled-p
     (should (equal (mapcan #'identity data) '(foo bar)))
     (should (equal data                     '((foo bar) (bar))))))
 
+(ert-deftest fns-tests-length= ()
+  (should (length= 2 '(3 4) (vector 5 6)))
+  (should (length= '(1 2) '(3 4)))
+  (should (length= 0 nil))
+  (should (length= '(1 2) "ab"))
+  (should (length= "ab" [c d]))
+  (should-not (length= 3 '(1 2)))
+  (should-not (length= '(1 2) '(1 2 3)))
+  (should-not (length= "a" "ab"))
+  (should-error (length= '(1 2) 2.1))
+  ;; length= of two args when compiled behaves slightly differently to
+  ;; accomodate overloading the = bytecode. Test it too.
+  (let* ((byte-compile-delete-errors t)
+         (comp-length= (byte-compile (lambda (x y) (length= x y)))))
+    (should-not (funcall comp-length= 2.1 '(1 2)))
+    (should (funcall comp-length= 2.0 '(1 2)))
+    (should (funcall comp-length= '(1 2) '(3 4)))
+    (should (funcall comp-length= 0 nil))
+    (should (funcall comp-length= '(1 2) "ab"))
+    (should (funcall comp-length= "ab" [c d]))
+    (should-not (funcall comp-length= "a" "ab"))
+    (should-not (funcall comp-length= 3 '(1 2)))
+    (should-not (funcall comp-length= '(1 2) '(1 2 3)))))
+
 ;; Test handling of cyclic and dotted lists.
 
 (defun cyc1 (a)
@@ -284,6 +308,16 @@ dot2
   (should (= 10 (safe-length (dot1 1))))
   (should (= 20 (safe-length (dot2 1 2)))))
 
+(ert-deftest test-cycle-length= ()
+  (should-error (length= (cyc1 1)) :type 'circular-list)
+  (should-error (length= (cyc2 1 2)) :type 'circular-list)
+  (should-error (length= (dot1 1)) :type 'wrong-type-argument)
+  (should-error (length= (dot2 1 2)) :type 'wrong-type-argument)
+  (should-error (length= 100 (cyc1 1)) :type 'circular-list)
+  (should-error (length= 10000 (cyc2 1 2)) :type 'circular-list)
+  (should-error (length= 100 (dot1 1)) :type 'wrong-type-argument)
+  (should-error (length= 100 (dot2 1 2)) :type 'wrong-type-argument))
+
 (ert-deftest test-cycle-member ()
   (let ((c1 (cyc1 1))
         (c2 (cyc2 1 2))
-- 
2.12.0

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

[Elias Mårtenson]

[-- Attachment #1: Type: text/plain, Size: 638 bytes --]

On 6 March 2017 at 09:59, Gdobbins <gdobbins@protonmail.com> wrote:

> I have attached a new patch which incorporates all of the requested
> changes. length= now accepts only integers, not markers or floats. The doc
> string has been updated and a manual entry written. I included all of the
> bytecode changes as well since there were no objections. Those changes have
> been improved to account for various edge cases.
>

Wouldn't it make sense to have a function ‘length<’ and ‘length>’ as well?
There are plenty of occasions that I have wanted to ensure that a list
contains at least a certain number of elements.

[-- Attachment #2: Type: text/html, Size: 952 bytes --]

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

[John Wiegley]

>>>>> "EM" == Elias Mårtenson <lokedhs@gmail.com> writes:

EM> Wouldn't it make sense to have a function ‘length<’ and ‘length>’ as well?
EM> There are plenty of occasions that I have wanted to ensure that a list
EM> contains at least a certain number of elements.

I would agree; having length= makes it seem strange not to have the others.

-- 
John Wiegley                  GPG fingerprint = 4710 CF98 AF9B 327B B80F
http://newartisans.com                          60E1 46C4 BD1A 7AC1 4BA2

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

[Richard Stallman]

[[[ To any NSA and FBI agents reading my email: please consider    ]]]
[[[ whether defending the US Constitution against all enemies,     ]]]
[[[ foreign or domestic, requires you to follow Snowden's example. ]]]

  > I would agree; having length= makes it seem strange not to have the others.

Why add length= as a primitive?  Why is it important enough to justify that?

Unless you're concerned about improper lists, 
length= can be implemented as follows:

(defun length= (list n)
  (if (= n 0)
      (null list)
    (let ((tail (nthcdr (1- n) list)))
      (and (consp tail)
	   (not (cdr tail))))))

This will run almost as fast as a primitive, for long lists,
since nthcdr does most of the work.

If we want to make it safe for improper lists,
it would be better to add nthcdr-safe as a primitive.
That would make it easy to implement length= or length< or length>
or length>= if you want them.

-- 
Dr Richard Stallman
President, Free Software Foundation (gnu.org, fsf.org)
Internet Hall-of-Famer (internethalloffame.org)
Skype: No way! See stallman.org/skype.html.

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

[Gdobbins]

[-- Attachment #1: Type: text/plain, Size: 849 bytes --]

> Why add length= as a primitive? Why is it important enough to justify that?

About 14% of all calls to length are then simply compared via =. I checked and the < and > variants combined account for about 30%, the <= and >= combined about 10%. I don't really see a purpose in using nthcdr like you have in a lisp implementation of length=, it isn't any better than just using length directly since it requires just as much linked list traversal. That was of course the reason I implemented it in C.

> Wouldn't it make sense to have a function ‘length<’ and ‘length>’ as well?

Yes, it would appear so. But for the same reasons as length= they would need to be implemented in C for there to be any improvement in efficiency. They could be added to the < and > bytecodes in the same way that I've done with = and length=.


-- Graham Dobbins

[-- Attachment #2: Type: text/html, Size: 1106 bytes --]

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

[Clément Pit-Claudel]

On 2017-03-06 15:36, Gdobbins wrote:
>> Why add length= as a primitive? Why is it important enough to
>> justify that?
> 
> … I don't really see a purpose in using nthcdr like you have in a
> lisp implementation of length=, it isn't any better than just using
> length directly since it requires just as much linked list traversal.

Isn't Richard's code much faster for long lists and small Ns thank taking the length of the list?

Clément.



 

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

[Gdobbins]

[-- Attachment #1: Type: text/plain, Size: 155 bytes --]

> Isn't Richard's code much faster for long lists and small Ns thank taking the length of the list?

Yes, I didn't read very carefully.


-- Graham Dobbins

[-- Attachment #2: Type: text/html, Size: 529 bytes --]

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

[Gdobbins]

[-- 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

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

[Ken Raeburn]

On Mar 6, 2017, at 19:29, Gdobbins <gdobbins@protonmail.com> wrote:

> 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

Looks like interesting work.  A few comments:

The &rest arguments for the functions might be better called “sequences-or-numbers”, because the documentation as displayed by describe-function will show the parameter names.

> length< is a Lisp function in ‘/private/tmp/gdobbins.el’.
> 
> (length< &rest SEQUENCES)
> 
> Compare the lengths of sequences with numbers.

The documentation indicates that numbers are permitted in the argument list, but nthcdr won’t be happy with 3.0, or 3.1416, or 1.0e+INF, or 0.0e+NaN.

The tail-compare-or-swap and tail-adjust logic is hard to follow (especially with no comments).  Maybe it would be more straightforward to just have the macro check if the comparison symbol is = and do one thing, or < to do another, etc.  Maybe even two different implementations, one for = without the tail-adjust bit and one for < and <= with it.  And the functions working by argument list reversal can just be their own functions, or use an entirely separate macro.

I gather internal--length-compare (specifically the nthcdr bit) works for “less than” but not for “greater than”, and thus the reversal approach is actually required, not just a way to reduce the quantity of code generated.  Is that correct?

The doc string for “length<” talks about wanting its first argument to be a non-list.  I take it that’s because it'll always compute the length of a list in that position.  But I think
  (length< some-big-list 5)
could still limit the work it does by using nthcdr, couldn’t it?  Implement it the same as:
  (not (length< 4 some-big-list))
At least, when the number is known to be an integer.
I think it’s if both arguments are lists, that’s when you’re still stuck getting the real length of at least one of them.  (More than two arguments gets more complicated, but there are additional use cases where unbounded “length” calls can be avoided.  I don’t know if the case of more than two arguments comes up often enough to bother.)

The doc string’s attempt to refer to arguments that could be sequences or numbers, and which get treated differently depending on which they are, is a bit awkward.  Maybe something like:
  Compare numbers and lengths of sequences.
  Arguments that are numbers are compared directly; for sequences, their lengths are used.
  Return t if each number or length is `>’ to the next.
I’m still not wild about it.  Constructing a sentence from the comparison-operator’s symbol name is just going to be awkward, I think, compared to the doc strings for “>” or “length” which sound fairly natural.  It’d be better to actually write out “greater than” and such.

The doc string mention of “more efficient” is ambiguous; more efficient than what?  Are you comparing against using “length” and “>”?  Or are you comparing different ways the arguments to the function might be arranged?

Ken

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

[Gdobbins]

[-- Attachment #1: Type: text/plain, Size: 1646 bytes --]

> The documentation indicates that numbers are permitted

That should have been integers. Both in the documentation and in the code.

> I gather internal--length-compare (specifically the nthcdr bit) works for “less than” but not for “greater than”, and thus the reversal approach is actually required, not just a way to reduce the quantity of code generated. Is that correct?

It's actually a limitation of the whole nthcdr approach. You can only ever save list traversal on the last argument with <, but not any with > since you need to know whether it will get bigger than the preceding argument.

> But I think
> (length< some-big-list 5)
> could still limit the work it does by using nthcdr, couldn’t it? Implement it the same as:
> (not (length< 4 some-big-list))

This sort of approach could work and would obviate the previous problem as well. I think it would be best to do it in a compiler macro which acts when passed literal numbers rather than variables holding numbers. That case is more common anyway, and it would prevent extra run-time computation.

> The doc string mention of “more efficient” is ambiguous; more efficient than what? Are you comparing against using “length” and “>”? Or are you comparing different ways the arguments to the function might be arranged?

The second one.

I'm actually considering an entirely different approach toward changing the bytecode interpreter which will be backwards compatible, not require new bytecodes, and improve run-time for these cases. If it's acceptable then it will greatly affect how length= and related can and should be implemented.


-- Graham Dobbins

[-- Attachment #2: Type: text/html, Size: 2099 bytes --]

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

[Gdobbins]

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

Attached is a new patch which modifies the byte-interpreter to use C functions for comparing list length to numbers at run-time. It does this by checking if the next bytecode is a comparison op when it encounters a length op. It does not have the problem of incompatibly changing = like the last method. The only remaining incompatible change is forms like (= 0 (length some-long-circular-list)) will now not throw an error, instead they will return nil in byte-compiled code. Similarly for dotted lists. The rare code which does require the error to be thrown can switch to (= 0 (safe-length some-long-circular-list)) to regain the behavior.

This change also makes length= and related then either worse than not having them, or they become trivial:

(defun length= (number list)
(= number (length list)))

Regardless of if this change is acceptable, I also need to get my copyright assignment done. I'm working on another unrelated patch as well.


-- Graham Dobbins

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

[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-Optimize-bytecode-interpeter-for-numeric-comparisons.patch --]
[-- Type: text/x-patch; name="0001-Optimize-bytecode-interpeter-for-numeric-comparisons.patch", Size: 8293 bytes --]

From 2376ca2baed8d1bc06265c432f4afbe353adc3e0 Mon Sep 17 00:00:00 2001
From: Graham Dobbins <gdobbins@protonmail.com>
Date: Sun, 12 Mar 2017 22:22:19 -0400
Subject: [PATCH] Optimize bytecode interpeter for numeric comparisons of list
 length

When the bytecode interpreter encounters a length bytecode with a list
argument followed by a comparison bytecode it defers to the new special
purpose length comparison functions.
* src/bytecode.c (exec_byte_code): Change the Blength bytecode case and add
the new functions.
* lisp/emacs-lisp/byte-opt.el (byte-optimize-binary-predicate,
byte-optimize-predicate): Make the byte-compiler put the length and
comparison bytecodes next to each other when possible.
* src/lisp.h (length_Beqlsign, length_Bgtr, length_Blss, length_Bleq,
length_Bgeq, length_Beq): Declare new C functions.
---
 lisp/emacs-lisp/byte-opt.el |  37 +++++--
 src/bytecode.c              | 233 +++++++++++++++++++++++++++++++++++++++++++-
 src/lisp.h                  |   6 ++
 3 files changed, 265 insertions(+), 11 deletions(-)

diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el
index 004f2e2865..f3a24d9d26 100644
--- a/lisp/emacs-lisp/byte-opt.el
+++ b/lisp/emacs-lisp/byte-opt.el
@@ -862,15 +862,23 @@ byte-optimize-logmumble
 
 (defun byte-optimize-binary-predicate (form)
   (cond
-   ((or (not (macroexp-const-p (nth 1 form)))
-        (nthcdr 3 form)) ;; In case there are more than 2 args.
-    form)
-   ((macroexp-const-p (nth 2 form))
-    (condition-case ()
-        (list 'quote (eval form))
-      (error form)))
-   (t ;; This can enable some lapcode optimizations.
-    (list (car form) (nth 2 form) (nth 1 form)))))
+    ((nthcdr 3 form) form)
+    ((not (macroexp-const-p (nth 1 form)))
+     (if (and
+          (memq (car form) '(= eq equal))
+          (eq (car-safe (cadr form)) 'length)
+          (macroexp-const-p (nth 2 form)))
+         (list (car form) (nth 2 form) (nth 1 form))
+       form))
+    ((macroexp-const-p (nth 2 form))
+     (condition-case ()
+         (list 'quote (eval form))
+       (error form)))
+    ((and (memq (car form) '(= eq equal))
+          (eq (car-safe (caddr form)) 'length))
+     form)
+    (t ;; This can enable some lapcode optimizations.
+     (list (car form) (nth 2 form) (nth 1 form)))))
 
 (defun byte-optimize-predicate (form)
   (let ((ok t)
@@ -882,7 +890,16 @@ byte-optimize-predicate
 	(condition-case ()
 	    (list 'quote (eval form))
 	  (error form))
-	form)))
+      (let ((swap (assoc (car form)
+                         '((< . >) (> . <)
+                           (<= . >=) (>= . <=)
+                           (= . =)))))
+        (if (and swap
+                 (= 3 (length form))
+                 (eq (car-safe (cadr form)) 'length)
+                 (macroexp-const-p (nth 2 form)))
+            (list (cdr swap) (nth 2 form) (nth 1 form))
+          form)))))
 
 (defun byte-optimize-identity (form)
   (if (and (cdr form) (null (cdr (cdr form))))
diff --git a/src/bytecode.c b/src/bytecode.c
index e781a87d16..b00ac4d096 100644
--- a/src/bytecode.c
+++ b/src/bytecode.c
@@ -310,6 +310,10 @@ enum byte_code_op
 
 #define TOP (*top)
 
+/* Look at the next byte of the bytecode stream. */
+
+#define PEEK (*pc)
+
 DEFUN ("byte-code", Fbyte_code, Sbyte_code, 3, 3, 0,
        doc: /* Function used internally in byte-compiled code.
 The first argument, BYTESTR, is a string of byte code;
@@ -907,7 +911,54 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
 	  NEXT;
 
 	CASE (Blength):
-	  TOP = Flength (TOP);
+	  if (CONSP (TOP))
+	    {
+	      Lisp_Object v1;
+	      switch (PEEK)
+		{
+		case Beqlsign:
+		  op = FETCH;
+		  v1 = POP;
+		  TOP = length_Beqlsign (TOP, v1);
+		  break;
+
+		case Bgtr:
+		  op = FETCH;
+		  v1 = POP;
+		  TOP = length_Bgtr (TOP, v1);
+		  break;
+
+		case Blss:
+		  op = FETCH;
+		  v1 = POP;
+		  TOP = length_Blss (TOP, v1);
+		  break;
+
+		case Bleq:
+		  op = FETCH;
+		  v1 = POP;
+		  TOP = length_Bleq (TOP, v1);
+		  break;
+
+		case Bgeq:
+		  op = FETCH;
+		  v1 = POP;
+		  TOP = length_Bgeq (TOP, v1);
+		  break;
+
+		case Beq:
+		case Bequal:
+		  op = FETCH;
+		  v1 = POP;
+		  TOP = length_Beq (TOP, v1);
+		  break;
+
+		default:
+		  TOP = Flength (TOP);
+		}
+	    }
+	  else
+	    TOP = Flength (TOP);
 	  NEXT;
 
 	CASE (Baref):
@@ -1522,3 +1573,183 @@ integer, it is incremented each time that symbol's function is called.  */);
   }
 #endif
 }
+
+/* The following are used above in the Blength case. Each assumes s1
+   is a number or marker and s2 is a list. */
+
+Lisp_Object
+length_Beqlsign (Lisp_Object s1, Lisp_Object s2)
+{
+  Lisp_Object val = Qnil;
+
+  CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (s1);
+
+  if (__builtin_expect (FLOATP (s1), 0))
+    {
+      s2 = Flength(s2);
+      val = arithcompare (s1, s2, ARITH_EQUAL);
+    }
+  else
+    {
+      intptr_t n = XINT (s1);
+      intptr_t i = 0;
+      FOR_EACH_TAIL (s2)
+	{
+	  i++;
+	  if (i > n)
+	    return val;
+	}
+      CHECK_LIST_END (s2, s2);
+      if (i == n)
+	val = Qt;
+    }
+
+  return val;
+}
+
+Lisp_Object
+length_Bgtr (Lisp_Object s1, Lisp_Object s2)
+{
+  Lisp_Object val = Qnil;
+
+  CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (s1);
+
+  if (__builtin_expect (FLOATP (s1), 0))
+    {
+      s2 = Flength(s2);
+      val = arithcompare (s1, s2, ARITH_GRTR);
+    }
+  else
+    {
+      intptr_t n = XINT (s1);
+      intptr_t i = 0;
+      FOR_EACH_TAIL (s2)
+	{
+	  i++;
+	  if (i >= n)
+	    return val;
+	}
+      CHECK_LIST_END (s2, s2);
+      if (i < n)
+	val = Qt;
+    }
+
+  return val;
+}
+
+Lisp_Object
+length_Blss (Lisp_Object s1, Lisp_Object s2)
+{
+  Lisp_Object val = Qnil;
+
+  CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (s1);
+
+  if (__builtin_expect (FLOATP (s1), 0))
+    {
+      s2 = Flength(s2);
+      val = arithcompare (s1, s2, ARITH_LESS);
+    }
+  else
+    {
+      intptr_t n = XINT (s1);
+      intptr_t i = 0;
+      FOR_EACH_TAIL (s2)
+	{
+	  i++;
+	  if (i > n)
+	    {
+	      if (! CONSP (s2))
+		CHECK_LIST_END (s2, s2);
+	      return Qt;
+	    }
+	}
+      CHECK_LIST_END (s2, s2);
+    }
+
+  return val;
+}
+
+Lisp_Object
+length_Bleq (Lisp_Object s1, Lisp_Object s2)
+{
+  Lisp_Object val = Qnil;
+
+  CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (s1);
+
+  if (__builtin_expect (FLOATP (s1), 0))
+    {
+      s2 = Flength(s2);
+      val = arithcompare (s1, s2, ARITH_LESS_OR_EQUAL);
+    }
+  else
+    {
+      intptr_t n = XINT (s1);
+      intptr_t i = 0;
+      FOR_EACH_TAIL (s2)
+	{
+	  i++;
+	  if (i >= n)
+	    {
+	      if (! CONSP (s2))
+		CHECK_LIST_END (s2, s2);
+	      return Qt;
+	    }
+	}
+      CHECK_LIST_END (s2, s2);
+    }
+
+  return val;
+}
+
+Lisp_Object
+length_Bgeq (Lisp_Object s1, Lisp_Object s2)
+{
+  Lisp_Object val = Qnil;
+
+  CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (s1);
+
+  if (__builtin_expect (FLOATP (s1), 0))
+    {
+      s2 = Flength(s2);
+      val = arithcompare (s1, s2, ARITH_GRTR_OR_EQUAL);
+    }
+  else
+    {
+      intptr_t n = XINT (s1);
+      intptr_t i = 0;
+      FOR_EACH_TAIL (s2)
+	{
+	  i++;
+	  if (i > n)
+	    return val;
+	}
+      CHECK_LIST_END (s2, s2);
+      if (i <= n)
+	val = Qt;
+    }
+
+  return val;
+}
+
+Lisp_Object
+length_Beq (Lisp_Object s1, Lisp_Object s2)
+{
+  Lisp_Object val = Qnil;
+
+  if (INTEGERP (s1))
+    {
+      intptr_t n = XINT (s1);
+      intptr_t i = 0;
+      FOR_EACH_TAIL (s2)
+	{
+	  i++;
+	  if (i > n)
+	    return val;
+	}
+      CHECK_LIST_END (s2, s2);
+      if (i == n)
+	val = Qt;
+    }
+
+  return val;
+}
diff --git a/src/lisp.h b/src/lisp.h
index ab4db4cac0..cbda641acd 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -4151,6 +4151,12 @@ extern void syms_of_bytecode (void);
 extern Lisp_Object exec_byte_code (Lisp_Object, Lisp_Object, Lisp_Object,
 				   Lisp_Object, ptrdiff_t, Lisp_Object *);
 extern Lisp_Object get_byte_code_arity (Lisp_Object);
+Lisp_Object length_Beqlsign (Lisp_Object, Lisp_Object);
+Lisp_Object length_Bgtr (Lisp_Object, Lisp_Object);
+Lisp_Object length_Blss (Lisp_Object, Lisp_Object);
+Lisp_Object length_Bleq (Lisp_Object, Lisp_Object);
+Lisp_Object length_Bgeq (Lisp_Object, Lisp_Object);
+Lisp_Object length_Beq (Lisp_Object, Lisp_Object);
 
 /* Defined in macros.c.  */
 extern void init_macros (void);
-- 
2.12.0

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

[Stefan Monnier]

> When the bytecode interpreter encounters a length bytecode with a list
> argument followed by a comparison bytecode it defers to the new special
> purpose length comparison functions.
> * src/bytecode.c (exec_byte_code): Change the Blength bytecode case and add
> the new functions.
> * lisp/emacs-lisp/byte-opt.el (byte-optimize-binary-predicate,
> byte-optimize-predicate): Make the byte-compiler put the length and
> comparison bytecodes next to each other when possible.
> * src/lisp.h (length_Beqlsign, length_Bgtr, length_Blss, length_Bleq,
> length_Bgeq, length_Beq): Declare new C functions.

I like that.

> +	      switch (PEEK)
> +		{
> +		case Beqlsign:
> +		  op = FETCH;
> +		  v1 = POP;
> +		  TOP = length_Beqlsign (TOP, v1);
> +		  break;
> +
> +		case Bgtr:
> +		  op = FETCH;
> +		  v1 = POP;
> +		  TOP = length_Bgtr (TOP, v1);
> +		  break;
> +
> +		case Blss:
> +		  op = FETCH;
> +		  v1 = POP;
> +		  TOP = length_Blss (TOP, v1);
> +		  break;
> +
> +		case Bleq:
> +		  op = FETCH;
> +		  v1 = POP;
> +		  TOP = length_Bleq (TOP, v1);
> +		  break;
> +
> +		case Bgeq:
> +		  op = FETCH;
> +		  v1 = POP;
> +		  TOP = length_Bgeq (TOP, v1);
> +		  break;
> +
> +		case Beq:
> +		case Bequal:
> +		  op = FETCH;
> +		  v1 = POP;
> +		  TOP = length_Beq (TOP, v1);
> +		  break;
> +
> +		default:
> +		  TOP = Flength (TOP);
> +		}
> +	    }

Please move most of that to a separate function (which I guess will take
the list, the op and the value to which to compare the list).

> +/* The following are used above in the Blength case. Each assumes s1
> +   is a number or marker and s2 is a list. */
> +
> +Lisp_Object
> +length_Beqlsign (Lisp_Object s1, Lisp_Object s2)
> +{
> +  Lisp_Object val = Qnil;
> +
> +  CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (s1);
> +
> +  if (__builtin_expect (FLOATP (s1), 0))
> +    {
> +      s2 = Flength(s2);
> +      val = arithcompare (s1, s2, ARITH_EQUAL);
> +    }
> +  else
> +    {
> +      intptr_t n = XINT (s1);
> +      intptr_t i = 0;
> +      FOR_EACH_TAIL (s2)
> +	{
> +	  i++;
> +	  if (i > n)
> +	    return val;
> +	}
> +      CHECK_LIST_END (s2, s2);
> +      if (i == n)
> +	val = Qt;
> +    }
> +
> +  return val;
> +}
> +
> +Lisp_Object
> +length_Bgtr (Lisp_Object s1, Lisp_Object s2)
> +{
> +  Lisp_Object val = Qnil;
> +
> +  CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (s1);
> +
> +  if (__builtin_expect (FLOATP (s1), 0))
> +    {
> +      s2 = Flength(s2);
> +      val = arithcompare (s1, s2, ARITH_GRTR);
> +    }
> +  else
> +    {
> +      intptr_t n = XINT (s1);
> +      intptr_t i = 0;
> +      FOR_EACH_TAIL (s2)
> +	{
> +	  i++;
> +	  if (i >= n)
> +	    return val;
> +	}
> +      CHECK_LIST_END (s2, s2);
> +      if (i < n)
> +	val = Qt;
> +    }
> +
> +  return val;
> +}

Similarly, here (and below), I'm wondering if we can't reduce the code
duplication.  Furthermore, you might like to declare them static, so the
compiler is more likely to inline them.

> +Lisp_Object length_Beqlsign (Lisp_Object, Lisp_Object);
> +Lisp_Object length_Bgtr (Lisp_Object, Lisp_Object);
> +Lisp_Object length_Blss (Lisp_Object, Lisp_Object);
> +Lisp_Object length_Bleq (Lisp_Object, Lisp_Object);
> +Lisp_Object length_Bgeq (Lisp_Object, Lisp_Object);
> +Lisp_Object length_Beq (Lisp_Object, Lisp_Object);
 
Don't expose them in lisp.h, since they're only used in bytecode.c.


        Stefan

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

[Gdobbins]

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

> Please move most of that to a separate function (which I guess will take the list, the op and the value to which to compare the list).

Done, but since the default case of the switch needs the bytecode stream and execution stack to be at a different point than all of the other cases, the function needs the relevant pointers.

> Similarly, here (and below), I'm wondering if we can't reduce the code duplication.

They are now defined via a macro.

> Furthermore, you might like to declare them static, so thecompiler is more likely to inline them.

> Don't expose them in lisp.h, since they're only used in bytecode.c.

Done.


-- Graham Dobbins

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

[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0002-Optimize-bytecode-interpeter-for-numeric-comparisons.patch --]
[-- Type: text/x-patch; name="0002-Optimize-bytecode-interpeter-for-numeric-comparisons.patch", Size: 7431 bytes --]

From af696dd3e37ea46ee0a59670b02bab5a9f3b37ce Mon Sep 17 00:00:00 2001
From: Graham Dobbins <gdobbins@protonmail.com>
Date: Tue, 14 Mar 2017 01:54:29 -0400
Subject: [PATCH] Optimize bytecode interpeter for numeric comparisons of list
 length

When the bytecode interpreter encounters a length bytecode with a list
argument followed by a comparison bytecode it defers to the new special
purpose length comparison functions.
* src/bytecode.c (exec_byte_code, length_Beqlsign, length_Bgtr, length_Blss,
length_Bleq, length_Bgeq, length_Beq, length_compare): Change the Blength
bytecode case and add the new functions.
* lisp/emacs-lisp/byte-opt.el (byte-optimize-binary-predicate,
byte-optimize-predicate): Make the byte-compiler put the length and
comparison bytecodes next to each other when possible.
---
 lisp/emacs-lisp/byte-opt.el |  37 +++++++++----
 src/bytecode.c              | 123 +++++++++++++++++++++++++++++++++++++++++++-
 2 files changed, 149 insertions(+), 11 deletions(-)

diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el
index 004f2e2865..f3a24d9d26 100644
--- a/lisp/emacs-lisp/byte-opt.el
+++ b/lisp/emacs-lisp/byte-opt.el
@@ -862,15 +862,23 @@ byte-optimize-logmumble
 
 (defun byte-optimize-binary-predicate (form)
   (cond
-   ((or (not (macroexp-const-p (nth 1 form)))
-        (nthcdr 3 form)) ;; In case there are more than 2 args.
-    form)
-   ((macroexp-const-p (nth 2 form))
-    (condition-case ()
-        (list 'quote (eval form))
-      (error form)))
-   (t ;; This can enable some lapcode optimizations.
-    (list (car form) (nth 2 form) (nth 1 form)))))
+    ((nthcdr 3 form) form)
+    ((not (macroexp-const-p (nth 1 form)))
+     (if (and
+          (memq (car form) '(= eq equal))
+          (eq (car-safe (cadr form)) 'length)
+          (macroexp-const-p (nth 2 form)))
+         (list (car form) (nth 2 form) (nth 1 form))
+       form))
+    ((macroexp-const-p (nth 2 form))
+     (condition-case ()
+         (list 'quote (eval form))
+       (error form)))
+    ((and (memq (car form) '(= eq equal))
+          (eq (car-safe (caddr form)) 'length))
+     form)
+    (t ;; This can enable some lapcode optimizations.
+     (list (car form) (nth 2 form) (nth 1 form)))))
 
 (defun byte-optimize-predicate (form)
   (let ((ok t)
@@ -882,7 +890,16 @@ byte-optimize-predicate
 	(condition-case ()
 	    (list 'quote (eval form))
 	  (error form))
-	form)))
+      (let ((swap (assoc (car form)
+                         '((< . >) (> . <)
+                           (<= . >=) (>= . <=)
+                           (= . =)))))
+        (if (and swap
+                 (= 3 (length form))
+                 (eq (car-safe (cadr form)) 'length)
+                 (macroexp-const-p (nth 2 form)))
+            (list (cdr swap) (nth 2 form) (nth 1 form))
+          form)))))
 
 (defun byte-optimize-identity (form)
   (if (and (cdr form) (null (cdr (cdr form))))
diff --git a/src/bytecode.c b/src/bytecode.c
index e781a87d16..9dee69e3f6 100644
--- a/src/bytecode.c
+++ b/src/bytecode.c
@@ -310,6 +310,12 @@ enum byte_code_op
 
 #define TOP (*top)
 
+/* Look at the next byte of the bytecode stream. */
+
+#define PEEK (*pc)
+
+static void length_compare (unsigned char const **, Lisp_Object **, int *);
+
 DEFUN ("byte-code", Fbyte_code, Sbyte_code, 3, 3, 0,
        doc: /* Function used internally in byte-compiled code.
 The first argument, BYTESTR, is a string of byte code;
@@ -907,7 +913,10 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
 	  NEXT;
 
 	CASE (Blength):
-	  TOP = Flength (TOP);
+	  if (CONSP (TOP))
+	    length_compare (&pc, &top, &op);
+	  else
+	    TOP = Flength (TOP);
 	  NEXT;
 
 	CASE (Baref):
@@ -1522,3 +1531,115 @@ integer, it is incremented each time that symbol's function is called.  */);
   }
 #endif
 }
+
+/* The following are used above in the Blength case. Each assumes s1
+   is a number or marker and s2 is a list. */
+
+#define DEF_LENGTH_COMPARE(name, arith_op, loop_op, loop_ret, fin_op)\
+static Lisp_Object                                            \
+name (Lisp_Object s1, Lisp_Object s2)                         \
+{                                                             \
+  Lisp_Object val = Qnil;                                     \
+                                                              \
+  CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (s1);                   \
+                                                              \
+  if (__builtin_expect (FLOATP (s1), 0))                      \
+    {                                                         \
+      s2 = Flength(s2);                                       \
+      val = arithcompare (s1, s2, arith_op);                  \
+    }                                                         \
+  else                                                        \
+    {                                                         \
+      intptr_t n = XINT (s1);                                 \
+      intptr_t i = 0;                                         \
+      FOR_EACH_TAIL (s2)                                      \
+        {                                                     \
+          ++i;                                                \
+          if (i loop_op n)                                    \
+            loop_ret                                          \
+        }                                                     \
+      CHECK_LIST_END (s2, s2);                                \
+      if (i fin_op n)                                         \
+        val = Qt;                                             \
+    }                                                         \
+                                                              \
+  return val;                                                 \
+}
+
+DEF_LENGTH_COMPARE (length_Beqlsign, ARITH_EQUAL, >, return val;, ==)
+DEF_LENGTH_COMPARE (length_Bgtr, ARITH_GRTR, >=, return val;, <)
+DEF_LENGTH_COMPARE (length_Blss, ARITH_LESS, >,
+		    {
+		      if (! CONSP (s2))
+			CHECK_LIST_END (s2, s2);
+		      return Qt;
+		    }, && 0 &&)
+DEF_LENGTH_COMPARE (length_Bleq, ARITH_LESS_OR_EQUAL, >=,
+		    {
+		      if (! CONSP (s2))
+			CHECK_LIST_END (s2, s2);
+		      return Qt;
+		    }, && 0 &&)
+DEF_LENGTH_COMPARE (length_Bgeq, ARITH_GRTR_OR_EQUAL, >, return val;, <=)
+
+static Lisp_Object
+length_Beq (Lisp_Object s1, Lisp_Object s2)
+{
+  Lisp_Object val = Qnil;
+
+  if (INTEGERP (s1))
+    {
+      intptr_t n = XINT (s1);
+      intptr_t i = 0;
+      FOR_EACH_TAIL (s2)
+	{
+	  i++;
+	  if (i > n)
+	    return val;
+	}
+      CHECK_LIST_END (s2, s2);
+      if (i == n)
+	val = Qt;
+    }
+
+  return val;
+}
+
+static void
+length_compare (unsigned char const *PEEK, Lisp_Object *TOP, int *op)
+{
+  *op = *PEEK++;
+  Lisp_Object v1 = *TOP--;
+  switch (*op)
+    {
+    case Beqlsign:
+      *TOP = length_Beqlsign (*TOP, v1);
+      break;
+
+    case Bgtr:
+      *TOP = length_Bgtr (*TOP, v1);
+      break;
+
+    case Blss:
+      *TOP = length_Blss (*TOP, v1);
+      break;
+
+    case Bleq:
+      *TOP = length_Bleq (*TOP, v1);
+      break;
+
+    case Bgeq:
+      *TOP = length_Bgeq (*TOP, v1);
+      break;
+
+    case Beq:
+    case Bequal:
+      *TOP = length_Beq (*TOP, v1);
+      break;
+
+    default:
+      *op = *--PEEK;
+      ++TOP;
+      *TOP = Flength (*TOP);
+    }
+}
-- 
2.12.0