diff src/number.h @ 1983:9c872f33ecbe

[xemacs-hg @ 2004-04-05 22:49:31 by james] Add bignum, ratio, and bigfloat support.
author james
date Mon, 05 Apr 2004 22:50:11 +0000
parents
children 4e6a63799f08
line wrap: on
line diff
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/number.h	Mon Apr 05 22:50:11 2004 +0000
@@ -0,0 +1,329 @@
+/* Definitions of numeric types for XEmacs.
+   Copyright (C) 2004 Jerry James.
+
+This file is part of XEmacs.
+
+XEmacs is free software; you can redistribute it and/or modify it
+under the terms of the GNU General Public License as published by the
+Free Software Foundation; either version 2, or (at your option) any
+later version.
+
+XEmacs is distributed in the hope that it will be useful, but WITHOUT
+ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+for more details.
+
+You should have received a copy of the GNU General Public License
+along with XEmacs; see the file COPYING.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+Boston, MA 02111-1307, USA.  */
+
+/* Synched up with: Not in FSF. */
+
+#ifndef INCLUDED_number_h_
+#define INCLUDED_number_h_
+
+/* The following types are always defined in the same manner:
+   fixnum       = whatever fits in the Lisp_Object type
+   integer      = union (fixnum, bignum)
+   rational     = union (integer, ratio)
+   float        = C double
+   floating     = union(float, bigfloat)  Anybody got a better name?
+   real         = union (rational, floating)
+   number       = real  (should be union(real, complex) but no complex yet)
+
+   It is up to the library-specific code to define the remaining types,
+   namely: bignum, ratio, and bigfloat.  Not all of these types may be
+   available.  The top-level configure script should define the symbols
+   HAVE_BIGNUM, HAVE_RATIO, and HAVE_BIGFLOAT to indicate which it provides.
+   If some type is not defined by the library, this is what happens:
+
+   - bignum: bignump(x) is false for all x; any attempt to create a bignum
+     causes an error to be raised.
+
+   - ratio: we define our own structure consisting of two Lisp_Objects, which
+     are presumed to be integers (i.e., either fixnums or bignums).  We do our
+     own GCD calculation, which is bound to be slow, to keep the ratios
+     reduced to canonical form.  (FIXME: Not yet implemented.)
+
+   - bigfloat: bigfloat(x) is false for all x; any attempt to create a
+     bigfloat causes an error to be raised.
+
+   We (provide) the following symbols, so that Lisp code has some hope of
+   using this correctly:
+
+   - (provide 'bignum) if HAVE_BIGNUM
+   - (provde 'ratio) if HAVE_RATIO
+   - (provide 'bigfloat) if HAVE_BIGFLOAT
+*/
+
+/* Load the library definitions */
+#ifdef WITH_GMP
+#include "number-gmp.h"
+#endif
+#ifdef WITH_MP
+#include "number-mp.h"
+#endif
+
+
+/********************************* Bignums **********************************/
+#ifdef HAVE_BIGNUM
+
+struct Lisp_Bignum
+{
+  struct lrecord_header lheader;
+  bignum data;
+};
+typedef struct Lisp_Bignum Lisp_Bignum;
+
+DECLARE_LRECORD (bignum, Lisp_Bignum);
+#define XBIGNUM(x) XRECORD (x, bignum, Lisp_Bignum)
+#define wrap_bignum(p) wrap_record (p, bignum)
+#define BIGNUMP(x) RECORDP (x, bignum)
+#define CHECK_BIGNUM(x) CHECK_RECORD (x, bignum)
+#define CONCHECK_BIGNUM(x) CONCHECK_RECORD (x, bignum)
+
+#define bignum_data(b) (b)->data
+#define XBIGNUM_DATA(x) bignum_data (XBIGNUM (x))
+
+#define BIGNUM_ARITH_RETURN(b,op) do				\
+{								\
+  Lisp_Object retval = make_bignum (0);				\
+  bignum_##op (XBIGNUM_DATA (retval), XBIGNUM_DATA (b));	\
+  return Fcanonicalize_number (retval);				\
+} while (0)
+
+#define BIGNUM_ARITH_RETURN1(b,op,arg) do			\
+{								\
+  Lisp_Object retval = make_bignum(0);				\
+  bignum_##op (XBIGNUM_DATA (retval), XBIGNUM_DATA (b), arg);	\
+  return Fcanonicalize_number (retval);				\
+} while (0)
+
+extern Lisp_Object make_bignum (long);
+extern Lisp_Object make_bignum_bg (bignum);
+extern bignum scratch_bignum, scratch_bignum2;
+
+#else /* !HAVE_BIGNUM */
+
+extern Lisp_Object Qbignump;
+#define BIGNUMP(x)         0
+#define CHECK_BIGNUM(x)    dead_wrong_type_argument (Qbignump, x)
+#define CONCHECK_BIGNUM(x) dead_wrong_type_argument (Qbignump, x)
+typedef void bignum;
+#define make_bignum(l)     This XEmacs does not support bignums
+#define make_bignum_bg(b)  This XEmacs does not support bignums
+
+#endif /* HAVE_BIGNUM */
+
+EXFUN (Fbignump, 1);
+
+
+/********************************* Integers *********************************/
+extern Lisp_Object Qintegerp;
+
+#define INTEGERP(x) (INTP(x) || BIGNUMP(x))
+#define CHECK_INTEGER(x) do {			\
+ if (!INTEGERP (x))				\
+   dead_wrong_type_argument (Qintegerp, x);	\
+ } while (0)
+#define CONCHECK_INTEGER(x) do {		\
+ if (!INTEGERP (x))				\
+   x = wrong_type_argument (Qintegerp, x);	\
+}  while (0)
+
+#ifdef HAVE_BIGNUM
+#define make_integer(x) \
+  (NUMBER_FITS_IN_AN_EMACS_INT (x) ? make_int (x) : make_bignum (x))
+#else
+#define make_integer(x) make_int (x)
+#endif
+
+extern Fixnum Vmost_negative_fixnum, Vmost_positive_fixnum;
+EXFUN (Fintegerp, 1);
+EXFUN (Fevenp, 1);
+EXFUN (Foddp, 1);
+
+
+/********************************** Ratios **********************************/
+#ifdef HAVE_RATIO
+
+struct Lisp_Ratio
+{
+  struct lrecord_header lheader;
+  ratio data;
+};
+typedef struct Lisp_Ratio Lisp_Ratio;
+
+DECLARE_LRECORD (ratio, Lisp_Ratio);
+#define XRATIO(x) XRECORD (x, ratio, Lisp_Ratio)
+#define wrap_ratio(p) wrap_record (p, ratio)
+#define RATIOP(x) RECORDP (x, ratio)
+#define CHECK_RATIO(x) CHECK_RECORD (x, ratio)
+#define CONCHECK_RATIO(x) CONCHECK_RECORD (x, ratio)
+
+#define ratio_data(r) (r)->data
+
+#define XRATIO_DATA(r) ratio_data (XRATIO (r))
+#define XRATIO_NUMERATOR(r) ratio_numerator (XRATIO_DATA (r))
+#define XRATIO_DENOMINATOR(r) ratio_denominator (XRATIO_DATA (r))
+
+#define RATIO_ARITH_RETURN(r,op) do			\
+{							\
+  Lisp_Object retval = make_ratio (0L, 1UL);		\
+  ratio_##op (XRATIO_DATA (retval), XRATIO_DATA (r));	\
+  return Fcanonicalize_number (retval);			\
+} while (0)
+
+#define RATIO_ARITH_RETURN1(r,op,arg) do			\
+{								\
+  Lisp_Object retval = make_ratio (0L, 1UL);			\
+  ratio_##op (XRATIO_DATA (retval), XRATIO_DATA (r), arg);	\
+  return Fcanonicalize_number (retval);				\
+} while (0)
+
+extern Lisp_Object make_ratio (long, unsigned long);
+extern Lisp_Object make_ratio_bg (bignum, bignum);
+extern Lisp_Object make_ratio_rt (ratio);
+extern ratio scratch_ratio;
+
+#else /* !HAVE_RATIO */
+
+extern Lisp_Object Qratiop;
+#define RATIOP(x)          0
+#define CHECK_RATIO(x)     dead_wrong_type_argument (Qratiop, x)
+#define CONCHECK_RATIO(x)  dead_wrong_type_argument (Qratiop, x)
+typedef void ratio;
+#define make_ratio(n,d)    This XEmacs does not support ratios
+#define make_ratio_bg(n,d) This XEmacs does not support ratios
+
+#endif /* HAVE_RATIO */
+
+EXFUN (Fratiop, 1);
+
+
+/******************************** Rationals *********************************/
+extern Lisp_Object Qrationalp;
+
+#define RATIONALP(x) (INTEGERP(x) || RATIOP(x))
+#define CHECK_RATIONAL(x) do {			\
+ if (!RATIONALP (x))				\
+   dead_wrong_type_argument (Qrationalp, x);	\
+ } while (0)
+#define CONCHECK_RATIONAL(x) do {		\
+ if (!RATIONALP (x))				\
+   x = wrong_type_argument (Qrationalp, x);	\
+}  while (0)
+
+EXFUN (Frationalp, 1);
+EXFUN (Fnumerator, 1);
+EXFUN (Fdenominator, 1);
+
+
+/******************************** Bigfloats *********************************/
+#ifdef HAVE_BIGFLOAT
+struct Lisp_Bigfloat
+{
+  struct lrecord_header lheader;
+  bigfloat bf;
+};
+typedef struct Lisp_Bigfloat Lisp_Bigfloat;
+
+DECLARE_LRECORD (bigfloat, Lisp_Bigfloat);
+#define XBIGFLOAT(x) XRECORD (x, bigfloat, Lisp_Bigfloat)
+#define wrap_bigfloat(p) wrap_record (p, bigfloat)
+#define BIGFLOATP(x) RECORDP (x, bigfloat)
+#define CHECK_BIGFLOAT(x) CHECK_RECORD (x, bigfloat)
+#define CONCHECK_BIGFLOAT(x) CONCHECK_RECORD (x, bigfloat)
+
+#define bigfloat_data(f) ((f)->bf)
+#define XBIGFLOAT_DATA(x) bigfloat_data (XBIGFLOAT (x))
+#define XBIGFLOAT_GET_PREC(x) bigfloat_get_prec (XBIGFLOAT_DATA (x))
+#define XBIGFLOAT_SET_PREC(x,p) bigfloat_set_prec (XBIGFLOAT_DATA (x), p)
+
+#define BIGFLOAT_ARITH_RETURN(f,op) do				\
+{								\
+  Lisp_Object retval = make_bigfloat_bf (f);			\
+  bigfloat_##op (XBIGFLOAT_DATA (retval), XBIGFLOAT_DATA (f));	\
+  return retval;						\
+} while (0)
+
+#define BIGFLOAT_ARITH_RETURN1(f,op,arg) do				\
+{									\
+  Lisp_Object retval = make_bigfloat_bf (f);				\
+  bigfloat_##op (XBIGFLOAT_DATA (retval), XBIGFLOAT_DATA (f), arg);	\
+  return retval;							\
+} while (0)
+
+extern Lisp_Object make_bigfloat (double, unsigned long);
+extern Lisp_Object make_bigfloat_bf (bigfloat);
+extern Lisp_Object Vdefault_float_precision;
+extern bigfloat scratch_bigfloat, scratch_bigfloat2;
+
+#else /* !HAVE_BIGFLOAT */
+
+extern Lisp_Object Qbigfloatp;
+#define BIGFLOATP(x)         0
+#define CHECK_BIGFLOAT(x)    dead_wrong_type_argument (Qbigfloatp, x)
+#define CONCHECK_BIGFLOAT(x) dead_wrong_type_argument (Qbigfloatp, x)
+typedef void bigfloat;
+#define make_bigfloat(f)     This XEmacs does not support bigfloats
+#define make_bigfloat_bf(f)  This XEmacs does not support bigfloast
+
+#endif /* HAVE_BIGFLOAT */
+
+EXFUN (Fbigfloatp, 1);
+
+/********************************* Floating *********************************/
+extern Lisp_Object Qfloatingp, Qbigfloat;
+extern Lisp_Object Qread_default_float_format, Vread_default_float_format;
+
+#define FLOATINGP(x) (FLOATP (x) || BIGFLOATP (x))
+#define CHECK_FLOATING(x) do {			\
+ if (!FLOATINGP (x))				\
+   dead_wrong_type_argument (Qfloatingp, x);	\
+ } while (0)
+#define CONCHECK_FLOATING(x) do {		\
+ if (!FLOATINGP (x))				\
+   x = wrong_type_argument (Qfloating, x);	\
+}  while (0)
+
+EXFUN (Ffloatp, 1);
+
+
+/********************************** Reals ***********************************/
+extern Lisp_Object Qrealp;
+
+#define REALP(x) (RATIONALP (x) || FLOATINGP (x))
+#define CHECK_REAL(x) do {			\
+ if (!REALP (x))				\
+   dead_wrong_type_argument (Qrealp, x);	\
+ } while (0)
+#define CONCHECK_REAL(x) do {			\
+ if (!REALP (x))				\
+   x = wrong_type_argument (Qrealp, x);		\
+}  while (0)
+
+EXFUN (Frealp, 1);
+
+
+/********************************* Numbers **********************************/
+extern Lisp_Object Qnumberp;
+
+#define NUMBERP(x) REALP (x)
+#define CHECK_NUMBER(x) do {			\
+  if (!NUMBERP (x))				\
+    dead_wrong_type_argument (Qnumberp, x);	\
+} while (0)
+#define CONCHECK_NUMBER(x) do {			\
+  if (!NUMBERP (x))				\
+    x = wrong_type_argument (Qnumberp, x);	\
+} while (0)
+
+EXFUN (Fcanonicalize_number, 1);
+
+enum number_type {FIXNUM_T, BIGNUM_T, RATIO_T, FLOAT_T, BIGFLOAT_T};
+
+extern enum number_type promote_args (Lisp_Object *, Lisp_Object *);
+
+#endif /* INCLUDED_number_h_ */