* 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 public inbox https://git.savannah.gnu.org/cgit/emacs.git This is a public inbox, see mirroring instructions for how to clone and mirror all data and code used for this inbox; as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).