diff options
Diffstat (limited to 'src/data.c')
| -rw-r--r-- | src/data.c | 76 |
1 files changed, 43 insertions, 33 deletions
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, |