-/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001,2002,2003,2004,2005, 2006 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001,2002,2003,2004,2005, 2006, 2007, 2008 Free Software Foundation, Inc.
*
* Portions Copyright 1990, 1991, 1992, 1993 by AT&T Bell Laboratories
* and Bellcore. See scm_divide.
*/
-/* tell glibc (2.3) to give prototype for C99 trunc(), csqrt(), etc */
-#define _GNU_SOURCE
-
-#if HAVE_CONFIG_H
+#ifdef HAVE_CONFIG_H
# include <config.h>
#endif
#endif
}
+#if defined (GUILE_I)
+#if HAVE_COMPLEX_DOUBLE
/* For an SCM object Z which is a complex number (ie. satisfies
SCM_COMPLEXP), return its value as a C level "complex double". */
#define SCM_COMPLEX_VALUE(z) \
- (SCM_COMPLEX_REAL (z) + _Complex_I * SCM_COMPLEX_IMAG (z))
+ (SCM_COMPLEX_REAL (z) + GUILE_I * SCM_COMPLEX_IMAG (z))
+
+static inline SCM scm_from_complex_double (complex double z) SCM_UNUSED;
/* Convert a C "complex double" to an SCM value. */
-#if HAVE_COMPLEX_DOUBLE
-static SCM
+static inline SCM
scm_from_complex_double (complex double z)
{
return scm_c_make_rectangular (creal (z), cimag (z));
}
+
#endif /* HAVE_COMPLEX_DOUBLE */
+#endif /* GUILE_I */
\f
\f
-SCM_C_INLINE_KEYWORD SCM
+SCM
scm_i_mkbig ()
{
/* Return a newly created bignum. */
return z;
}
-SCM_C_INLINE_KEYWORD SCM
+SCM
scm_i_long2big (long x)
{
/* Return a newly created bignum initialized to X. */
return z;
}
-SCM_C_INLINE_KEYWORD SCM
+SCM
scm_i_ulong2big (unsigned long x)
{
/* Return a newly created bignum initialized to X. */
return z;
}
-SCM_C_INLINE_KEYWORD SCM
+SCM
scm_i_clonebig (SCM src_big, int same_sign_p)
{
/* Copy src_big's value, negate it if same_sign_p is false, and return. */
return z;
}
-SCM_C_INLINE_KEYWORD int
+int
scm_i_bigcmp (SCM x, SCM y)
{
/* Return neg if x < y, pos if x > y, and 0 if x == y */
return result;
}
-SCM_C_INLINE_KEYWORD SCM
+SCM
scm_i_dbl2big (double d)
{
/* results are only defined if d is an integer */
/* Convert a integer in double representation to a SCM number. */
-SCM_C_INLINE_KEYWORD SCM
+SCM
scm_i_dbl2num (double u)
{
/* SCM_MOST_POSITIVE_FIXNUM+1 and SCM_MOST_NEGATIVE_FIXNUM are both
return result;
}
-SCM_C_INLINE_KEYWORD SCM
+SCM
scm_i_normbig (SCM b)
{
/* convert a big back to a fixnum if it'll fit */
SCM
scm_sum (SCM x, SCM y)
{
- if (SCM_UNBNDP (y))
+ if (SCM_UNLIKELY (SCM_UNBNDP (y)))
{
if (SCM_NUMBERP (x)) return x;
if (SCM_UNBNDP (x)) return SCM_INUM0;
SCM_WTA_DISPATCH_1 (g_sum, x, SCM_ARG1, s_sum);
}
- if (SCM_I_INUMP (x))
+ if (SCM_LIKELY (SCM_I_INUMP (x)))
{
- if (SCM_I_INUMP (y))
+ if (SCM_LIKELY (SCM_I_INUMP (y)))
{
long xx = SCM_I_INUM (x);
long yy = SCM_I_INUM (y);
SCM
scm_difference (SCM x, SCM y)
{
- if (SCM_UNBNDP (y))
+ if (SCM_UNLIKELY (SCM_UNBNDP (y)))
{
if (SCM_UNBNDP (x))
SCM_WTA_DISPATCH_0 (g_difference, s_difference);
SCM_WTA_DISPATCH_1 (g_difference, x, SCM_ARG1, s_difference);
}
- if (SCM_I_INUMP (x))
+ if (SCM_LIKELY (SCM_I_INUMP (x)))
{
- if (SCM_I_INUMP (y))
+ if (SCM_LIKELY (SCM_I_INUMP (y)))
{
long int xx = SCM_I_INUM (x);
long int yy = SCM_I_INUM (y);
SCM
scm_product (SCM x, SCM y)
{
- if (SCM_UNBNDP (y))
+ if (SCM_UNLIKELY (SCM_UNBNDP (y)))
{
if (SCM_UNBNDP (x))
return SCM_I_MAKINUM (1L);
SCM_WTA_DISPATCH_1 (g_product, x, SCM_ARG1, s_product);
}
- if (SCM_I_INUMP (x))
+ if (SCM_LIKELY (SCM_I_INUMP (x)))
{
long xx;
case 1: return y; break;
}
- if (SCM_I_INUMP (y))
+ if (SCM_LIKELY (SCM_I_INUMP (y)))
{
long yy = SCM_I_INUM (y);
long kk = xx * yy;
else if (SCM_REALP (x))
{
if (SCM_I_INUMP (y))
- return scm_from_double (SCM_I_INUM (y) * SCM_REAL_VALUE (x));
+ {
+ /* inexact*exact0 => exact 0, per R5RS "Exactness" section */
+ if (scm_is_eq (y, SCM_INUM0))
+ return y;
+ return scm_from_double (SCM_I_INUM (y) * SCM_REAL_VALUE (x));
+ }
else if (SCM_BIGP (y))
{
double result = mpz_get_d (SCM_I_BIG_MPZ (y)) * SCM_REAL_VALUE (x);
else if (SCM_COMPLEXP (x))
{
if (SCM_I_INUMP (y))
- return scm_c_make_rectangular (SCM_I_INUM (y) * SCM_COMPLEX_REAL (x),
- SCM_I_INUM (y) * SCM_COMPLEX_IMAG (x));
+ {
+ /* inexact*exact0 => exact 0, per R5RS "Exactness" section */
+ if (scm_is_eq (y, SCM_INUM0))
+ return y;
+ return scm_c_make_rectangular (SCM_I_INUM (y) * SCM_COMPLEX_REAL (x),
+ SCM_I_INUM (y) * SCM_COMPLEX_IMAG (x));
+ }
else if (SCM_BIGP (y))
{
double z = mpz_get_d (SCM_I_BIG_MPZ (y));
{
double a;
- if (SCM_UNBNDP (y))
+ if (SCM_UNLIKELY (SCM_UNBNDP (y)))
{
if (SCM_UNBNDP (x))
SCM_WTA_DISPATCH_0 (g_divide, s_divide);
SCM_WTA_DISPATCH_1 (g_divide, x, SCM_ARG1, s_divide);
}
- if (SCM_I_INUMP (x))
+ if (SCM_LIKELY (SCM_I_INUMP (x)))
{
long xx = SCM_I_INUM (x);
- if (SCM_I_INUMP (y))
+ if (SCM_LIKELY (SCM_I_INUMP (y)))
{
long yy = SCM_I_INUM (y);
if (yy == 0)
else
{
SCM z;
- SCM_NEWSMOB (z, scm_tc16_complex, scm_gc_malloc (sizeof (scm_t_complex),
- "complex"));
+ SCM_NEWSMOB (z, scm_tc16_complex,
+ scm_gc_malloc_pointerless (sizeof (scm_t_complex),
+ "complex"));
SCM_COMPLEX_REAL (z) = re;
SCM_COMPLEX_IMAG (z) = im;
return z;
}
SCM_DEFINE (scm_make_rectangular, "make-rectangular", 2, 0, 0,
- (SCM real, SCM imaginary),
- "Return a complex number constructed of the given @var{real} and\n"
- "@var{imaginary} parts.")
+ (SCM real_part, SCM imaginary_part),
+ "Return a complex number constructed of the given @var{real-part} "
+ "and @var{imaginary-part} parts.")
#define FUNC_NAME s_scm_make_rectangular
{
struct dpair xy;
- scm_two_doubles (real, imaginary, FUNC_NAME, &xy);
+ scm_two_doubles (real_part, imaginary_part, FUNC_NAME, &xy);
return scm_c_make_rectangular (xy.x, xy.y);
}
#undef FUNC_NAME
#undef FUNC_NAME
SCM_DEFINE (scm_rationalize, "rationalize", 2, 0, 0,
- (SCM x, SCM err),
- "Return an exact number that is within @var{err} of @var{x}.")
+ (SCM x, SCM eps),
+ "Returns the @emph{simplest} rational number differing\n"
+ "from @var{x} by no more than @var{eps}.\n"
+ "\n"
+ "As required by @acronym{R5RS}, @code{rationalize} only returns an\n"
+ "exact result when both its arguments are exact. Thus, you might need\n"
+ "to use @code{inexact->exact} on the arguments.\n"
+ "\n"
+ "@lisp\n"
+ "(rationalize (inexact->exact 1.2) 1/100)\n"
+ "@result{} 6/5\n"
+ "@end lisp")
#define FUNC_NAME s_scm_rationalize
{
if (SCM_I_INUMP (x))
converges after less than a dozen iterations.
*/
- err = scm_abs (err);
+ eps = scm_abs (eps);
while (++i < 1000000)
{
a = scm_sum (scm_product (a1, tt), a2); /* a = a1*tt + a2 */
if (scm_is_false (scm_zero_p (b)) && /* b != 0 */
scm_is_false
(scm_gr_p (scm_abs (scm_difference (ex, scm_divide (a, b))),
- err))) /* abs(x-a/b) <= err */
+ eps))) /* abs(x-a/b) <= eps */
{
SCM res = scm_sum (int_part, scm_divide (a, b));
if (scm_is_false (scm_exact_p (x))
- || scm_is_false (scm_exact_p (err)))
+ || scm_is_false (scm_exact_p (eps)))
return scm_exact_to_inexact (res);
else
return res;
{
if (SCM_COMPLEXP (z))
{
-#if HAVE_COMPLEX_DOUBLE
+#if HAVE_COMPLEX_DOUBLE && HAVE_CLOG && defined (SCM_COMPLEX_VALUE)
return scm_from_complex_double (clog (SCM_COMPLEX_VALUE (z)));
#else
double re = SCM_COMPLEX_REAL (z);
/* Mingw has clog() but not clog10(). (Maybe it'd be worth using
clog() and a multiply by M_LOG10E, rather than the fallback
log10+hypot+atan2.) */
-#if HAVE_COMPLEX_DOUBLE && HAVE_CLOG10
+#if HAVE_COMPLEX_DOUBLE && HAVE_CLOG10 && defined (SCM_COMPLEX_VALUE)
return scm_from_complex_double (clog10 (SCM_COMPLEX_VALUE (z)));
#else
double re = SCM_COMPLEX_REAL (z);
{
if (SCM_COMPLEXP (z))
{
-#if HAVE_COMPLEX_DOUBLE
+#if HAVE_COMPLEX_DOUBLE && HAVE_CEXP && defined (SCM_COMPLEX_VALUE)
return scm_from_complex_double (cexp (SCM_COMPLEX_VALUE (z)));
#else
return scm_c_make_polar (exp (SCM_COMPLEX_REAL (z)),
{
if (SCM_COMPLEXP (x))
{
-#if HAVE_COMPLEX_DOUBLE && HAVE_USABLE_CSQRT
+#if HAVE_COMPLEX_DOUBLE && HAVE_USABLE_CSQRT && defined (SCM_COMPLEX_VALUE)
return scm_from_complex_double (csqrt (SCM_COMPLEX_VALUE (x)));
#else
double re = SCM_COMPLEX_REAL (x);
HCoop / bpt / guile.git / blobdiff