diff options
| -rw-r--r-- | arith.c | 60 | ||||
| -rwxr-xr-x | configure | 19 | ||||
| -rw-r--r-- | eval.c | 1 | ||||
| -rw-r--r-- | lib.h | 1 | ||||
| -rw-r--r-- | txr.1 | 29 |
5 files changed, 106 insertions, 4 deletions
@@ -1231,6 +1231,66 @@ val ceildiv(val anum, val bnum) return neg(floordiv(neg(anum), bnum)); } +static val round1(val num) +{ + switch (type(num)) { + case NUM: + case BGNUM: + return num; + case FLNUM: +#if HAVE_ROUND + return flo(round(c_flo(num))); +#else + { + double n = c_flo(num); + return if3(n >= 0, + flo(floor(0.5 + n)), + flo(-floor(0.5 + fabs(n)))); + } +#endif + case RNG: + return rcons(round1(from(num)), round1(to(num))); + default: + break; + } + uw_throwf(error_s, lit("round: invalid operand ~s"), num); +} + + +val roundiv(val anum, val bnum) +{ + if (missingp(bnum)) + return round1(anum); + + if (minusp(bnum)) { + anum = neg(anum); + bnum = neg(bnum); + } + + if (rangep(anum)) { + return rcons(roundiv(from(anum), bnum), roundiv(to(anum), bnum)); + } else if (floatp(anum) || floatp(bnum)) { + val quot = divi(anum, bnum); +#if HAVE_ROUND + return flo(round(c_flo(quot))); +#else + { + double q = c_flo(quot); + return if3(q >= 0, + flo(floor(0.5 + q)), + flo(-ceil(0.5 + fabs(q)))); + } +#endif + } else { + val quot = floordiv(anum, bnum); + val rem = minus(anum, mul(quot, bnum)); + val drem = ash(rem, one); + return if3(eq(drem, bnum), + if3(minusp(quot), quot, succ(quot)), + if3(lt(drem, bnum), quot, succ(quot))); + } +} + val wrap_star(val start, val end, val num) { val modulus = minus(end, start); @@ -2128,6 +2128,25 @@ else printf "no\n" fi +printf "Checking for round ... " +cat > conftest.c <<! +#include <math.h> + +int main(void) +{ + double x = round(0.5); + return 0; +} +! +if conftest ; then + printf "yes\n" + printf "#define HAVE_ROUND 1\n" >> $config_h +else + printf "no\n" +fi + + + printf "Checking for glob ... " cat > conftest.c <<! @@ -5704,6 +5704,7 @@ void eval_init(void) reg_fun(intern(lit("lcm"), user_package), func_n0v(lcmv)); reg_fun(intern(lit("floor"), user_package), func_n2o(floordiv, 1)); reg_fun(intern(lit("ceil"), user_package), func_n2o(ceildiv, 1)); + reg_fun(intern(lit("round"), user_package), func_n2o(roundiv, 1)); reg_fun(intern(lit("sin"), user_package), func_n1(sine)); reg_fun(intern(lit("cos"), user_package), func_n1(cosi)); reg_fun(intern(lit("tan"), user_package), func_n1(tang)); @@ -682,6 +682,7 @@ val floorf(val); val floordiv(val, val); val ceili(val); val ceildiv(val anum, val bnum); +val roundiv(val anum, val bnum); val sine(val); val cosi(val); val tang(val); @@ -31688,16 +31688,18 @@ is positive, it is returned. If is negative, its additive inverse is returned: a positive number of the same type with exactly the same magnitude. -.coNP Functions @ floor and @ ceil +.coNP Functions @, floor @ ceil and @ round .synb .mets (floor < dividend <> [ divisor ]) .mets (ceil < dividend <> [ divisor ]) +.mets (round < dividend <> [ divisor ]) .syne .desc The -.code floor -and +.codn floor , .code ceiling +and +.code round functions perform division of the .meta dividend by the @@ -31739,12 +31741,31 @@ of the quotient. does not exceed the value of .metn dividend . That is to say, the division is truncated to an integer -value toward positive infinity. +value toward positive infinity. The +.code round +function returns the nearest integer to the quotient. +Exact halfway cases are rounded to the integer away from +zero so that +.code "(round -1 2)" +yields +.code -1 +and +.code "(round 1 2)" +yields 1, Note that for large floating point values, due to the limited precision, the integer value corresponding to the mathematical floor or ceiling may not be available. +.TP* "Dialect note:" +In ANSI Common Lisp, the +.code round +function chooses the nearest even integer, rather than +rounding halfway cases away from zero. \*(TX's choice +harmonizes with the semantics of the +.code round +function in the C language. + .coNP Functions @, sin @, cos @, tan @, asin @, acos @ atan and @ atan2 .synb .mets (sin << radians ) |