c99 number funcs

c99 number funcs

[Kevin Ryde]

[-- Attachment #1: Type: text/plain, Size: 881 bytes --]

This is a small change to make use of c99 math functions when
available, for instance in recent glibc.

There shouldn't be much difference, though there's probably a good
chance of getting higher accuracy or range from the library asinh etc
than from an equivalent expression.

Removing the private isfinite is a good thing on its own, don't want
to have problems on a c99 system.

	* configure.in (AC_CHECK_FUNCS): Add asinh, acosh, atanh, round, trunc.

	* numbers.c (_GNU_SOURCE): #define, to get C99 things.
	(scm_asinh, scm_acosh, scm_atanh, scm_truncate, scm_round, $asinh,
	$acosh, $atanh, truncate, round): Use C library asinh, acosh, atanh,
	trunc and round, when available.
	(scm_inexact_to_exact): Expand isfinite to its definition !isinf.
	(isfinite): Remove, conflicts with C99 isfinite().

	* tests/numbers.test (trunc, round, asinh, acosh, atanh): Add some
	tests.


[-- Attachment #2: configure.in.c99.diff --]
[-- Type: text/plain, Size: 569 bytes --]

--- configure.in.~1.219.~	2003-05-31 09:42:52.000000000 +1000
+++ configure.in	2003-06-12 11:03:09.000000000 +1000
@@ -753,7 +753,10 @@
 
 AC_CHECK_HEADERS(floatingpoint.h ieeefp.h nan.h)
 
-AC_CHECK_FUNCS(finite isinf isnan copysign)
+# asinh, acosh, atanh, round and trunc (all in -lm) are only C99 standard
+# and older systems generally don't have them.
+#
+AC_CHECK_FUNCS(asinh acosh atanh copysign finite isinf isnan round trunc)
 
 # When testing for the presence of alloca, we need to add alloca.o
 # explicitly to LIBOBJS to make sure that it is translated to

[-- Attachment #3: numbers.c.c99.diff --]
[-- Type: text/plain, Size: 3406 bytes --]

--- numbers.c.~1.191.~	2003-06-05 01:56:18.000000000 +1000
+++ numbers.c	2003-06-12 10:59:40.000000000 +1000
@@ -39,6 +39,9 @@
 
  */
 
+/* tell glibc (2.3) to give prototypes for C99 trunc() and round() */
+#define _GNU_SOURCE
+
 #if HAVE_CONFIG_H
 #  include <config.h>
 #endif
@@ -263,8 +266,6 @@
 #endif
 }
 
-#define isfinite(x) (! xisinf (x))
-
 SCM_DEFINE (scm_inf_p, "inf?", 1, 0, 0, 
             (SCM n),
 	    "Return @code{#t} if @var{n} is infinite, @code{#f}\n"
@@ -3643,61 +3644,87 @@
 }
 #undef FUNC_NAME
 
-SCM_GPROC1 (s_asinh, "$asinh", scm_tc7_dsubr, (SCM (*)()) scm_asinh, g_asinh);
-/* "Return the inverse hyperbolic sine of @var{x}."
- */
+
 double
 scm_asinh (double x)
 {
+#if HAVE_ASINH
+  return asinh (x);
+#else
+#define asinh scm_asinh
   return log (x + sqrt (x * x + 1));
+#endif
 }
+SCM_GPROC1 (s_asinh, "$asinh", scm_tc7_dsubr, (SCM (*)()) asinh, g_asinh);
+/* "Return the inverse hyperbolic sine of @var{x}."
+ */
 
 
-SCM_GPROC1 (s_acosh, "$acosh", scm_tc7_dsubr, (SCM (*)()) scm_acosh, g_acosh);
-/* "Return the inverse hyperbolic cosine of @var{x}."
- */
 double
 scm_acosh (double x)
 {
+#if HAVE_ACOSH
+  return acosh (x);
+#else
+#define acosh scm_acosh
   return log (x + sqrt (x * x - 1));
+#endif
 }
+SCM_GPROC1 (s_acosh, "$acosh", scm_tc7_dsubr, (SCM (*)()) acosh, g_acosh);
+/* "Return the inverse hyperbolic cosine of @var{x}."
+ */
 
 
-SCM_GPROC1 (s_atanh, "$atanh", scm_tc7_dsubr, (SCM (*)()) scm_atanh, g_atanh);
-/* "Return the inverse hyperbolic tangent of @var{x}."
- */
 double
 scm_atanh (double x)
 {
+#if HAVE_ATANH
+  return atanh (x);
+#else
+#define atanh scm_atanh
   return 0.5 * log ((1 + x) / (1 - x));
+#endif
 }
+SCM_GPROC1 (s_atanh, "$atanh", scm_tc7_dsubr, (SCM (*)()) atanh, g_atanh);
+/* "Return the inverse hyperbolic tangent of @var{x}."
+ */
 
 
-SCM_GPROC1 (s_truncate, "truncate", scm_tc7_dsubr, (SCM (*)()) scm_truncate, g_truncate);
-/* "Round the inexact number @var{x} towards zero."
- */
 double
 scm_truncate (double x)
 {
+#if HAVE_TRUNC
+  return trunc (x);
+#else
+#define trunc scm_truncate
   if (x < 0.0)
     return -floor (-x);
   return floor (x);
+#endif
 }
+SCM_GPROC1 (s_truncate, "truncate", scm_tc7_dsubr, (SCM (*)()) trunc, g_truncate);
+/* "Round the inexact number @var{x} towards zero."
+ */
 
 
-SCM_GPROC1 (s_round, "round", scm_tc7_dsubr, (SCM (*)()) scm_round, g_round);
-/* "Round the inexact number @var{x}. If @var{x} is halfway between two\n"
- * "numbers, round towards even."
- */
 double
 scm_round (double x)
 {
+#if HAVE_ROUND
+  return round (x);
+#else
+#define round scm_round
   double plus_half = x + 0.5;
   double result = floor (plus_half);
   /* Adjust so that the scm_round is towards even.  */
   return (plus_half == result && plus_half / 2 != floor (plus_half / 2))
     ? result - 1 : result;
+#endif
 }
+SCM_GPROC1 (s_round, "round", scm_tc7_dsubr, (SCM (*)()) scm_round, g_round);
+/* "Round the inexact number @var{x}. If @var{x} is halfway between two\n"
+ * "numbers, round towards even."
+ */
 
 
 SCM_GPROC1 (s_i_floor, "floor", scm_tc7_dsubr, (SCM (*)()) floor, g_i_floor);
@@ -3973,7 +4000,7 @@
     long lu = (long) u;
     if (SCM_FIXABLE (lu)) {
       return SCM_MAKINUM (lu);
-    } else if (isfinite (u) && !xisnan (u)) {
+    } else if (!xisinf (u) && !xisnan (u)) {
       return scm_i_dbl2big (u);
     } else {
       scm_num_overflow (s_scm_inexact_to_exact);

[-- Attachment #4: numbers.test.c99.diff --]
[-- Type: text/plain, Size: 994 bytes --]

--- numbers.test.~1.25.~	2003-06-05 02:10:17.000000000 +1000
+++ numbers.test	2003-06-08 17:18:43.000000000 +1000
@@ -1863,10 +1863,30 @@
 ;;; truncate
 ;;;
 
+(with-test-prefix "trunc"
+  (pass-if "0.5"
+    (= 0 (trunc 0.5)))
+  (pass-if "1.5"
+    (= 2 (trunc 1.5)))
+  (pass-if "-0.5"
+    (= 0 (trunc -1.5)))
+  (pass-if "-1.5"
+    (= -2 (trunc -1.5))))
+
 ;;;
 ;;; round
 ;;;
 
+(with-test-prefix "round"
+  (pass-if "0.5"
+    (= 1 (round 0.5)))
+  (pass-if "1.5"
+    (= 2 (round 1.5)))
+  (pass-if "-0.5"
+    (= -2 (round -1.5)))
+  (pass-if "-1.5"
+    (= -1 (round -1.5))))
+
 ;;;
 ;;; exact->inexact
 ;;;
@@ -1890,6 +1910,27 @@
   (pass-if "(= 1 (expt 0.0 0.0))" (= 1 (expt 0.0 0.0))))
 
 ;;;
+;;; asinh
+;;;
+
+(with-test-prefix "asinh"
+  (pass-if "0" (= 0 (asinh 0))))
+
+;;;
+;;; acosh
+;;;
+
+(with-test-prefix "acosh"
+  (pass-if "1" (= 0 (acosh 1))))
+
+;;;
+;;; atanh
+;;;
+
+(with-test-prefix "atanh"
+  (pass-if "0" (= 0 (atanh 0))))
+
+;;;
 ;;; make-rectangular
 ;;;
 

[-- Attachment #5: Type: text/plain, Size: 142 bytes --]

_______________________________________________
Guile-devel mailing list
Guile-devel@gnu.org
http://mail.gnu.org/mailman/listinfo/guile-devel

Re: c99 number funcs

[Kevin Ryde]

I made this change.  I realized though I had the c99 "round" function
doesn't do what's desired, so I left scm_round etc alone.


_______________________________________________
Guile-devel mailing list
Guile-devel@gnu.org
http://mail.gnu.org/mailman/listinfo/guile-devel