Mercurial > hg > xemacs-beta

comparison src/number.h @ 1983:9c872f33ecbe

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
[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
comparison
equal deleted inserted replaced
1982:a748951fd4fb 1983:9c872f33ecbe
1 /* Definitions of numeric types for XEmacs.
2 Copyright (C) 2004 Jerry James.
3
4 This file is part of XEmacs.
5
6 XEmacs is free software; you can redistribute it and/or modify it
7 under the terms of the GNU General Public License as published by the
8 Free Software Foundation; either version 2, or (at your option) any
9 later version.
10
11 XEmacs is distributed in the hope that it will be useful, but WITHOUT
12 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
13 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
14 for more details.
15
16 You should have received a copy of the GNU General Public License
17 along with XEmacs; see the file COPYING. If not, write to
18 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
19 Boston, MA 02111-1307, USA. */
20
21 /* Synched up with: Not in FSF. */
22
23 #ifndef INCLUDED_number_h_
24 #define INCLUDED_number_h_
25
26 /* The following types are always defined in the same manner:
27 fixnum = whatever fits in the Lisp_Object type
28 integer = union (fixnum, bignum)
29 rational = union (integer, ratio)
30 float = C double
31 floating = union(float, bigfloat) Anybody got a better name?
32 real = union (rational, floating)
33 number = real (should be union(real, complex) but no complex yet)
34
35 It is up to the library-specific code to define the remaining types,
36 namely: bignum, ratio, and bigfloat. Not all of these types may be
37 available. The top-level configure script should define the symbols
38 HAVE_BIGNUM, HAVE_RATIO, and HAVE_BIGFLOAT to indicate which it provides.
39 If some type is not defined by the library, this is what happens:
40
41 - bignum: bignump(x) is false for all x; any attempt to create a bignum
42 causes an error to be raised.
43
44 - ratio: we define our own structure consisting of two Lisp_Objects, which
45 are presumed to be integers (i.e., either fixnums or bignums). We do our
46 own GCD calculation, which is bound to be slow, to keep the ratios
47 reduced to canonical form. (FIXME: Not yet implemented.)
48
49 - bigfloat: bigfloat(x) is false for all x; any attempt to create a
50 bigfloat causes an error to be raised.
51
52 We (provide) the following symbols, so that Lisp code has some hope of
53 using this correctly:
54
55 - (provide 'bignum) if HAVE_BIGNUM
56 - (provde 'ratio) if HAVE_RATIO
57 - (provide 'bigfloat) if HAVE_BIGFLOAT
58 */
59
60 /* Load the library definitions */
61 #ifdef WITH_GMP
62 #include "number-gmp.h"
63 #endif
64 #ifdef WITH_MP
65 #include "number-mp.h"
66 #endif
67
68
69 /********************************* Bignums **********************************/
70 #ifdef HAVE_BIGNUM
71
72 struct Lisp_Bignum
73 {
74 struct lrecord_header lheader;
75 bignum data;
76 };
77 typedef struct Lisp_Bignum Lisp_Bignum;
78
79 DECLARE_LRECORD (bignum, Lisp_Bignum);
80 #define XBIGNUM(x) XRECORD (x, bignum, Lisp_Bignum)
81 #define wrap_bignum(p) wrap_record (p, bignum)
82 #define BIGNUMP(x) RECORDP (x, bignum)
83 #define CHECK_BIGNUM(x) CHECK_RECORD (x, bignum)
84 #define CONCHECK_BIGNUM(x) CONCHECK_RECORD (x, bignum)
85
86 #define bignum_data(b) (b)->data
87 #define XBIGNUM_DATA(x) bignum_data (XBIGNUM (x))
88
89 #define BIGNUM_ARITH_RETURN(b,op) do \
90 { \
91 Lisp_Object retval = make_bignum (0); \
92 bignum_##op (XBIGNUM_DATA (retval), XBIGNUM_DATA (b)); \
93 return Fcanonicalize_number (retval); \
94 } while (0)
95
96 #define BIGNUM_ARITH_RETURN1(b,op,arg) do \
97 { \
98 Lisp_Object retval = make_bignum(0); \
99 bignum_##op (XBIGNUM_DATA (retval), XBIGNUM_DATA (b), arg); \
100 return Fcanonicalize_number (retval); \
101 } while (0)
102
103 extern Lisp_Object make_bignum (long);
104 extern Lisp_Object make_bignum_bg (bignum);
105 extern bignum scratch_bignum, scratch_bignum2;
106
107 #else /* !HAVE_BIGNUM */
108
109 extern Lisp_Object Qbignump;
110 #define BIGNUMP(x) 0
111 #define CHECK_BIGNUM(x) dead_wrong_type_argument (Qbignump, x)
112 #define CONCHECK_BIGNUM(x) dead_wrong_type_argument (Qbignump, x)
113 typedef void bignum;
114 #define make_bignum(l) This XEmacs does not support bignums
115 #define make_bignum_bg(b) This XEmacs does not support bignums
116
117 #endif /* HAVE_BIGNUM */
118
119 EXFUN (Fbignump, 1);
120
121
122 /********************************* Integers *********************************/
123 extern Lisp_Object Qintegerp;
124
125 #define INTEGERP(x) (INTP(x) || BIGNUMP(x))
126 #define CHECK_INTEGER(x) do { \
127 if (!INTEGERP (x)) \
128 dead_wrong_type_argument (Qintegerp, x); \
129 } while (0)
130 #define CONCHECK_INTEGER(x) do { \
131 if (!INTEGERP (x)) \
132 x = wrong_type_argument (Qintegerp, x); \
133 } while (0)
134
135 #ifdef HAVE_BIGNUM
136 #define make_integer(x) \
137 (NUMBER_FITS_IN_AN_EMACS_INT (x) ? make_int (x) : make_bignum (x))
138 #else
139 #define make_integer(x) make_int (x)
140 #endif
141
142 extern Fixnum Vmost_negative_fixnum, Vmost_positive_fixnum;
143 EXFUN (Fintegerp, 1);
144 EXFUN (Fevenp, 1);
145 EXFUN (Foddp, 1);
146
147
148 /********************************** Ratios **********************************/
149 #ifdef HAVE_RATIO
150
151 struct Lisp_Ratio
152 {
153 struct lrecord_header lheader;
154 ratio data;
155 };
156 typedef struct Lisp_Ratio Lisp_Ratio;
157
158 DECLARE_LRECORD (ratio, Lisp_Ratio);
159 #define XRATIO(x) XRECORD (x, ratio, Lisp_Ratio)
160 #define wrap_ratio(p) wrap_record (p, ratio)
161 #define RATIOP(x) RECORDP (x, ratio)
162 #define CHECK_RATIO(x) CHECK_RECORD (x, ratio)
163 #define CONCHECK_RATIO(x) CONCHECK_RECORD (x, ratio)
164
165 #define ratio_data(r) (r)->data
166
167 #define XRATIO_DATA(r) ratio_data (XRATIO (r))
168 #define XRATIO_NUMERATOR(r) ratio_numerator (XRATIO_DATA (r))
169 #define XRATIO_DENOMINATOR(r) ratio_denominator (XRATIO_DATA (r))
170
171 #define RATIO_ARITH_RETURN(r,op) do \
172 { \
173 Lisp_Object retval = make_ratio (0L, 1UL); \
174 ratio_##op (XRATIO_DATA (retval), XRATIO_DATA (r)); \
175 return Fcanonicalize_number (retval); \
176 } while (0)
177
178 #define RATIO_ARITH_RETURN1(r,op,arg) do \
179 { \
180 Lisp_Object retval = make_ratio (0L, 1UL); \
181 ratio_##op (XRATIO_DATA (retval), XRATIO_DATA (r), arg); \
182 return Fcanonicalize_number (retval); \
183 } while (0)
184
185 extern Lisp_Object make_ratio (long, unsigned long);
186 extern Lisp_Object make_ratio_bg (bignum, bignum);
187 extern Lisp_Object make_ratio_rt (ratio);
188 extern ratio scratch_ratio;
189
190 #else /* !HAVE_RATIO */
191
192 extern Lisp_Object Qratiop;
193 #define RATIOP(x) 0
194 #define CHECK_RATIO(x) dead_wrong_type_argument (Qratiop, x)
195 #define CONCHECK_RATIO(x) dead_wrong_type_argument (Qratiop, x)
196 typedef void ratio;
197 #define make_ratio(n,d) This XEmacs does not support ratios
198 #define make_ratio_bg(n,d) This XEmacs does not support ratios
199
200 #endif /* HAVE_RATIO */
201
202 EXFUN (Fratiop, 1);
203
204
205 /******************************** Rationals *********************************/
206 extern Lisp_Object Qrationalp;
207
208 #define RATIONALP(x) (INTEGERP(x) || RATIOP(x))
209 #define CHECK_RATIONAL(x) do { \
210 if (!RATIONALP (x)) \
211 dead_wrong_type_argument (Qrationalp, x); \
212 } while (0)
213 #define CONCHECK_RATIONAL(x) do { \
214 if (!RATIONALP (x)) \
215 x = wrong_type_argument (Qrationalp, x); \
216 } while (0)
217
218 EXFUN (Frationalp, 1);
219 EXFUN (Fnumerator, 1);
220 EXFUN (Fdenominator, 1);
221
222
223 /******************************** Bigfloats *********************************/
224 #ifdef HAVE_BIGFLOAT
225 struct Lisp_Bigfloat
226 {
227 struct lrecord_header lheader;
228 bigfloat bf;
229 };
230 typedef struct Lisp_Bigfloat Lisp_Bigfloat;
231
232 DECLARE_LRECORD (bigfloat, Lisp_Bigfloat);
233 #define XBIGFLOAT(x) XRECORD (x, bigfloat, Lisp_Bigfloat)
234 #define wrap_bigfloat(p) wrap_record (p, bigfloat)
235 #define BIGFLOATP(x) RECORDP (x, bigfloat)
236 #define CHECK_BIGFLOAT(x) CHECK_RECORD (x, bigfloat)
237 #define CONCHECK_BIGFLOAT(x) CONCHECK_RECORD (x, bigfloat)
238
239 #define bigfloat_data(f) ((f)->bf)
240 #define XBIGFLOAT_DATA(x) bigfloat_data (XBIGFLOAT (x))
241 #define XBIGFLOAT_GET_PREC(x) bigfloat_get_prec (XBIGFLOAT_DATA (x))
242 #define XBIGFLOAT_SET_PREC(x,p) bigfloat_set_prec (XBIGFLOAT_DATA (x), p)
243
244 #define BIGFLOAT_ARITH_RETURN(f,op) do \
245 { \
246 Lisp_Object retval = make_bigfloat_bf (f); \
247 bigfloat_##op (XBIGFLOAT_DATA (retval), XBIGFLOAT_DATA (f)); \
248 return retval; \
249 } while (0)
250
251 #define BIGFLOAT_ARITH_RETURN1(f,op,arg) do \
252 { \
253 Lisp_Object retval = make_bigfloat_bf (f); \
254 bigfloat_##op (XBIGFLOAT_DATA (retval), XBIGFLOAT_DATA (f), arg); \
255 return retval; \
256 } while (0)
257
258 extern Lisp_Object make_bigfloat (double, unsigned long);
259 extern Lisp_Object make_bigfloat_bf (bigfloat);
260 extern Lisp_Object Vdefault_float_precision;
261 extern bigfloat scratch_bigfloat, scratch_bigfloat2;
262
263 #else /* !HAVE_BIGFLOAT */
264
265 extern Lisp_Object Qbigfloatp;
266 #define BIGFLOATP(x) 0
267 #define CHECK_BIGFLOAT(x) dead_wrong_type_argument (Qbigfloatp, x)
268 #define CONCHECK_BIGFLOAT(x) dead_wrong_type_argument (Qbigfloatp, x)
269 typedef void bigfloat;
270 #define make_bigfloat(f) This XEmacs does not support bigfloats
271 #define make_bigfloat_bf(f) This XEmacs does not support bigfloast
272
273 #endif /* HAVE_BIGFLOAT */
274
275 EXFUN (Fbigfloatp, 1);
276
277 /********************************* Floating *********************************/
278 extern Lisp_Object Qfloatingp, Qbigfloat;
279 extern Lisp_Object Qread_default_float_format, Vread_default_float_format;
280
281 #define FLOATINGP(x) (FLOATP (x) || BIGFLOATP (x))
282 #define CHECK_FLOATING(x) do { \
283 if (!FLOATINGP (x)) \
284 dead_wrong_type_argument (Qfloatingp, x); \
285 } while (0)
286 #define CONCHECK_FLOATING(x) do { \
287 if (!FLOATINGP (x)) \
288 x = wrong_type_argument (Qfloating, x); \
289 } while (0)
290
291 EXFUN (Ffloatp, 1);
292
293
294 /********************************** Reals ***********************************/
295 extern Lisp_Object Qrealp;
296
297 #define REALP(x) (RATIONALP (x) || FLOATINGP (x))
298 #define CHECK_REAL(x) do { \
299 if (!REALP (x)) \
300 dead_wrong_type_argument (Qrealp, x); \
301 } while (0)
302 #define CONCHECK_REAL(x) do { \
303 if (!REALP (x)) \
304 x = wrong_type_argument (Qrealp, x); \
305 } while (0)
306
307 EXFUN (Frealp, 1);
308
309
310 /********************************* Numbers **********************************/
311 extern Lisp_Object Qnumberp;
312
313 #define NUMBERP(x) REALP (x)
314 #define CHECK_NUMBER(x) do { \
315 if (!NUMBERP (x)) \
316 dead_wrong_type_argument (Qnumberp, x); \
317 } while (0)
318 #define CONCHECK_NUMBER(x) do { \
319 if (!NUMBERP (x)) \
320 x = wrong_type_argument (Qnumberp, x); \
321 } while (0)
322
323 EXFUN (Fcanonicalize_number, 1);
324
325 enum number_type {FIXNUM_T, BIGNUM_T, RATIO_T, FLOAT_T, BIGFLOAT_T};
326
327 extern enum number_type promote_args (Lisp_Object *, Lisp_Object *);
328
329 #endif /* INCLUDED_number_h_ */