all messages for Emacs-related lists mirrored at yhetil.org
 help / color / mirror / code / Atom feed
* bug#14892: Enhance Elisp compare functions (< <= > >=) to take var args
@ 2013-07-17 15:58 Barry OReilly
  2013-09-06 23:02 ` bug#14892: [PATCH] " Barry OReilly
  0 siblings, 1 reply; 11+ messages in thread
From: Barry OReilly @ 2013-07-17 15:58 UTC (permalink / raw)
  To: 14892

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

Other dialects of Lisp implement < and cousin functions with var args. eg
(< 1 x 10) would determine whether x is between 1 and 10. (apply '<=
some-list) would determine whether some-list is sorted. This would be a
nice enhancement to these core Elisp functions.

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

^ permalink raw reply	[flat|nested] 11+ messages in thread

* bug#14892: [PATCH] Enhance Elisp compare functions (< <= > >=) to take var args
  2013-07-17 15:58 bug#14892: Enhance Elisp compare functions (< <= > >=) to take var args Barry OReilly
@ 2013-09-06 23:02 ` Barry OReilly
  2013-09-07  2:28   ` Stefan Monnier
  0 siblings, 1 reply; 11+ messages in thread
From: Barry OReilly @ 2013-09-06 23:02 UTC (permalink / raw)
  To: 14892

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

Here is a patch to implement this. The tests in the patch pass.

diff --git a/src/bytecode.c b/src/bytecode.c
index e0e7b22..b777220 100644
--- a/src/bytecode.c
+++ b/src/bytecode.c
@@ -1364,40 +1364,36 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object
vector, Lisp_Object maxdepth,

     CASE (Bgtr):
       {
-        Lisp_Object v1;
         BEFORE_POTENTIAL_GC ();
-        v1 = POP;
-        TOP = Fgtr (TOP, v1);
+        DISCARD (1);
+        TOP = Fgtr (2, &TOP);
         AFTER_POTENTIAL_GC ();
         NEXT;
       }

     CASE (Blss):
       {
-        Lisp_Object v1;
         BEFORE_POTENTIAL_GC ();
-        v1 = POP;
-        TOP = Flss (TOP, v1);
+        DISCARD (1);
+        TOP = Flss (2, &TOP);
         AFTER_POTENTIAL_GC ();
         NEXT;
       }

     CASE (Bleq):
       {
-        Lisp_Object v1;
         BEFORE_POTENTIAL_GC ();
-        v1 = POP;
-        TOP = Fleq (TOP, v1);
+        DISCARD (1);
+        TOP = Fleq (2, &TOP);
         AFTER_POTENTIAL_GC ();
         NEXT;
       }

     CASE (Bgeq):
       {
-        Lisp_Object v1;
         BEFORE_POTENTIAL_GC ();
-        v1 = POP;
-        TOP = Fgeq (TOP, v1);
+        DISCARD (1);
+        TOP = Fgeq (2, &TOP);
         AFTER_POTENTIAL_GC ();
         NEXT;
       }
diff --git a/src/data.c b/src/data.c
index 9f4bd1f..cbfb18f 100644
--- a/src/data.c
+++ b/src/data.c
@@ -2310,41 +2310,53 @@ arithcompare (Lisp_Object num1, Lisp_Object num2,
enum comparison comparison)
     }
 }

-DEFUN ("=", Feqlsign, Seqlsign, 2, 2, 0,
-       doc: /* Return t if two args, both numbers or markers, are equal.
*/)
-  (register Lisp_Object num1, Lisp_Object num2)
+static Lisp_Object
+arithcompare_driver (ptrdiff_t nargs, Lisp_Object *args,
+                     enum comparison comparison)
 {
-  return arithcompare (num1, num2, equal);
+  for (ptrdiff_t argnum = 1; argnum < nargs; ++argnum)
+    {
+      if (EQ (Qnil, arithcompare (args[argnum-1], args[argnum],
comparison)))
+        return Qnil;
+    }
+  return Qt;
 }

-DEFUN ("<", Flss, Slss, 2, 2, 0,
-       doc: /* Return t if first arg is less than second arg.  Both must
be numbers or markers.  */)
-  (register Lisp_Object num1, Lisp_Object num2)
+DEFUN ("=", Feqlsign, Seqlsign, 1, MANY, 0,
+       doc: /* Return t if args, all numbers or markers, are equal.  */)
+  (ptrdiff_t nargs, Lisp_Object *args)
 {
-  return arithcompare (num1, num2, less);
+  return arithcompare_driver (nargs, args, equal);
 }

-DEFUN (">", Fgtr, Sgtr, 2, 2, 0,
-       doc: /* Return t if first arg is greater than second arg.  Both
must be numbers or markers.  */)
-  (register Lisp_Object num1, Lisp_Object num2)
+DEFUN ("<", Flss, Slss, 1, MANY, 0,
+       doc: /* Return t if each arg is less than the next arg.  All must
be numbers or markers.  */)
+  (ptrdiff_t nargs, Lisp_Object *args)
 {
-  return arithcompare (num1, num2, grtr);
+  return arithcompare_driver (nargs, args, less);
 }

-DEFUN ("<=", Fleq, Sleq, 2, 2, 0,
-       doc: /* Return t if first arg is less than or equal to second arg.
-Both must be numbers or markers.  */)
-  (register Lisp_Object num1, Lisp_Object num2)
+DEFUN (">", Fgtr, Sgtr, 1, MANY, 0,
+       doc: /* Return t if each arg is greater than the next arg.  All
must be numbers or markers.  */)
+  (ptrdiff_t nargs, Lisp_Object *args)
 {
-  return arithcompare (num1, num2, less_or_equal);
+  return arithcompare_driver (nargs, args, grtr);
 }

-DEFUN (">=", Fgeq, Sgeq, 2, 2, 0,
-       doc: /* Return t if first arg is greater than or equal to second
arg.
-Both must be numbers or markers.  */)
-  (register Lisp_Object num1, Lisp_Object num2)
+DEFUN ("<=", Fleq, Sleq, 1, MANY, 0,
+       doc: /* Return t if each arg is less than or equal to the next arg.
+All must be numbers or markers.  */)
+  (ptrdiff_t nargs, Lisp_Object *args)
+{
+  return arithcompare_driver (nargs, args, less_or_equal);
+}
+
+DEFUN (">=", Fgeq, Sgeq, 1, MANY, 0,
+       doc: /* Return t if each arg is greater than or equal to the next
arg.
+All must be numbers or markers.  */)
+  (ptrdiff_t nargs, Lisp_Object *args)
 {
-  return arithcompare (num1, num2, grtr_or_equal);
+  return arithcompare_driver (nargs, args, grtr_or_equal);
 }

 DEFUN ("/=", Fneq, Sneq, 2, 2, 0,
diff --git a/src/fileio.c b/src/fileio.c
index a751a73..6a8ab9b 100644
--- a/src/fileio.c
+++ b/src/fileio.c
@@ -5121,7 +5121,8 @@ DEFUN ("car-less-than-car", Fcar_less_than_car,
Scar_less_than_car, 2, 2, 0,
        doc: /* Return t if (car A) is numerically less than (car B).  */)
   (Lisp_Object a, Lisp_Object b)
 {
-  return Flss (Fcar (a), Fcar (b));
+  Lisp_Object args[2] = { Fcar (a), Fcar (b), };
+  return Flss (2, args);
 }

 /* Build the complete list of annotations appropriate for writing out
diff --git a/test/automated/data-tests.el b/test/automated/data-tests.el
index e69de29..2298fa3 100644
--- a/test/automated/data-tests.el
+++ b/test/automated/data-tests.el
@@ -0,0 +1,75 @@
+;;; data-tests.el --- tests for src/data.c
+
+;; Copyright (C) 2013 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; This program is free software: you can redistribute it and/or
+;; modify it under the terms of the GNU General Public License as
+;; published by the Free Software Foundation, either version 3 of the
+;; License, or (at your option) any later version.
+;;
+;; This program is distributed in the hope that it will be useful, but
+;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;; General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with this program.  If not, see `http://www.gnu.org/licenses/'.
+
+;;; Commentary:
+
+;;; Code:
+
+(ert-deftest data-tests-= ()
+  (should-error (=))
+  (should (= 1))
+  (should (= 2 2))
+  (should (= 9 9 9 9 9 9 9 9 9))
+  (should-not (apply #'= '(3 8 3)))
+  (should-error (= 9 9 'foo))
+  ;; Short circuits before getting to bad arg
+  (should-not (= 9 8 'foo)))
+
+(ert-deftest data-tests-< ()
+  (should-error (<))
+  (should (< 1))
+  (should (< 2 3))
+  (should (< -6 -1 0 2 3 4 8 9 999))
+  (should-not (apply #'< '(3 8 3)))
+  (should-error (< 9 10 'foo))
+  ;; Short circuits before getting to bad arg
+  (should-not (< 9 8 'foo)))
+
+(ert-deftest data-tests-> ()
+  (should-error (>))
+  (should (> 1))
+  (should (> 3 2))
+  (should (> 6 1 0 -2 -3 -4 -8 -9 -999))
+  (should-not (apply #'> '(3 8 3)))
+  (should-error (> 9 8 'foo))
+  ;; Short circuits before getting to bad arg
+  (should-not (> 8 9 'foo)))
+
+(ert-deftest data-tests-<= ()
+  (should-error (<=))
+  (should (<= 1))
+  (should (<= 2 3))
+  (should (<= -6 -1 -1 0 0 0 2 3 4 8 999))
+  (should-not (apply #'<= '(3 8 3 3)))
+  (should-error (<= 9 10 'foo))
+  ;; Short circuits before getting to bad arg
+  (should-not (<= 9 8 'foo)))
+
+(ert-deftest data-tests->= ()
+  (should-error (>=))
+  (should (>= 1))
+  (should (>= 3 2))
+  (should (>= 666 1 0 0 -2 -3 -3 -3 -4 -8 -8 -9 -999))
+  (should-not (apply #'>= '(3 8 3)))
+  (should-error (>= 9 8 'foo))
+  ;; Short circuits before getting to bad arg
+  (should-not (>= 8 9 'foo)))
+
+;;; data-tests.el ends here
+

I didn't do /=. If I implement /= with Fsort, then it won't behave
quite like in other Lisps.

In SBCL:
  (/= 1 2 3 'foo) signals error
  (/= 1 2 1 'foo) evaluates to NIL

To not get an error for the latter, I would want to use a hash map or
tree map. Are either of these ready-available to Emacs C code?

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

^ permalink raw reply related	[flat|nested] 11+ messages in thread

* bug#14892: [PATCH] Enhance Elisp compare functions (< <= > >=) to take var args
  2013-09-06 23:02 ` bug#14892: [PATCH] " Barry OReilly
@ 2013-09-07  2:28   ` Stefan Monnier
  2013-09-09 22:53     ` Barry OReilly
  0 siblings, 1 reply; 11+ messages in thread
From: Stefan Monnier @ 2013-09-07  2:28 UTC (permalink / raw)
  To: Barry OReilly; +Cc: 14892

> Here is a patch to implement this. The tests in the patch pass.

Do you have some performance numbers?

> I didn't do /=. If I implement /= with Fsort, then it won't behave
> quite like in other Lisps.

That kind of compatibility is not very important.

> In SBCL:
>   (/= 1 2 3 'foo) signals error
>   (/= 1 2 1 'foo) evaluates to NIL

> To not get an error for the latter, I would want to use a hash map or
> tree map.  Are either of these ready-available to Emacs C code?

We have hash-tables implemented in C, yes.


        Stefan





^ permalink raw reply	[flat|nested] 11+ messages in thread

* bug#14892: [PATCH] Enhance Elisp compare functions (< <= > >=) to take var args
  2013-09-07  2:28   ` Stefan Monnier
@ 2013-09-09 22:53     ` Barry OReilly
  2013-09-10 13:20       ` Stefan Monnier
  0 siblings, 1 reply; 11+ messages in thread
From: Barry OReilly @ 2013-09-09 22:53 UTC (permalink / raw)
  To: Stefan Monnier; +Cc: 14892

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

> Do you have some performance numbers?

Let arithcompare-benchmark.el contain:

  (defun arithcompare-many (lhs rhs)
    (dotimes (_ (floor 1e6))
      (< lhs rhs)))
  (message "%s" (benchmark-run 1 (arithcompare-many 100 101)))

Run by:

  emacs -Q --batch -f batch-byte-compile arithcompare-benchmark.el && emacs
-Q --batch --load arithcompare-benchmark.elc

The results averaged over ten trials each:

  Before patch: (0.061 0 0.0)
  After patch: (0.084 0 0.0)

In GNU Emacs 24.3.50.1 (x86_64-unknown-linux-gnu, GTK+ Version 2.10.4)
Windowing system distributor `The X.Org Foundation', version 11.0.70101000
System Description:    Red Hat Enterprise Linux Client release 5.4 (Tikanga)

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

^ permalink raw reply	[flat|nested] 11+ messages in thread

* bug#14892: [PATCH] Enhance Elisp compare functions (< <= > >=) to take var args
  2013-09-09 22:53     ` Barry OReilly
@ 2013-09-10 13:20       ` Stefan Monnier
  2013-09-10 14:54         ` Barry OReilly
  0 siblings, 1 reply; 11+ messages in thread
From: Stefan Monnier @ 2013-09-10 13:20 UTC (permalink / raw)
  To: Barry OReilly; +Cc: 14892

Looking at your patch a second time, I don't see how/where it handles
(< a b c) in byte-compiled code: the byte-codes only handle 2-arguments,
and the byte-compiler is left unchanged.

>> Do you have some performance numbers?
> Let arithcompare-benchmark.el contain:
>   (defun arithcompare-many (lhs rhs)
>     (dotimes (_ (floor 1e6))
>       (< lhs rhs)))
>   (message "%s" (benchmark-run 1 (arithcompare-many 100 101)))
> Run by:
>   emacs -Q --batch -f batch-byte-compile arithcompare-benchmark.el && emacs
> -Q --batch --load arithcompare-benchmark.elc
> The results averaged over ten trials each:
>   Before patch: (0.061 0 0.0)
>   After patch: (0.084 0 0.0)

The slowdown is not too bad, but I think it'd be better to change the
implementation so that the bytecode.c code is left mostly unchanged
(i.e. calling a function that only handles 2 arguments), so that there's
no slowdown at all.
IOW, change bytecode.c to call "arithcompare (TOP, v1, grtr)" rather
than the previous "Fgtr (TOP, v1)" or the new "Fgtr (2, &TOP)".


        Stefan





^ permalink raw reply	[flat|nested] 11+ messages in thread

* bug#14892: [PATCH] Enhance Elisp compare functions (< <= > >=) to take var args
  2013-09-10 13:20       ` Stefan Monnier
@ 2013-09-10 14:54         ` Barry OReilly
  2013-09-10 20:16           ` Stefan Monnier
  0 siblings, 1 reply; 11+ messages in thread
From: Barry OReilly @ 2013-09-10 14:54 UTC (permalink / raw)
  To: Stefan Monnier; +Cc: 14892

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

> Looking at your patch a second time, I don't see how/where it
> handles (< a b c) in byte-compiled code: the byte-codes only
> handle 2-arguments, and the byte-compiler is left unchanged.

(disassemble (byte-compile (lambda () (< x y))))
byte code:
  args: nil
0       varref    x
1       varref    y
2       lss
3       return

(disassemble (byte-compile (lambda () (< x y z))))
byte code:
  args: nil
0       constant  <
1       varref    x
2       varref    y
3       varref    z
4       call      3
5       return

So it works with many args, it just byte compiles to a general
function call rather than to a specific comparison bytecode.

I had considered this before submitting the patch, but decided it
might be a premature optimization to extend the byte compiler in
this way. There are no users of more than 2 args to start with.

'make check' runs the new data-tests as byte compiled, so it has
been tested.

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

^ permalink raw reply	[flat|nested] 11+ messages in thread

* bug#14892: [PATCH] Enhance Elisp compare functions (< <= > >=) to take var args
  2013-09-10 14:54         ` Barry OReilly
@ 2013-09-10 20:16           ` Stefan Monnier
  2013-09-10 23:35             ` Barry OReilly
  0 siblings, 1 reply; 11+ messages in thread
From: Stefan Monnier @ 2013-09-10 20:16 UTC (permalink / raw)
  To: Barry OReilly; +Cc: 14892

>> Looking at your patch a second time, I don't see how/where it
>> handles (< a b c) in byte-compiled code: the byte-codes only
>> handle 2-arguments, and the byte-compiler is left unchanged.
> (disassemble (byte-compile (lambda () (< x y))))
> byte code:
>   args: nil
> 0       varref    x
> 1       varref    y
> 2       lss
> 3       return

> (disassemble (byte-compile (lambda () (< x y z))))
> byte code:
>   args: nil
> 0       constant  <
> 1       varref    x
> 2       varref    y
> 3       varref    z
> 4       call      3
> 5       return

Ha!  Indeed, it does!  great!

So could you change the bytecode.c code along the lines I suggested so
as to eliminate the slight speed penalty?


        Stefan





^ permalink raw reply	[flat|nested] 11+ messages in thread

* bug#14892: [PATCH] Enhance Elisp compare functions (< <= > >=) to take var args
  2013-09-10 20:16           ` Stefan Monnier
@ 2013-09-10 23:35             ` Barry OReilly
  2013-09-11  1:08               ` Stefan Monnier
  0 siblings, 1 reply; 11+ messages in thread
From: Barry OReilly @ 2013-09-10 23:35 UTC (permalink / raw)
  To: Stefan Monnier; +Cc: 14892

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

Benchmarking the same way:

  Before patch: (0.062154 0 0.0)
  After patch:  (0.061831 0 0.0)

I renamed the comparison enum as I moved it to lisp.h so as it is less
polluting to those that include it.

diff --git a/src/bytecode.c b/src/bytecode.c
index e0e7b22..3ac8b45 100644
--- a/src/bytecode.c
+++ b/src/bytecode.c
@@ -1367,7 +1367,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object
vector, Lisp_Object maxdepth,
            Lisp_Object v1;
            BEFORE_POTENTIAL_GC ();
            v1 = POP;
-           TOP = Fgtr (TOP, v1);
+           TOP = arithcompare (TOP, v1, ARITH_GRTR);
            AFTER_POTENTIAL_GC ();
            NEXT;
          }
@@ -1377,7 +1377,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object
vector, Lisp_Object maxdepth,
            Lisp_Object v1;
            BEFORE_POTENTIAL_GC ();
            v1 = POP;
-           TOP = Flss (TOP, v1);
+           TOP = arithcompare (TOP, v1, ARITH_LESS);
            AFTER_POTENTIAL_GC ();
            NEXT;
          }
@@ -1387,7 +1387,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object
vector, Lisp_Object maxdepth,
            Lisp_Object v1;
            BEFORE_POTENTIAL_GC ();
            v1 = POP;
-           TOP = Fleq (TOP, v1);
+           TOP = arithcompare (TOP, v1, ARITH_LESS_OR_EQUAL);
            AFTER_POTENTIAL_GC ();
            NEXT;
          }
@@ -1397,7 +1397,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object
vector, Lisp_Object maxdepth,
            Lisp_Object v1;
            BEFORE_POTENTIAL_GC ();
            v1 = POP;
-           TOP = Fgeq (TOP, v1);
+           TOP = arithcompare (TOP, v1, ARITH_GRTR_OR_EQUAL);
            AFTER_POTENTIAL_GC ();
            NEXT;
          }
diff --git a/src/data.c b/src/data.c
index 9f4bd1f..7f28028 100644
--- a/src/data.c
+++ b/src/data.c
@@ -2255,10 +2255,8 @@ bool-vector.  IDX starts at 0.  */)


 /* Arithmetic functions */

-enum comparison { equal, notequal, less, grtr, less_or_equal,
grtr_or_equal };
-
-static Lisp_Object
-arithcompare (Lisp_Object num1, Lisp_Object num2, enum comparison
comparison)
+Lisp_Object
+arithcompare (Lisp_Object num1, Lisp_Object num2, enum Arith_Comparison
comparison)
 {
   double f1 = 0, f2 = 0;
   bool floatp = 0;
@@ -2275,32 +2273,32 @@ arithcompare (Lisp_Object num1, Lisp_Object num2,
enum comparison comparison)

   switch (comparison)
     {
-    case equal:
+    case ARITH_EQUAL:
       if (floatp ? f1 == f2 : XINT (num1) == XINT (num2))
        return Qt;
       return Qnil;

-    case notequal:
+    case ARITH_NOTEQUAL:
       if (floatp ? f1 != f2 : XINT (num1) != XINT (num2))
        return Qt;
       return Qnil;

-    case less:
+    case ARITH_LESS:
       if (floatp ? f1 < f2 : XINT (num1) < XINT (num2))
        return Qt;
       return Qnil;

-    case less_or_equal:
+    case ARITH_LESS_OR_EQUAL:
       if (floatp ? f1 <= f2 : XINT (num1) <= XINT (num2))
        return Qt;
       return Qnil;

-    case grtr:
+    case ARITH_GRTR:
       if (floatp ? f1 > f2 : XINT (num1) > XINT (num2))
        return Qt;
       return Qnil;

-    case grtr_or_equal:
+    case ARITH_GRTR_OR_EQUAL:
       if (floatp ? f1 >= f2 : XINT (num1) >= XINT (num2))
        return Qt;
       return Qnil;
@@ -2310,48 +2308,60 @@ arithcompare (Lisp_Object num1, Lisp_Object num2,
enum comparison comparison)
     }
 }

-DEFUN ("=", Feqlsign, Seqlsign, 2, 2, 0,
-       doc: /* Return t if two args, both numbers or markers, are equal.
*/)
-  (register Lisp_Object num1, Lisp_Object num2)
+static Lisp_Object
+arithcompare_driver (ptrdiff_t nargs, Lisp_Object *args,
+                     enum Arith_Comparison comparison)
 {
-  return arithcompare (num1, num2, equal);
+  for (ptrdiff_t argnum = 1; argnum < nargs; ++argnum)
+    {
+      if (EQ (Qnil, arithcompare (args[argnum-1], args[argnum],
comparison)))
+        return Qnil;
+    }
+  return Qt;
 }

-DEFUN ("<", Flss, Slss, 2, 2, 0,
-       doc: /* Return t if first arg is less than second arg.  Both must
be numbers or markers.  */)
-  (register Lisp_Object num1, Lisp_Object num2)
+DEFUN ("=", Feqlsign, Seqlsign, 1, MANY, 0,
+       doc: /* Return t if args, all numbers or markers, are equal.  */)
+  (ptrdiff_t nargs, Lisp_Object *args)
 {
-  return arithcompare (num1, num2, less);
+  return arithcompare_driver (nargs, args, ARITH_EQUAL);
 }

-DEFUN (">", Fgtr, Sgtr, 2, 2, 0,
-       doc: /* Return t if first arg is greater than second arg.  Both
must be numbers or markers.  */)
-  (register Lisp_Object num1, Lisp_Object num2)
+DEFUN ("<", Flss, Slss, 1, MANY, 0,
+       doc: /* Return t if each arg is less than the next arg.  All must
be numbers or markers.  */)
+  (ptrdiff_t nargs, Lisp_Object *args)
 {
-  return arithcompare (num1, num2, grtr);
+  return arithcompare_driver (nargs, args, ARITH_LESS);
 }

-DEFUN ("<=", Fleq, Sleq, 2, 2, 0,
-       doc: /* Return t if first arg is less than or equal to second arg.
-Both must be numbers or markers.  */)
-  (register Lisp_Object num1, Lisp_Object num2)
+DEFUN (">", Fgtr, Sgtr, 1, MANY, 0,
+       doc: /* Return t if each arg is greater than the next arg.  All
must be numbers or markers.  */)
+  (ptrdiff_t nargs, Lisp_Object *args)
 {
-  return arithcompare (num1, num2, less_or_equal);
+  return arithcompare_driver (nargs, args, ARITH_GRTR);
 }

-DEFUN (">=", Fgeq, Sgeq, 2, 2, 0,
-       doc: /* Return t if first arg is greater than or equal to second
arg.
-Both must be numbers or markers.  */)
-  (register Lisp_Object num1, Lisp_Object num2)
+DEFUN ("<=", Fleq, Sleq, 1, MANY, 0,
+       doc: /* Return t if each arg is less than or equal to the next arg.
+All must be numbers or markers.  */)
+  (ptrdiff_t nargs, Lisp_Object *args)
+{
+  return arithcompare_driver (nargs, args, ARITH_LESS_OR_EQUAL);
+}
+
+DEFUN (">=", Fgeq, Sgeq, 1, MANY, 0,
+       doc: /* Return t if each arg is greater than or equal to the next
arg.
+All must be numbers or markers.  */)
+  (ptrdiff_t nargs, Lisp_Object *args)
 {
-  return arithcompare (num1, num2, grtr_or_equal);
+  return arithcompare_driver (nargs, args, ARITH_GRTR_OR_EQUAL);
 }

 DEFUN ("/=", Fneq, Sneq, 2, 2, 0,
        doc: /* Return t if first arg is not equal to second arg.  Both
must be numbers or markers.  */)
   (register Lisp_Object num1, Lisp_Object num2)
 {
-  return arithcompare (num1, num2, notequal);
+  return arithcompare (num1, num2, ARITH_NOTEQUAL);
 }

 DEFUN ("zerop", Fzerop, Szerop, 1, 1, 0,
diff --git a/src/fileio.c b/src/fileio.c
index 0e6113f..1a2bdfa 100644
--- a/src/fileio.c
+++ b/src/fileio.c
@@ -5121,7 +5121,8 @@ DEFUN ("car-less-than-car", Fcar_less_than_car,
Scar_less_than_car, 2, 2, 0,
        doc: /* Return t if (car A) is numerically less than (car B).  */)
   (Lisp_Object a, Lisp_Object b)
 {
-  return Flss (Fcar (a), Fcar (b));
+  Lisp_Object args[2] = { Fcar (a), Fcar (b), };
+  return Flss (2, args);
 }

 /* Build the complete list of annotations appropriate for writing out
diff --git a/src/lisp.h b/src/lisp.h
index 38b538d..2b1af1f 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -3160,6 +3160,16 @@ EXFUN (Fbyteorder, 0) ATTRIBUTE_CONST;
 /* Defined in data.c.  */
 extern Lisp_Object indirect_function (Lisp_Object);
 extern Lisp_Object find_symbol_value (Lisp_Object);
+enum Arith_Comparison {
+  ARITH_EQUAL,
+  ARITH_NOTEQUAL,
+  ARITH_LESS,
+  ARITH_GRTR,
+  ARITH_LESS_OR_EQUAL,
+  ARITH_GRTR_OR_EQUAL
+};
+extern Lisp_Object arithcompare (Lisp_Object num1, Lisp_Object num2,
+                                 enum Arith_Comparison comparison);

 /* Convert the integer I to an Emacs representation, either the integer
    itself, or a cons of two or three integers, or if all else fails a
float.
diff --git a/test/automated/data-tests.el b/test/automated/data-tests.el
index e69de29..2298fa3 100644
--- a/test/automated/data-tests.el
+++ b/test/automated/data-tests.el
@@ -0,0 +1,75 @@
+;;; data-tests.el --- tests for src/data.c
+
+;; Copyright (C) 2013 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; This program is free software: you can redistribute it and/or
+;; modify it under the terms of the GNU General Public License as
+;; published by the Free Software Foundation, either version 3 of the
+;; License, or (at your option) any later version.
+;;
+;; This program is distributed in the hope that it will be useful, but
+;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;; General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with this program.  If not, see `http://www.gnu.org/licenses/'.
+
+;;; Commentary:
+
+;;; Code:
+
+(ert-deftest data-tests-= ()
+  (should-error (=))
+  (should (= 1))
+  (should (= 2 2))
+  (should (= 9 9 9 9 9 9 9 9 9))
+  (should-not (apply #'= '(3 8 3)))
+  (should-error (= 9 9 'foo))
+  ;; Short circuits before getting to bad arg
+  (should-not (= 9 8 'foo)))
+
+(ert-deftest data-tests-< ()
+  (should-error (<))
+  (should (< 1))
+  (should (< 2 3))
+  (should (< -6 -1 0 2 3 4 8 9 999))
+  (should-not (apply #'< '(3 8 3)))
+  (should-error (< 9 10 'foo))
+  ;; Short circuits before getting to bad arg
+  (should-not (< 9 8 'foo)))
+
+(ert-deftest data-tests-> ()
+  (should-error (>))
+  (should (> 1))
+  (should (> 3 2))
+  (should (> 6 1 0 -2 -3 -4 -8 -9 -999))
+  (should-not (apply #'> '(3 8 3)))
+  (should-error (> 9 8 'foo))
+  ;; Short circuits before getting to bad arg
+  (should-not (> 8 9 'foo)))
+
+(ert-deftest data-tests-<= ()
+  (should-error (<=))
+  (should (<= 1))
+  (should (<= 2 3))
+  (should (<= -6 -1 -1 0 0 0 2 3 4 8 999))
+  (should-not (apply #'<= '(3 8 3 3)))
+  (should-error (<= 9 10 'foo))
+  ;; Short circuits before getting to bad arg
+  (should-not (<= 9 8 'foo)))
+
+(ert-deftest data-tests->= ()
+  (should-error (>=))
+  (should (>= 1))
+  (should (>= 3 2))
+  (should (>= 666 1 0 0 -2 -3 -3 -3 -4 -8 -8 -9 -999))
+  (should-not (apply #'>= '(3 8 3)))
+  (should-error (>= 9 8 'foo))
+  ;; Short circuits before getting to bad arg
+  (should-not (>= 8 9 'foo)))
+
+;;; data-tests.el ends here
+

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

^ permalink raw reply related	[flat|nested] 11+ messages in thread

* bug#14892: [PATCH] Enhance Elisp compare functions (< <= > >=) to take var args
  2013-09-10 23:35             ` Barry OReilly
@ 2013-09-11  1:08               ` Stefan Monnier
  2013-09-11  5:10                 ` Barry OReilly
  0 siblings, 1 reply; 11+ messages in thread
From: Stefan Monnier @ 2013-09-11  1:08 UTC (permalink / raw)
  To: Barry OReilly; +Cc: 14892

>   Before patch: (0.062154 0 0.0)
>   After patch:  (0.061831 0 0.0)

Perfect, please install,


        Stefan





^ permalink raw reply	[flat|nested] 11+ messages in thread

* bug#14892: [PATCH] Enhance Elisp compare functions (< <= > >=) to take var args
  2013-09-11  1:08               ` Stefan Monnier
@ 2013-09-11  5:10                 ` Barry OReilly
  2013-09-11 12:33                   ` Stefan Monnier
  0 siblings, 1 reply; 11+ messages in thread
From: Barry OReilly @ 2013-09-11  5:10 UTC (permalink / raw)
  Cc: 14892-done

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

Revision 114200

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

^ permalink raw reply	[flat|nested] 11+ messages in thread

* bug#14892: [PATCH] Enhance Elisp compare functions (< <= > >=) to take var args
  2013-09-11  5:10                 ` Barry OReilly
@ 2013-09-11 12:33                   ` Stefan Monnier
  0 siblings, 0 replies; 11+ messages in thread
From: Stefan Monnier @ 2013-09-11 12:33 UTC (permalink / raw)
  To: 14892; +Cc: gundaetiapo

> Revision 114200

Thank you,


        Stefan





^ permalink raw reply	[flat|nested] 11+ messages in thread

end of thread, other threads:[~2013-09-11 12:33 UTC | newest]

Thread overview: 11+ messages (download: mbox.gz follow: Atom feed
-- links below jump to the message on this page --
2013-07-17 15:58 bug#14892: Enhance Elisp compare functions (< <= > >=) to take var args Barry OReilly
2013-09-06 23:02 ` bug#14892: [PATCH] " Barry OReilly
2013-09-07  2:28   ` Stefan Monnier
2013-09-09 22:53     ` Barry OReilly
2013-09-10 13:20       ` Stefan Monnier
2013-09-10 14:54         ` Barry OReilly
2013-09-10 20:16           ` Stefan Monnier
2013-09-10 23:35             ` Barry OReilly
2013-09-11  1:08               ` Stefan Monnier
2013-09-11  5:10                 ` Barry OReilly
2013-09-11 12:33                   ` Stefan Monnier

Code repositories for project(s) associated with this external index

	https://git.savannah.gnu.org/cgit/emacs.git
	https://git.savannah.gnu.org/cgit/emacs/org-mode.git

This is an external index of several public inboxes,
see mirroring instructions on how to clone and mirror
all data and code used by this external index.