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.

6 files changed, 38 insertions, 16 deletions

diff --git a/ChangeLog b/ChangeLog
index 0a264e7c..e9ad5953 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,5 +1,23 @@
 2012-03-22  Kaz Kylheku  <kaz@kylheku.com>
 
+	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  <kaz@kylheku.com>
+
 	* arith.c (floorf, ceili, sine, cosi, atang, loga): New functions.
 
 	* eval.c (eval_init): New intrinsic functions registered:
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 >