diff options
| author | Barry O'Reilly | 2013-09-11 01:03:23 -0400 |
|---|---|---|
| committer | Barry O'Reilly | 2013-09-11 01:03:23 -0400 |
| commit | ebb99847285bca912e04f79dd3d9dcc84769ccf6 (patch) | |
| tree | a3be4b8a0d987e4c6a54d284737a1383de933000 /src | |
| parent | 1b3b87dfe0fae8e5266319531c0a874c8b4313b1 (diff) | |
| download | emacs-ebb99847285bca912e04f79dd3d9dcc84769ccf6.tar.gz emacs-ebb99847285bca912e04f79dd3d9dcc84769ccf6.zip | |
Change comparison functions =, <, >, <=, >= to take many arguments.
* src/data.c: Change comparison functions' interface and
implementation
* src/lisp.h: Make arithcompare available for efficient two arg
comparisons
* src/bytecode.c: Use arithcompare
* src/fileio.c: Use new interface
* test/automated/data-tests.el: New tests for comparison functions
* etc/NEWS
Diffstat (limited to 'src')
| -rw-r--r-- | src/bytecode.c | 8 | ||||
| -rw-r--r-- | src/data.c | 76 | ||||
| -rw-r--r-- | src/fileio.c | 3 | ||||
| -rw-r--r-- | src/lisp.h | 10 |
4 files changed, 59 insertions, 38 deletions
diff --git a/src/bytecode.c b/src/bytecode.c index e0e7b22ea13..3ac8b452fbe 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, | |||
| 1367 | Lisp_Object v1; | 1367 | Lisp_Object v1; |
| 1368 | BEFORE_POTENTIAL_GC (); | 1368 | BEFORE_POTENTIAL_GC (); |
| 1369 | v1 = POP; | 1369 | v1 = POP; |
| 1370 | TOP = Fgtr (TOP, v1); | 1370 | TOP = arithcompare (TOP, v1, ARITH_GRTR); |
| 1371 | AFTER_POTENTIAL_GC (); | 1371 | AFTER_POTENTIAL_GC (); |
| 1372 | NEXT; | 1372 | NEXT; |
| 1373 | } | 1373 | } |
| @@ -1377,7 +1377,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, | |||
| 1377 | Lisp_Object v1; | 1377 | Lisp_Object v1; |
| 1378 | BEFORE_POTENTIAL_GC (); | 1378 | BEFORE_POTENTIAL_GC (); |
| 1379 | v1 = POP; | 1379 | v1 = POP; |
| 1380 | TOP = Flss (TOP, v1); | 1380 | TOP = arithcompare (TOP, v1, ARITH_LESS); |
| 1381 | AFTER_POTENTIAL_GC (); | 1381 | AFTER_POTENTIAL_GC (); |
| 1382 | NEXT; | 1382 | NEXT; |
| 1383 | } | 1383 | } |
| @@ -1387,7 +1387,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, | |||
| 1387 | Lisp_Object v1; | 1387 | Lisp_Object v1; |
| 1388 | BEFORE_POTENTIAL_GC (); | 1388 | BEFORE_POTENTIAL_GC (); |
| 1389 | v1 = POP; | 1389 | v1 = POP; |
| 1390 | TOP = Fleq (TOP, v1); | 1390 | TOP = arithcompare (TOP, v1, ARITH_LESS_OR_EQUAL); |
| 1391 | AFTER_POTENTIAL_GC (); | 1391 | AFTER_POTENTIAL_GC (); |
| 1392 | NEXT; | 1392 | NEXT; |
| 1393 | } | 1393 | } |
| @@ -1397,7 +1397,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, | |||
| 1397 | Lisp_Object v1; | 1397 | Lisp_Object v1; |
| 1398 | BEFORE_POTENTIAL_GC (); | 1398 | BEFORE_POTENTIAL_GC (); |
| 1399 | v1 = POP; | 1399 | v1 = POP; |
| 1400 | TOP = Fgeq (TOP, v1); | 1400 | TOP = arithcompare (TOP, v1, ARITH_GRTR_OR_EQUAL); |
| 1401 | AFTER_POTENTIAL_GC (); | 1401 | AFTER_POTENTIAL_GC (); |
| 1402 | NEXT; | 1402 | NEXT; |
| 1403 | } | 1403 | } |
diff --git a/src/data.c b/src/data.c index 9f4bd1f1c02..7f28028f604 100644 --- a/src/data.c +++ b/src/data.c | |||
| @@ -2255,10 +2255,8 @@ bool-vector. IDX starts at 0. */) | |||
| 2255 | 2255 | ||
| 2256 | /* Arithmetic functions */ | 2256 | /* Arithmetic functions */ |
| 2257 | 2257 | ||
| 2258 | enum comparison { equal, notequal, less, grtr, less_or_equal, grtr_or_equal }; | 2258 | Lisp_Object |
| 2259 | 2259 | arithcompare (Lisp_Object num1, Lisp_Object num2, enum Arith_Comparison comparison) | |
| 2260 | static Lisp_Object | ||
| 2261 | arithcompare (Lisp_Object num1, Lisp_Object num2, enum comparison comparison) | ||
| 2262 | { | 2260 | { |
| 2263 | double f1 = 0, f2 = 0; | 2261 | double f1 = 0, f2 = 0; |
| 2264 | bool floatp = 0; | 2262 | bool floatp = 0; |
| @@ -2275,32 +2273,32 @@ arithcompare (Lisp_Object num1, Lisp_Object num2, enum comparison comparison) | |||
| 2275 | 2273 | ||
| 2276 | switch (comparison) | 2274 | switch (comparison) |
| 2277 | { | 2275 | { |
| 2278 | case equal: | 2276 | case ARITH_EQUAL: |
| 2279 | if (floatp ? f1 == f2 : XINT (num1) == XINT (num2)) | 2277 | if (floatp ? f1 == f2 : XINT (num1) == XINT (num2)) |
| 2280 | return Qt; | 2278 | return Qt; |
| 2281 | return Qnil; | 2279 | return Qnil; |
| 2282 | 2280 | ||
| 2283 | case notequal: | 2281 | case ARITH_NOTEQUAL: |
| 2284 | if (floatp ? f1 != f2 : XINT (num1) != XINT (num2)) | 2282 | if (floatp ? f1 != f2 : XINT (num1) != XINT (num2)) |
| 2285 | return Qt; | 2283 | return Qt; |
| 2286 | return Qnil; | 2284 | return Qnil; |
| 2287 | 2285 | ||
| 2288 | case less: | 2286 | case ARITH_LESS: |
| 2289 | if (floatp ? f1 < f2 : XINT (num1) < XINT (num2)) | 2287 | if (floatp ? f1 < f2 : XINT (num1) < XINT (num2)) |
| 2290 | return Qt; | 2288 | return Qt; |
| 2291 | return Qnil; | 2289 | return Qnil; |
| 2292 | 2290 | ||
| 2293 | case less_or_equal: | 2291 | case ARITH_LESS_OR_EQUAL: |
| 2294 | if (floatp ? f1 <= f2 : XINT (num1) <= XINT (num2)) | 2292 | if (floatp ? f1 <= f2 : XINT (num1) <= XINT (num2)) |
| 2295 | return Qt; | 2293 | return Qt; |
| 2296 | return Qnil; | 2294 | return Qnil; |
| 2297 | 2295 | ||
| 2298 | case grtr: | 2296 | case ARITH_GRTR: |
| 2299 | if (floatp ? f1 > f2 : XINT (num1) > XINT (num2)) | 2297 | if (floatp ? f1 > f2 : XINT (num1) > XINT (num2)) |
| 2300 | return Qt; | 2298 | return Qt; |
| 2301 | return Qnil; | 2299 | return Qnil; |
| 2302 | 2300 | ||
| 2303 | case grtr_or_equal: | 2301 | case ARITH_GRTR_OR_EQUAL: |
| 2304 | if (floatp ? f1 >= f2 : XINT (num1) >= XINT (num2)) | 2302 | if (floatp ? f1 >= f2 : XINT (num1) >= XINT (num2)) |
| 2305 | return Qt; | 2303 | return Qt; |
| 2306 | return Qnil; | 2304 | return Qnil; |
| @@ -2310,48 +2308,60 @@ arithcompare (Lisp_Object num1, Lisp_Object num2, enum comparison comparison) | |||
| 2310 | } | 2308 | } |
| 2311 | } | 2309 | } |
| 2312 | 2310 | ||
| 2313 | DEFUN ("=", Feqlsign, Seqlsign, 2, 2, 0, | 2311 | static Lisp_Object |
| 2314 | doc: /* Return t if two args, both numbers or markers, are equal. */) | 2312 | arithcompare_driver (ptrdiff_t nargs, Lisp_Object *args, |
| 2315 | (register Lisp_Object num1, Lisp_Object num2) | 2313 | enum Arith_Comparison comparison) |
| 2316 | { | 2314 | { |
| 2317 | return arithcompare (num1, num2, equal); | 2315 | for (ptrdiff_t argnum = 1; argnum < nargs; ++argnum) |
| 2316 | { | ||
| 2317 | if (EQ (Qnil, arithcompare (args[argnum-1], args[argnum], comparison))) | ||
| 2318 | return Qnil; | ||
| 2319 | } | ||
| 2320 | return Qt; | ||
| 2318 | } | 2321 | } |
| 2319 | 2322 | ||
| 2320 | DEFUN ("<", Flss, Slss, 2, 2, 0, | 2323 | DEFUN ("=", Feqlsign, Seqlsign, 1, MANY, 0, |
| 2321 | doc: /* Return t if first arg is less than second arg. Both must be numbers or markers. */) | 2324 | doc: /* Return t if args, all numbers or markers, are equal. */) |
| 2322 | (register Lisp_Object num1, Lisp_Object num2) | 2325 | (ptrdiff_t nargs, Lisp_Object *args) |
| 2323 | { | 2326 | { |
| 2324 | return arithcompare (num1, num2, less); | 2327 | return arithcompare_driver (nargs, args, ARITH_EQUAL); |
| 2325 | } | 2328 | } |
| 2326 | 2329 | ||
| 2327 | DEFUN (">", Fgtr, Sgtr, 2, 2, 0, | 2330 | DEFUN ("<", Flss, Slss, 1, MANY, 0, |
| 2328 | doc: /* Return t if first arg is greater than second arg. Both must be numbers or markers. */) | 2331 | doc: /* Return t if each arg is less than the next arg. All must be numbers or markers. */) |
| 2329 | (register Lisp_Object num1, Lisp_Object num2) | 2332 | (ptrdiff_t nargs, Lisp_Object *args) |
| 2330 | { | 2333 | { |
| 2331 | return arithcompare (num1, num2, grtr); | 2334 | return arithcompare_driver (nargs, args, ARITH_LESS); |
| 2332 | } | 2335 | } |
| 2333 | 2336 | ||
| 2334 | DEFUN ("<=", Fleq, Sleq, 2, 2, 0, | 2337 | DEFUN (">", Fgtr, Sgtr, 1, MANY, 0, |
| 2335 | doc: /* Return t if first arg is less than or equal to second arg. | 2338 | doc: /* Return t if each arg is greater than the next arg. All must be numbers or markers. */) |
| 2336 | Both must be numbers or markers. */) | 2339 | (ptrdiff_t nargs, Lisp_Object *args) |
| 2337 | (register Lisp_Object num1, Lisp_Object num2) | ||
| 2338 | { | 2340 | { |
| 2339 | return arithcompare (num1, num2, less_or_equal); | 2341 | return arithcompare_driver (nargs, args, ARITH_GRTR); |
| 2340 | } | 2342 | } |
| 2341 | 2343 | ||
| 2342 | DEFUN (">=", Fgeq, Sgeq, 2, 2, 0, | 2344 | DEFUN ("<=", Fleq, Sleq, 1, MANY, 0, |
| 2343 | doc: /* Return t if first arg is greater than or equal to second arg. | 2345 | doc: /* Return t if each arg is less than or equal to the next arg. |
| 2344 | Both must be numbers or markers. */) | 2346 | All must be numbers or markers. */) |
| 2345 | (register Lisp_Object num1, Lisp_Object num2) | 2347 | (ptrdiff_t nargs, Lisp_Object *args) |
| 2348 | { | ||
| 2349 | return arithcompare_driver (nargs, args, ARITH_LESS_OR_EQUAL); | ||
| 2350 | } | ||
| 2351 | |||
| 2352 | DEFUN (">=", Fgeq, Sgeq, 1, MANY, 0, | ||
| 2353 | doc: /* Return t if each arg is greater than or equal to the next arg. | ||
| 2354 | All must be numbers or markers. */) | ||
| 2355 | (ptrdiff_t nargs, Lisp_Object *args) | ||
| 2346 | { | 2356 | { |
| 2347 | return arithcompare (num1, num2, grtr_or_equal); | 2357 | return arithcompare_driver (nargs, args, ARITH_GRTR_OR_EQUAL); |
| 2348 | } | 2358 | } |
| 2349 | 2359 | ||
| 2350 | DEFUN ("/=", Fneq, Sneq, 2, 2, 0, | 2360 | DEFUN ("/=", Fneq, Sneq, 2, 2, 0, |
| 2351 | doc: /* Return t if first arg is not equal to second arg. Both must be numbers or markers. */) | 2361 | doc: /* Return t if first arg is not equal to second arg. Both must be numbers or markers. */) |
| 2352 | (register Lisp_Object num1, Lisp_Object num2) | 2362 | (register Lisp_Object num1, Lisp_Object num2) |
| 2353 | { | 2363 | { |
| 2354 | return arithcompare (num1, num2, notequal); | 2364 | return arithcompare (num1, num2, ARITH_NOTEQUAL); |
| 2355 | } | 2365 | } |
| 2356 | 2366 | ||
| 2357 | DEFUN ("zerop", Fzerop, Szerop, 1, 1, 0, | 2367 | DEFUN ("zerop", Fzerop, Szerop, 1, 1, 0, |
diff --git a/src/fileio.c b/src/fileio.c index 0e6113f349d..1a2bdfa237c 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, | |||
| 5121 | doc: /* Return t if (car A) is numerically less than (car B). */) | 5121 | doc: /* Return t if (car A) is numerically less than (car B). */) |
| 5122 | (Lisp_Object a, Lisp_Object b) | 5122 | (Lisp_Object a, Lisp_Object b) |
| 5123 | { | 5123 | { |
| 5124 | return Flss (Fcar (a), Fcar (b)); | 5124 | Lisp_Object args[2] = { Fcar (a), Fcar (b), }; |
| 5125 | return Flss (2, args); | ||
| 5125 | } | 5126 | } |
| 5126 | 5127 | ||
| 5127 | /* Build the complete list of annotations appropriate for writing out | 5128 | /* Build the complete list of annotations appropriate for writing out |
diff --git a/src/lisp.h b/src/lisp.h index 38b538d9bc2..2b1af1faa19 100644 --- a/src/lisp.h +++ b/src/lisp.h | |||
| @@ -3160,6 +3160,16 @@ EXFUN (Fbyteorder, 0) ATTRIBUTE_CONST; | |||
| 3160 | /* Defined in data.c. */ | 3160 | /* Defined in data.c. */ |
| 3161 | extern Lisp_Object indirect_function (Lisp_Object); | 3161 | extern Lisp_Object indirect_function (Lisp_Object); |
| 3162 | extern Lisp_Object find_symbol_value (Lisp_Object); | 3162 | extern Lisp_Object find_symbol_value (Lisp_Object); |
| 3163 | enum Arith_Comparison { | ||
| 3164 | ARITH_EQUAL, | ||
| 3165 | ARITH_NOTEQUAL, | ||
| 3166 | ARITH_LESS, | ||
| 3167 | ARITH_GRTR, | ||
| 3168 | ARITH_LESS_OR_EQUAL, | ||
| 3169 | ARITH_GRTR_OR_EQUAL | ||
| 3170 | }; | ||
| 3171 | extern Lisp_Object arithcompare (Lisp_Object num1, Lisp_Object num2, | ||
| 3172 | enum Arith_Comparison comparison); | ||
| 3163 | 3173 | ||
| 3164 | /* Convert the integer I to an Emacs representation, either the integer | 3174 | /* Convert the integer I to an Emacs representation, either the integer |
| 3165 | itself, or a cons of two or three integers, or if all else fails a float. | 3175 | itself, or a cons of two or three integers, or if all else fails a float. |