From 1ccc6d458fbda380233019a1d80d5aff576d9d03 Mon Sep 17 00:00:00 2001 From: Kaz Kylheku Date: Thu, 22 Mar 2012 10:48:00 -0700 Subject: Fix sqrt confusion. There must be a separate isqrt for the integer square root. * arith.c (sqroot_fixnum): Renamed back to isqrt_fixnum. (sqroot): Rewritten to handle only floating-point square root. (isqrt): New function, based on previous sqroot, handles only integers. * eval.c (eval_init): New intrinsic, isqrt. * lib.h (isqrt): New declaration. * txr.1: Doc stubs. * txr.vim: Highlighting for isqrt. --- ChangeLog | 18 ++++++++++++++++++ arith.c | 22 ++++++++++------------ eval.c | 3 ++- lib.h | 1 + txr.1 | 8 ++++++-- txr.vim | 2 +- 6 files changed, 38 insertions(+), 16 deletions(-) diff --git a/ChangeLog b/ChangeLog index 0a264e7c..e9ad5953 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,21 @@ +2012-03-22 Kaz Kylheku + + Fix sqrt confusion. There must be a separate isqrt + for the integer square root. + + * arith.c (sqroot_fixnum): Renamed back to isqrt_fixnum. + (sqroot): Rewritten to handle only floating-point square root. + (isqrt): New function, based on previous sqroot, + handles only integers. + + * eval.c (eval_init): New intrinsic, isqrt. + + * lib.h (isqrt): New declaration. + + * txr.1: Doc stubs. + + * txr.vim: Highlighting for isqrt. + 2012-03-22 Kaz Kylheku * arith.c (floorf, ceili, sine, cosi, atang, loga): New functions. diff --git a/arith.c b/arith.c index a820dc8e..27ac3faf 100644 --- a/arith.c +++ b/arith.c @@ -1225,7 +1225,7 @@ inval: base, exp, mod, nao); } -static int_ptr_t sqroot_fixnum(int_ptr_t a) +static int_ptr_t isqrt_fixnum(int_ptr_t a) { int_ptr_t mask = (int_ptr_t) 1 << (highest_bit(a) / 2); int_ptr_t root = 0; @@ -1239,7 +1239,7 @@ static int_ptr_t sqroot_fixnum(int_ptr_t a) return root; } -val sqroot(val anum) +val isqrt(val anum) { switch (type(anum)) { case NUM: @@ -1247,7 +1247,7 @@ val sqroot(val anum) cnum a = c_num(anum); if (a < 0) goto negop; - return num_fast(sqroot_fixnum(c_num(anum))); + return num_fast(isqrt_fixnum(c_num(anum))); } case BGNUM: { @@ -1256,20 +1256,13 @@ val sqroot(val anum) goto negop; return normalize(n); } - case FLNUM: - { - double a = c_flo(anum); - if (a < 0) - goto negop; - return flo(sqrt(a)); - } default: break; } - uw_throwf(error_s, lit("sqrt: invalid operand ~s"), anum, nao); + uw_throwf(error_s, lit("isqrt: non-integer operand ~s"), anum, nao); negop: - uw_throw(error_s, lit("sqrt: negative operand")); + uw_throw(error_s, lit("isqrt: negative operand")); } val gcd(val anum, val bnum) @@ -1326,6 +1319,11 @@ val loga(val num) return flo(log(c_flo(to_float(lit("log"), num)))); } +val sqroot(val num) +{ + return flo(sqrt(c_flo(to_float(lit("sqrt"), num)))); +} + /* * TODO: replace this text-based hack! */ diff --git a/eval.c b/eval.c index af3b6a22..db568c0d 100644 --- a/eval.c +++ b/eval.c @@ -2185,7 +2185,7 @@ void eval_init(void) reg_fun(intern(lit("/"), user_package), func_n2(divi)); reg_fun(intern(lit("expt"), user_package), func_n0v(exptv)); reg_fun(intern(lit("exptmod"), user_package), func_n3(exptmod)); - reg_fun(intern(lit("sqrt"), user_package), func_n1(sqroot)); + reg_fun(intern(lit("isqrt"), user_package), func_n1(isqrt)); reg_fun(intern(lit("gcd"), user_package), func_n2(gcd)); reg_fun(intern(lit("floor"), user_package), func_n1(floorf)); reg_fun(intern(lit("ceil"), user_package), func_n1(ceili)); @@ -2193,6 +2193,7 @@ void eval_init(void) reg_fun(intern(lit("cos"), user_package), func_n1(cosi)); reg_fun(intern(lit("atan"), user_package), func_n1(atang)); reg_fun(intern(lit("log"), user_package), func_n1(loga)); + reg_fun(intern(lit("sqrt"), user_package), func_n1(sqroot)); reg_fun(intern(lit("fixnump"), user_package), func_n1(fixnump)); reg_fun(intern(lit("bignump"), user_package), func_n1(bignump)); reg_fun(intern(lit("floatp"), user_package), func_n1(floatp)); diff --git a/lib.h b/lib.h index e4dbfb8d..9876d77f 100644 --- a/lib.h +++ b/lib.h @@ -425,6 +425,7 @@ val expt(val base, val exp); val exptv(val nlist); val exptmod(val base, val exp, val mod); val sqroot(val anum); +val isqrt(val anum); val gcd(val anum, val bnum); val floorf(val); val ceili(val); diff --git a/txr.1 b/txr.1 index 280da48e..9a8e4d80 100644 --- a/txr.1 +++ b/txr.1 @@ -6641,9 +6641,9 @@ symbols, packages, or streams are equal if they are the same hash. Certain object types have a custom equal function. -.SS Arithmetic functions +, -, *, /, trunc, mod, expt, sqrt +.SS Arithmetic functions +, -, * -.SS Arithmetic function exptmod +.SS Arithmetic function /, trunc, mod .SS Arithmetic function gcd @@ -6651,6 +6651,10 @@ Certain object types have a custom equal function. .SS Arithmetic functions floor, ceil, sin, cos, atan, log +.SS Arithmetic functions expt, sqrt, isqrt + +.SS Arithmetic function exptmod + .SS Functions fixnump, bignump, integerp, floatp, numberp .SS Functions zerop, evenp, oddp diff --git a/txr.vim b/txr.vim index 95b7c0f9..c219d01a 100644 --- a/txr.vim +++ b/txr.vim @@ -43,7 +43,7 @@ syn keyword txl_keyword contained reverse ldiff flatten lazy-flatten syn keyword txl_keyword contained memq memql memqual tree-find some syn keyword txl_keyword contained remq remql remqual syn keyword txl_keyword contained all none eq eql equal + - * / abs trunc mod -syn keyword txl_keyword contained expt exptmod sqrt gcd +syn keyword txl_keyword contained expt exptmod sqrt isqrt gcd syn keyword txl_keyword contained floor ceil sin cos atan log syn keyword txl_keyword contained fixnump bignump integerp floatp syn keyword txl_keyword contained numberp zerop evenp oddp > -- cgit v1.2.3