2 ent-mpc.c -- Numeric types for SXEmacs
3 Copyright (C) 2005, 2006 Sebastian Freundt
5 Author: Sebastian Freundt
7 This file is part of SXEmacs
9 SXEmacs is free software: you can redistribute it and/or modify
10 it under the terms of the GNU General Public License as published by
11 the Free Software Foundation, either version 3 of the License, or
12 (at your option) any later version.
14 SXEmacs is distributed in the hope that it will be useful,
15 but WITHOUT ANY WARRANTY; without even the implied warranty of
16 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
17 GNU General Public License for more details.
19 You should have received a copy of the GNU General Public License
20 along with this program. If not, see <http://www.gnu.org/licenses/>. */
27 #include "sysproc.h" /* For qxe_getpid */
31 bigc ent_scratch_bigc;
32 static ase_nullary_operation_f Qent_mpc_zero, Qent_mpc_one;
36 bigc_print (Lisp_Object obj, Lisp_Object printcharfun, int SXE_UNUSED(escapeflag))
38 Bufbyte *fstr = bigc_to_string(XBIGC_DATA(obj), 10);
39 write_c_string((char*)fstr, printcharfun);
41 fstr = (Bufbyte *)NULL;
46 bigc_equal (Lisp_Object obj1, Lisp_Object obj2, int SXE_UNUSED(depth))
48 return bigc_eq(XBIGC_DATA(obj1), XBIGC_DATA(obj2));
52 bigc_hash (Lisp_Object obj, int SXE_UNUSED(depth))
54 return bigc_hashcode(XBIGC_DATA(obj));
58 bigc_mark (Lisp_Object SXE_UNUSED(obj))
64 bigc_finalise (void *header, int for_disksave)
68 ("Can't dump an emacs containing MPC objects",Qt);
74 static const struct lrecord_description bigc_description[] = {
75 { XD_OPAQUE_DATA_PTR, offsetof(Lisp_Bigc, data) },
79 #if ! defined(HAVE_MPC_SET_UI_FR) || ! HAVE_MPC_SET_UI_FR
80 #if defined(MPC_SET_X_Y)
81 int mpc_set_ui_fr (mpc_t rop, unsigned long int re, mpfr_t im, mpc_rnd_t rnd);
82 int mpc_set_ui_fr (mpc_t rop, unsigned long int re, mpfr_t im, mpc_rnd_t rnd)
83 MPC_SET_X_Y (ui, fr, rop, re, im, rnd);
85 #error Cannot derived mpc_set_ui_fr without MPC_SET_X_Y!
89 DEFINE_BASIC_LRECORD_IMPLEMENTATION("bigc", bigc,
90 bigc_mark, bigc_print, bigc_finalise,
91 bigc_equal, bigc_hash,
92 bigc_description, Lisp_Bigc);
96 DEFUN ("bigc-get-precision", Fbigc_get_precision, 1, 1, 0, /*
97 Return the precision of bigc C as an integer.
102 return make_integer((signed long)XBIGC_GET_PREC(c));
105 DEFUN ("bigc-set-precision", Fbigc_set_precision, 2, 2, 0, /*
106 Set the precision of C, a bigc, to PRECISION, a nonnegative integer.
107 The new precision of C is returned. Note that the return value may differ
108 from PRECISION if the underlying library is unable to support exactly
109 PRECISION bits of precision.
116 if (INTP(precision)) {
117 prec = (XINT(precision) <= 0)
118 ? MPFR_PREC_MIN : (unsigned long)XINT(precision);
120 #if defined HAVE_MPZ && (defined WITH_GMP || defined WITH_MP)
121 else if (BIGZP(precision)) {
122 prec = bigz_fits_ulong_p(XBIGZ_DATA(precision))
123 ? bigz_to_ulong(XBIGZ_DATA(precision))
126 #endif /* HAVE_MPZ */
128 dead_wrong_type_argument(Qintegerp, c);
132 XBIGC_SET_PREC(c, prec);
133 return Fbigc_get_precision(c);
136 DEFUN ("make-bigc", Fmake_bigc, 2, 2, 0, /*
137 Return the bigc number whose real component is REAL-PART and
138 whose imaginary component is IMAGINARY-PART.
140 (real_part, imaginary_part))
144 CHECK_COMPARABLE(real_part);
145 CHECK_COMPARABLE(imaginary_part);
147 real_part = Fcoerce_number(
148 real_part, Qbigfr, Qnil);
149 imaginary_part = Fcoerce_number(
150 imaginary_part, Qbigfr, Qnil);
152 /* check if one of the components is not-a-number
153 * set both components NaN in that case
155 if (bigfr_nan_p(XBIGFR_DATA(real_part)) ||
156 bigfr_nan_p(XBIGFR_DATA(imaginary_part))) {
157 bigfr_set_nan(XBIGFR_DATA(real_part));
158 bigfr_set_nan(XBIGFR_DATA(imaginary_part));
159 } else if (bigfr_inf_p(XBIGFR_DATA(real_part)) ||
160 bigfr_inf_p(XBIGFR_DATA(imaginary_part))) {
161 bigfr_set_pinf(XBIGFR_DATA(real_part));
162 bigfr_set_pinf(XBIGFR_DATA(imaginary_part));
165 result = make_bigc_bfr(XBIGFR_DATA(real_part),
166 XBIGFR_DATA(imaginary_part),
167 internal_get_precision(Qnil));
173 int bigc_nan_p(bigc c)
175 return (bigfr_nan_p(bigc_re(c)) ||
176 bigfr_nan_p(bigc_im(c)));
179 int bigc_inf_p(bigc c)
181 return (bigfr_inf_p(bigc_re(c)) ||
182 bigfr_inf_p(bigc_im(c)));
186 Bufbyte *bigc_to_string(mpc_t c, int base)
192 /* if one of the components is infinity or not a number,
193 * just print the respective component
194 * +infinity+2i does not really make sense, that's why!
197 re_str = indef_to_string((indef)NOT_A_NUMBER);
199 } else if (bigc_inf_p(c)) {
200 re_str = indef_to_string((indef)COMPLEX_INFINITY);
203 /* fetch the components' strings */
204 re_str = bigfr_to_string(bigc_re(c), base);
205 im_str = bigfr_to_string(bigc_im(c), base);
207 re_len = strlen((char*)re_str);
208 im_len = strlen((char*)im_str);
210 const int sign = bigfr_sign(bigc_im(c));
211 const int neg = (sign >= 0) ? 1 : 0;
213 /* now append the imaginary string */
214 XREALLOC_ARRAY(re_str, Bufbyte, re_len + neg + im_len + 2);
216 re_str[re_len] = '+';
217 memmove(&re_str[re_len + neg],
220 re_str[re_len+neg+im_len] = 'i';
221 re_str[re_len+neg+im_len+1] = '\0';
229 void bigc_pow(bigc res, bigc g1, unsigned long g2)
231 #if defined(HAVE_MPZ) && defined(WITH_GMP)
234 bigfr binfr, resintg, resimag, tmpbz1, tmpbz2, tmpbz3, intg, imag;
246 bigfr_set_long(resintg, 0L);
247 bigfr_set_long(resimag, 0L);
249 bigfr_set(intg, bigc_re(g1));
250 bigfr_set(imag, bigc_im(g1));
252 /* we compute using the binomial coefficients */
253 for (i=0; i<=g2; i++) {
254 mpz_bin_uiui(bin, g2, i);
255 bigfr_set_bigz(binfr, bin);
257 /* real part changes */
258 bigfr_pow(tmpbz1, intg, g2-i);
259 bigfr_pow(tmpbz2, imag, i);
260 bigfr_mul(tmpbz3, tmpbz1, tmpbz2);
261 bigfr_mul(binfr, binfr, tmpbz3);
263 bigfr_add(resintg, resintg, binfr);
264 } else if (i % 4 == 2) {
265 bigfr_sub(resintg, resintg, binfr);
268 /* imag part changes */
269 bigfr_pow(tmpbz1, intg, g2-i);
270 bigfr_pow(tmpbz2, imag, i);
271 bigfr_mul(tmpbz3, tmpbz1, tmpbz2);
272 bigfr_mul(binfr, binfr, tmpbz3);
274 bigfr_add(resimag, resimag, binfr);
275 } else if (i % 4 == 3) {
276 bigfr_sub(resimag, resimag, binfr);
281 bigc_set_bigfr_bigfr(res, resintg, resimag);
292 #else /* !WITH_GMP */
293 bigc_set_long_long(res, 0L, 0L);
294 #endif /* WITH_GMP */
300 ent_mpc_zerop(Lisp_Object l)
302 return (bigfr_sign(bigc_re(XBIGC_DATA(l))) == 0 &&
303 bigfr_sign(bigc_im(XBIGC_DATA(l))) == 0);
307 ent_mpc_onep(Lisp_Object l)
309 return (bigfr_to_fpfloat(bigc_re(XBIGC_DATA(l))) == 1.0f &&
310 bigfr_sign(bigc_im(XBIGC_DATA(l))) == 0);
314 ent_mpc_unitp(Lisp_Object SXE_UNUSED(unused))
320 ent_sum_BIGC_T(Lisp_Object l, Lisp_Object r)
322 bigc_set_prec(ent_scratch_bigc,
323 max(XBIGC_GET_PREC(l), XBIGC_GET_PREC(r)));
324 bigc_add(ent_scratch_bigc, XBIGC_DATA(l), XBIGC_DATA(r));
325 return make_bigc_bc(ent_scratch_bigc);
329 ent_sum_BIGC_T_COMPARABLE(Lisp_Object l, Lisp_Object r)
331 struct ent_lift_args_s la;
335 la.precision = XBIGC_GET_PREC(l);
336 r = ent_lift(r, BIGFR_T, &la);
338 bigc_set_prec(ent_scratch_bigc, XBIGC_GET_PREC(l));
339 bigc_set_bigfr(ent_scratch_bigc, XBIGFR_DATA(r));
340 bigc_add(ent_scratch_bigc, XBIGC_DATA(l), ent_scratch_bigc);
341 return make_bigc_bc(ent_scratch_bigc);
345 ent_sum_COMPARABLE_BIGC_T(Lisp_Object l, Lisp_Object r)
347 return ent_sum_BIGC_T_COMPARABLE(r, l);
351 ent_sum_BIGC_T_COMPLEX(Lisp_Object l, Lisp_Object r)
353 struct ent_lift_args_s la;
357 la.precision = XBIGC_GET_PREC(l);
358 r = ent_lift(r, BIGC_T, &la);
360 return ent_sum_BIGC_T(l, r);
364 ent_sum_COMPLEX_BIGC_T(Lisp_Object l, Lisp_Object r)
366 return ent_sum_BIGC_T_COMPLEX(r, l);
370 ent_diff_BIGC_T(Lisp_Object l, Lisp_Object r)
372 bigc_set_prec(ent_scratch_bigc,
373 max(XBIGC_GET_PREC(l), XBIGC_GET_PREC(r)));
374 bigc_sub(ent_scratch_bigc, XBIGC_DATA(l), XBIGC_DATA(r));
375 return make_bigc_bc(ent_scratch_bigc);
379 ent_diff_BIGC_T_COMPARABLE(Lisp_Object l, Lisp_Object r)
381 struct ent_lift_args_s la;
385 la.precision = XBIGC_GET_PREC(l);
386 r = ent_lift(r, BIGFR_T, &la);
388 bigc_set_prec(ent_scratch_bigc, XBIGC_GET_PREC(l));
389 bigc_set_bigfr(ent_scratch_bigc, XBIGFR_DATA(r));
390 bigc_sub(ent_scratch_bigc, XBIGC_DATA(l), ent_scratch_bigc);
391 return make_bigc_bc(ent_scratch_bigc);
395 ent_diff_COMPARABLE_BIGC_T(Lisp_Object l, Lisp_Object r)
397 struct ent_lift_args_s la;
401 la.precision = XBIGC_GET_PREC(r);
402 l = ent_lift(l, BIGFR_T, &la);
404 bigc_set_prec(ent_scratch_bigc, XBIGC_GET_PREC(r));
405 bigc_set_bigfr(ent_scratch_bigc, XBIGFR_DATA(l));
406 bigc_sub(ent_scratch_bigc, ent_scratch_bigc, XBIGC_DATA(r));
407 return make_bigc_bc(ent_scratch_bigc);
411 ent_diff_BIGC_T_COMPLEX(Lisp_Object l, Lisp_Object r)
413 struct ent_lift_args_s la;
417 la.precision = XBIGC_GET_PREC(l);
418 r = ent_lift(r, BIGC_T, &la);
420 return ent_diff_BIGC_T(l, r);
424 ent_diff_COMPLEX_BIGC_T(Lisp_Object l, Lisp_Object r)
426 struct ent_lift_args_s la;
430 la.precision = XBIGC_GET_PREC(r);
431 l = ent_lift(l, BIGC_T, &la);
433 return ent_diff_BIGC_T(l, r);
437 ent_neg_BIGC_T(Lisp_Object l)
439 bigc_set_prec(ent_scratch_bigc, XBIGC_GET_PREC(l));
440 bigc_neg(ent_scratch_bigc, XBIGC_DATA(l));
441 return make_bigc_bc(ent_scratch_bigc);
445 ent_prod_BIGC_T(Lisp_Object l, Lisp_Object r)
447 bigc_set_prec(ent_scratch_bigc,
448 max(XBIGC_GET_PREC(l), XBIGC_GET_PREC(r)));
449 bigc_mul(ent_scratch_bigc, XBIGC_DATA(l), XBIGC_DATA(r));
450 return make_bigc_bc(ent_scratch_bigc);
454 ent_prod_BIGC_T_COMPARABLE(Lisp_Object l, Lisp_Object r)
456 struct ent_lift_args_s la;
460 la.precision = XBIGC_GET_PREC(l);
461 r = ent_lift(r, BIGFR_T, &la);
463 bigc_set_prec(ent_scratch_bigc, XBIGC_GET_PREC(l));
464 bigc_set_bigfr(ent_scratch_bigc, XBIGFR_DATA(r));
465 bigc_mul(ent_scratch_bigc, XBIGC_DATA(l), ent_scratch_bigc);
466 return make_bigc_bc(ent_scratch_bigc);
470 ent_prod_COMPARABLE_BIGC_T(Lisp_Object l, Lisp_Object r)
472 return ent_prod_BIGC_T_COMPARABLE(r, l);
476 ent_prod_BIGC_T_COMPLEX(Lisp_Object l, Lisp_Object r)
478 struct ent_lift_args_s la;
482 la.precision = XBIGC_GET_PREC(l);
483 r = ent_lift(r, BIGC_T, &la);
485 return ent_prod_BIGC_T(l, r);
489 ent_prod_COMPLEX_BIGC_T(Lisp_Object l, Lisp_Object r)
491 return ent_prod_BIGC_T_COMPLEX(r, l);
495 ent_div_BIGC_T(Lisp_Object l, Lisp_Object r)
497 if (ent_mpc_zerop(r)) {
498 if (!ent_mpc_zerop(l)) {
499 return make_indef(COMPLEX_INFINITY);
501 return make_indef(NOT_A_NUMBER);
504 bigc_set_prec(ent_scratch_bigc,
505 max(XBIGC_GET_PREC(l), XBIGC_GET_PREC(r)));
506 bigc_div(ent_scratch_bigc, XBIGC_DATA(l), XBIGC_DATA(r));
507 return make_bigc_bc(ent_scratch_bigc);
511 ent_div_BIGC_T_COMPARABLE(Lisp_Object l, Lisp_Object r)
513 struct ent_lift_args_s la;
517 if (ent_unrel(ASE_UNARY_REL_ZEROP, r)) {
518 if (!ent_mpc_zerop(l)) {
519 return make_indef(COMPLEX_INFINITY);
521 return make_indef(NOT_A_NUMBER);
525 la.precision = XBIGC_GET_PREC(l);
526 r = ent_lift(r, BIGFR_T, &la);
528 bigc_set_prec(ent_scratch_bigc, XBIGC_GET_PREC(l));
529 bigc_set_bigfr(ent_scratch_bigc, XBIGFR_DATA(r));
530 bigc_div(ent_scratch_bigc, XBIGC_DATA(l), ent_scratch_bigc);
531 return make_bigc_bc(ent_scratch_bigc);
535 ent_div_COMPARABLE_BIGC_T(Lisp_Object l, Lisp_Object r)
537 struct ent_lift_args_s la;
541 if (ent_mpc_zerop(r)) {
542 if (!ent_unrel(ASE_UNARY_REL_ZEROP, l)) {
543 return make_indef(COMPLEX_INFINITY);
545 return make_indef(NOT_A_NUMBER);
549 la.precision = XBIGC_GET_PREC(r);
550 l = ent_lift(l, BIGFR_T, &la);
552 bigc_set_prec(ent_scratch_bigc, XBIGC_GET_PREC(r));
553 bigc_set_bigfr(ent_scratch_bigc, XBIGFR_DATA(l));
554 bigc_div(ent_scratch_bigc, ent_scratch_bigc, XBIGC_DATA(r));
555 return make_bigc_bc(ent_scratch_bigc);
559 ent_div_BIGC_T_COMPLEX(Lisp_Object l, Lisp_Object r)
561 struct ent_lift_args_s la;
565 if (ent_unrel(ASE_UNARY_REL_ZEROP, r)) {
566 if (!ent_mpc_zerop(l)) {
567 return make_indef(COMPLEX_INFINITY);
569 return make_indef(NOT_A_NUMBER);
573 la.precision = XBIGC_GET_PREC(l);
574 r = ent_lift(r, BIGC_T, &la);
576 return ent_div_BIGC_T(l, r);
580 ent_div_COMPLEX_BIGC_T(Lisp_Object l, Lisp_Object r)
582 struct ent_lift_args_s la;
586 if (ent_mpc_zerop(r)) {
587 if (!ent_unrel(ASE_UNARY_REL_ZEROP, l)) {
588 return make_indef(COMPLEX_INFINITY);
590 return make_indef(NOT_A_NUMBER);
594 la.precision = XBIGC_GET_PREC(r);
595 l = ent_lift(l, BIGC_T, &la);
597 return ent_div_BIGC_T(l, r);
601 ent_inv_BIGC_T(Lisp_Object r)
603 if (ent_mpc_zerop(r)) {
604 return make_indef(COMPLEX_INFINITY);
606 bigc_set_long(ent_scratch_bigc, 1L);
607 bigc_set_prec(ent_scratch_bigc, XBIGC_GET_PREC(r));
608 bigc_div(ent_scratch_bigc, ent_scratch_bigc, XBIGC_DATA(r));
609 return make_bigc_bc(ent_scratch_bigc);
613 ent_rem_BIGC_T(Lisp_Object SXE_UNUSED(unused), Lisp_Object r)
615 return Qent_mpc_zero;
619 ent_mod_BIGC_T(Lisp_Object l, Lisp_Object r)
621 if (ent_mpc_zerop(r)) {
622 return Qent_mpc_zero;
624 bigc_set_prec(ent_scratch_bigc,
625 max(XBIGC_GET_PREC(l), XBIGC_GET_PREC(r)));
626 bigc_div(ent_scratch_bigc, XBIGC_DATA(l), XBIGC_DATA(r));
627 bigfr_trunc(bigc_re(ent_scratch_bigc), bigc_re(ent_scratch_bigc));
628 bigfr_trunc(bigc_im(ent_scratch_bigc), bigc_im(ent_scratch_bigc));
629 bigc_mul(ent_scratch_bigc, ent_scratch_bigc, XBIGC_DATA(r));
630 bigc_sub(ent_scratch_bigc, XBIGC_DATA(l), ent_scratch_bigc);
631 return make_bigc_bc(ent_scratch_bigc);
636 ent_eq_BIGC_T(Lisp_Object l, Lisp_Object r)
638 return (bigfr_eq(bigc_re(XBIGC_DATA(l)), bigc_re(XBIGC_DATA(r))) &&
639 bigfr_eq(bigc_im(XBIGC_DATA(l)), bigc_im(XBIGC_DATA(r))));
643 ent_ne_BIGC_T(Lisp_Object l, Lisp_Object r)
645 return (bigfr_eq(bigc_re(XBIGC_DATA(l)), bigc_re(XBIGC_DATA(r))) &&
646 bigfr_eq(bigc_im(XBIGC_DATA(l)), bigc_im(XBIGC_DATA(r))));
650 static inline Lisp_Object
651 ent_vallt_BIGC_T(Lisp_Object l, Lisp_Object r)
657 bigfr_set_prec(ent_scratch_bigfr, internal_get_precision(Qnil));
658 bigfr_set_prec(b2, internal_get_precision(Qnil));
659 bigc_norm(ent_scratch_bigfr, XBIGC_DATA(l));
660 bigc_norm(b2, XBIGC_DATA(r));
661 result = bigfr_lt(ent_scratch_bigfr, b2);
664 return (result) ? Qt : Qnil;
666 static inline Lisp_Object
667 ent_valgt_BIGC_T(Lisp_Object l, Lisp_Object r)
673 bigfr_set_prec(ent_scratch_bigfr, internal_get_precision(Qnil));
674 bigfr_set_prec(b2, internal_get_precision(Qnil));
675 bigc_norm(ent_scratch_bigfr, XBIGC_DATA(l));
676 bigc_norm(b2, XBIGC_DATA(r));
677 result = bigfr_gt(ent_scratch_bigfr, b2);
680 return (result) ? Qt : Qnil;
682 static inline Lisp_Object
683 ent_valeq_BIGC_T(Lisp_Object l, Lisp_Object r)
689 bigfr_set_prec(ent_scratch_bigfr, internal_get_precision(Qnil));
690 bigfr_set_prec(b2, internal_get_precision(Qnil));
691 bigc_norm(ent_scratch_bigfr, XBIGC_DATA(l));
692 bigc_norm(b2, XBIGC_DATA(r));
693 result = bigfr_eq(ent_scratch_bigfr, b2);
696 return (result) ? Qt : Qnil;
698 static inline Lisp_Object
699 ent_valne_BIGC_T(Lisp_Object l, Lisp_Object r)
705 bigfr_set_prec(ent_scratch_bigfr, internal_get_precision(Qnil));
706 bigfr_set_prec(b2, internal_get_precision(Qnil));
707 bigc_norm(ent_scratch_bigfr, XBIGC_DATA(l));
708 bigc_norm(b2, XBIGC_DATA(r));
709 result = bigfr_eq(ent_scratch_bigfr, b2);
712 return (result) ? Qnil : Qt;
718 ent_lift_INT_T_BIGC_T(Lisp_Object number, ent_lift_args_t la)
720 unsigned long precision = la->precision;
722 bigc_set_prec(ent_scratch_bigc, precision);
723 bigc_set_long(ent_scratch_bigc, ent_int(number));
724 return make_bigc_bc(ent_scratch_bigc);
727 #if defined HAVE_MPZ && (defined WITH_GMP || defined WITH_MP)
729 ent_lift_BIGZ_T_BIGC_T(Lisp_Object number, ent_lift_args_t la)
731 unsigned long precision = la->precision;
733 bigfr_set_prec(ent_scratch_bigfr, precision);
734 bigfr_set_bigz(ent_scratch_bigfr, XBIGZ_DATA(number));
735 bigc_set_prec(ent_scratch_bigc, precision);
736 bigc_set_bigfr(ent_scratch_bigc, ent_scratch_bigfr);
737 return make_bigc_bc(ent_scratch_bigc);
739 #endif /* HAVE_MPZ */
741 #if defined HAVE_MPQ && defined WITH_GMP
743 ent_lift_BIGQ_T_BIGC_T(Lisp_Object number, ent_lift_args_t la)
745 unsigned long precision = la->precision;
747 bigfr_set_prec(ent_scratch_bigfr, precision);
748 bigfr_set_bigq(ent_scratch_bigfr, XBIGQ_DATA(number));
749 bigc_set_prec(ent_scratch_bigc, precision);
750 bigc_set_bigfr(ent_scratch_bigc, ent_scratch_bigfr);
751 return make_bigc_bc(ent_scratch_bigc);
753 #endif /* HAVE_MPQ */
755 #if defined HAVE_MPF && defined WITH_GMP
757 ent_lift_BIGF_T_BIGC_T(Lisp_Object number, ent_lift_args_t la)
759 unsigned long precision = la->precision;
761 bigfr_set_prec(ent_scratch_bigfr, precision);
762 bigfr_set_bigf(ent_scratch_bigfr, XBIGF_DATA(number));
763 bigc_set_prec(ent_scratch_bigc, precision);
764 bigc_set_bigfr(ent_scratch_bigc, ent_scratch_bigfr);
765 return make_bigc_bc(ent_scratch_bigc);
767 #endif /* HAVE_MPF */
769 #if defined HAVE_MPFR && defined WITH_MPFR
771 ent_lift_BIGFR_T_BIGC_T(Lisp_Object number, ent_lift_args_t la)
773 unsigned long precision = la->precision;
775 /* warn about coercions of indefinite symbols */
776 if (bigfr_inf_p(XBIGFR_DATA(number)))
777 return make_indef(COMPLEX_INFINITY);
778 if (bigfr_nan_p(XBIGFR_DATA(number)))
779 return make_indef(NOT_A_NUMBER);
781 bigc_set_prec(ent_scratch_bigc, precision);
782 bigc_set_bigfr(ent_scratch_bigc, XBIGFR_DATA(number));
783 return make_bigc_bc(ent_scratch_bigc);
785 #endif /* HAVE_MPF */
789 ent_lift_FLOAT_T_BIGC_T(Lisp_Object number, ent_lift_args_t la)
791 unsigned long precision = la->precision;
793 bigc_set_prec(ent_scratch_bigc, precision);
794 bigc_set_fpfloat(ent_scratch_bigc, XFLOAT_DATA(number));
795 return make_bigc_bc(ent_scratch_bigc);
799 #if defined HAVE_PSEUG && defined WITH_PSEUG
801 ent_lift_BIGG_T_BIGC_T(Lisp_Object number, ent_lift_args_t la)
803 unsigned long precision = la->precision;
804 bigfr bfr_im, bfr_re;
805 Lisp_Object result, re, im;
807 re = Freal_part(number);
808 re = ent_lift(re, BIGFR_T, la);
809 im = Fimaginary_part(number);
810 im = ent_lift(im, BIGFR_T, la);
815 bigfr_set(bfr_re, XBIGFR_DATA(re));
816 bigfr_set(bfr_im, XBIGFR_DATA(im));
817 result = make_bigc_bfr(bfr_re, bfr_im, precision);
827 ent_lift_BIGC_T_BIGC_T(Lisp_Object number, ent_lift_args_t la)
829 unsigned long precision = la->precision;
831 bigc_set_prec(ent_scratch_bigc, precision);
832 bigc_set(ent_scratch_bigc, XBIGC_DATA(number));
833 return make_bigc_bc(ent_scratch_bigc);
838 ent_mpc_nullary_optable_init(void)
840 Qent_mpc_zero = make_bigc(0.0f, 0.0f, internal_get_precision(Qnil));
841 Qent_mpc_one = make_bigc(1.0f, 0.0f, internal_get_precision(Qnil));
842 staticpro(&Qent_mpc_zero);
843 staticpro(&Qent_mpc_one);
845 ent_nullop_register(ASE_NULLARY_OP_ZERO, BIGC_T, Qent_mpc_zero);
846 ent_nullop_register(ASE_NULLARY_OP_ONE, BIGC_T, Qent_mpc_one);
850 ent_mpc_unary_optable_init(void)
852 ent_unop_register(ASE_UNARY_OP_NEG, BIGC_T, ent_neg_BIGC_T);
853 ent_unop_register(ASE_UNARY_OP_INV, BIGC_T, ent_inv_BIGC_T);
857 ent_mpc_binary_optable_init(void)
860 ent_binop_register(ASE_BINARY_OP_SUM,
861 BIGC_T, BIGC_T, ent_sum_BIGC_T);
862 ent_binop_register(ASE_BINARY_OP_SUM,
863 BIGC_T, INT_T, ent_sum_BIGC_T_COMPARABLE);
864 ent_binop_register(ASE_BINARY_OP_SUM,
865 INT_T, BIGC_T, ent_sum_COMPARABLE_BIGC_T);
866 #if defined HAVE_MPZ && (defined WITH_GMP || defined WITH_MP)
867 ent_binop_register(ASE_BINARY_OP_SUM,
868 BIGC_T, BIGZ_T, ent_sum_BIGC_T_COMPARABLE);
869 ent_binop_register(ASE_BINARY_OP_SUM,
870 BIGZ_T, BIGC_T, ent_sum_COMPARABLE_BIGC_T);
872 #if defined HAVE_MPQ && defined WITH_GMP
873 ent_binop_register(ASE_BINARY_OP_SUM,
874 BIGC_T, BIGQ_T, ent_sum_BIGC_T_COMPARABLE);
875 ent_binop_register(ASE_BINARY_OP_SUM,
876 BIGQ_T, BIGC_T, ent_sum_COMPARABLE_BIGC_T);
878 #if defined HAVE_MPF && defined WITH_GMP
879 ent_binop_register(ASE_BINARY_OP_SUM,
880 BIGC_T, BIGF_T, ent_sum_BIGC_T_COMPARABLE);
881 ent_binop_register(ASE_BINARY_OP_SUM,
882 BIGF_T, BIGC_T, ent_sum_COMPARABLE_BIGC_T);
884 #if defined HAVE_MPFR && defined WITH_MPFR
885 ent_binop_register(ASE_BINARY_OP_SUM,
886 BIGC_T, BIGFR_T, ent_sum_BIGC_T_COMPARABLE);
887 ent_binop_register(ASE_BINARY_OP_SUM,
888 BIGFR_T, BIGC_T, ent_sum_COMPARABLE_BIGC_T);
891 ent_binop_register(ASE_BINARY_OP_SUM,
892 BIGC_T, FLOAT_T, ent_sum_BIGC_T_COMPARABLE);
893 ent_binop_register(ASE_BINARY_OP_SUM,
894 FLOAT_T, BIGC_T, ent_sum_COMPARABLE_BIGC_T);
896 #if defined HAVE_PSEUG && defined WITH_PSEUG
897 ent_binop_register(ASE_BINARY_OP_SUM,
898 BIGC_T, BIGG_T, ent_sum_BIGC_T_COMPLEX);
899 ent_binop_register(ASE_BINARY_OP_SUM,
900 BIGG_T, BIGC_T, ent_sum_COMPLEX_BIGC_T);
903 ent_binop_register(ASE_BINARY_OP_DIFF,
904 BIGC_T, BIGC_T, ent_diff_BIGC_T);
905 ent_binop_register(ASE_BINARY_OP_DIFF,
906 BIGC_T, INT_T, ent_diff_BIGC_T_COMPARABLE);
907 ent_binop_register(ASE_BINARY_OP_DIFF,
908 INT_T, BIGC_T, ent_diff_COMPARABLE_BIGC_T);
909 #if defined HAVE_MPZ && (defined WITH_GMP || defined WITH_MP)
910 ent_binop_register(ASE_BINARY_OP_DIFF,
911 BIGC_T, BIGZ_T, ent_diff_BIGC_T_COMPARABLE);
912 ent_binop_register(ASE_BINARY_OP_DIFF,
913 BIGZ_T, BIGC_T, ent_diff_COMPARABLE_BIGC_T);
915 #if defined HAVE_MPQ && defined WITH_GMP
916 ent_binop_register(ASE_BINARY_OP_DIFF,
917 BIGC_T, BIGQ_T, ent_diff_BIGC_T_COMPARABLE);
918 ent_binop_register(ASE_BINARY_OP_DIFF,
919 BIGQ_T, BIGC_T, ent_diff_COMPARABLE_BIGC_T);
921 #if defined HAVE_MPF && defined WITH_GMP
922 ent_binop_register(ASE_BINARY_OP_DIFF,
923 BIGC_T, BIGF_T, ent_diff_BIGC_T_COMPARABLE);
924 ent_binop_register(ASE_BINARY_OP_DIFF,
925 BIGF_T, BIGC_T, ent_diff_COMPARABLE_BIGC_T);
927 #if defined HAVE_MPFR && defined WITH_MPFR
928 ent_binop_register(ASE_BINARY_OP_DIFF,
929 BIGC_T, BIGFR_T, ent_diff_BIGC_T_COMPARABLE);
930 ent_binop_register(ASE_BINARY_OP_DIFF,
931 BIGFR_T, BIGC_T, ent_diff_COMPARABLE_BIGC_T);
934 ent_binop_register(ASE_BINARY_OP_DIFF,
935 BIGC_T, FLOAT_T, ent_diff_BIGC_T_COMPARABLE);
936 ent_binop_register(ASE_BINARY_OP_DIFF,
937 FLOAT_T, BIGC_T, ent_diff_COMPARABLE_BIGC_T);
939 #if defined HAVE_PSEUG && defined WITH_PSEUG
940 ent_binop_register(ASE_BINARY_OP_DIFF,
941 BIGC_T, BIGG_T, ent_diff_BIGC_T_COMPLEX);
942 ent_binop_register(ASE_BINARY_OP_DIFF,
943 BIGG_T, BIGC_T, ent_diff_COMPLEX_BIGC_T);
946 ent_binop_register(ASE_BINARY_OP_PROD,
947 BIGC_T, BIGC_T, ent_prod_BIGC_T);
948 ent_binop_register(ASE_BINARY_OP_PROD,
949 BIGC_T, INT_T, ent_prod_BIGC_T_COMPARABLE);
950 ent_binop_register(ASE_BINARY_OP_PROD,
951 INT_T, BIGC_T, ent_prod_COMPARABLE_BIGC_T);
952 #if defined HAVE_MPZ && (defined WITH_GMP || defined WITH_MP)
953 ent_binop_register(ASE_BINARY_OP_PROD,
954 BIGC_T, BIGZ_T, ent_prod_BIGC_T_COMPARABLE);
955 ent_binop_register(ASE_BINARY_OP_PROD,
956 BIGZ_T, BIGC_T, ent_prod_COMPARABLE_BIGC_T);
958 #if defined HAVE_MPQ && defined WITH_GMP
959 ent_binop_register(ASE_BINARY_OP_PROD,
960 BIGC_T, BIGQ_T, ent_prod_BIGC_T_COMPARABLE);
961 ent_binop_register(ASE_BINARY_OP_PROD,
962 BIGQ_T, BIGC_T, ent_prod_COMPARABLE_BIGC_T);
964 #if defined HAVE_MPF && defined WITH_GMP
965 ent_binop_register(ASE_BINARY_OP_PROD,
966 BIGC_T, BIGF_T, ent_prod_BIGC_T_COMPARABLE);
967 ent_binop_register(ASE_BINARY_OP_PROD,
968 BIGF_T, BIGC_T, ent_prod_COMPARABLE_BIGC_T);
970 #if defined HAVE_MPFR && defined WITH_MPFR
971 ent_binop_register(ASE_BINARY_OP_PROD,
972 BIGC_T, BIGFR_T, ent_prod_BIGC_T_COMPARABLE);
973 ent_binop_register(ASE_BINARY_OP_PROD,
974 BIGFR_T, BIGC_T, ent_prod_COMPARABLE_BIGC_T);
977 ent_binop_register(ASE_BINARY_OP_PROD,
978 BIGC_T, FLOAT_T, ent_prod_BIGC_T_COMPARABLE);
979 ent_binop_register(ASE_BINARY_OP_PROD,
980 FLOAT_T, BIGC_T, ent_prod_COMPARABLE_BIGC_T);
982 #if defined HAVE_PSEUG && defined WITH_PSEUG
983 ent_binop_register(ASE_BINARY_OP_PROD,
984 BIGC_T, BIGG_T, ent_prod_BIGC_T_COMPLEX);
985 ent_binop_register(ASE_BINARY_OP_PROD,
986 BIGG_T, BIGC_T, ent_prod_COMPLEX_BIGC_T);
989 /* divisions and quotients */
990 ent_binop_register(ASE_BINARY_OP_DIV,
991 BIGC_T, BIGC_T, ent_div_BIGC_T);
992 ent_binop_register(ASE_BINARY_OP_DIV,
993 BIGC_T, INT_T, ent_div_BIGC_T_COMPARABLE);
994 ent_binop_register(ASE_BINARY_OP_DIV,
995 INT_T, BIGC_T, ent_div_COMPARABLE_BIGC_T);
996 #if defined HAVE_MPZ && (defined WITH_GMP || defined WITH_MP)
997 ent_binop_register(ASE_BINARY_OP_DIV,
998 BIGC_T, BIGZ_T, ent_div_BIGC_T_COMPARABLE);
999 ent_binop_register(ASE_BINARY_OP_DIV,
1000 BIGZ_T, BIGC_T, ent_div_COMPARABLE_BIGC_T);
1002 #if defined HAVE_MPQ && defined WITH_GMP
1003 ent_binop_register(ASE_BINARY_OP_DIV,
1004 BIGC_T, BIGQ_T, ent_div_BIGC_T_COMPARABLE);
1005 ent_binop_register(ASE_BINARY_OP_DIV,
1006 BIGQ_T, BIGC_T, ent_div_COMPARABLE_BIGC_T);
1008 #if defined HAVE_MPF && defined WITH_GMP
1009 ent_binop_register(ASE_BINARY_OP_DIV,
1010 BIGC_T, BIGF_T, ent_div_BIGC_T_COMPARABLE);
1011 ent_binop_register(ASE_BINARY_OP_DIV,
1012 BIGF_T, BIGC_T, ent_div_COMPARABLE_BIGC_T);
1014 #if defined HAVE_MPFR && defined WITH_MPFR
1015 ent_binop_register(ASE_BINARY_OP_DIV,
1016 BIGC_T, BIGFR_T, ent_div_BIGC_T_COMPARABLE);
1017 ent_binop_register(ASE_BINARY_OP_DIV,
1018 BIGFR_T, BIGC_T, ent_div_COMPARABLE_BIGC_T);
1021 ent_binop_register(ASE_BINARY_OP_DIV,
1022 BIGC_T, FLOAT_T, ent_div_BIGC_T_COMPARABLE);
1023 ent_binop_register(ASE_BINARY_OP_DIV,
1024 FLOAT_T, BIGC_T, ent_div_COMPARABLE_BIGC_T);
1026 #if defined HAVE_PSEUG && defined WITH_PSEUG
1027 ent_binop_register(ASE_BINARY_OP_DIV,
1028 BIGC_T, BIGG_T, ent_div_BIGC_T_COMPLEX);
1029 ent_binop_register(ASE_BINARY_OP_DIV,
1030 BIGG_T, BIGC_T, ent_div_COMPLEX_BIGC_T);
1032 ent_binop_register(ASE_BINARY_OP_QUO,
1033 BIGC_T, BIGC_T, ent_div_BIGC_T);
1034 #if defined HAVE_MPZ && (defined WITH_GMP || defined WITH_MP)
1035 ent_binop_register(ASE_BINARY_OP_QUO,
1036 BIGC_T, BIGZ_T, ent_div_BIGC_T_COMPARABLE);
1037 ent_binop_register(ASE_BINARY_OP_QUO,
1038 BIGZ_T, BIGC_T, ent_div_COMPARABLE_BIGC_T);
1040 #if defined HAVE_MPQ && defined WITH_GMP
1041 ent_binop_register(ASE_BINARY_OP_QUO,
1042 BIGC_T, BIGQ_T, ent_div_BIGC_T_COMPARABLE);
1043 ent_binop_register(ASE_BINARY_OP_QUO,
1044 BIGQ_T, BIGC_T, ent_div_COMPARABLE_BIGC_T);
1046 #if defined HAVE_MPF && defined WITH_GMP
1047 ent_binop_register(ASE_BINARY_OP_QUO,
1048 BIGC_T, BIGF_T, ent_div_BIGC_T_COMPARABLE);
1049 ent_binop_register(ASE_BINARY_OP_QUO,
1050 BIGF_T, BIGC_T, ent_div_COMPARABLE_BIGC_T);
1052 #if defined HAVE_MPFR && defined WITH_MPFR
1053 ent_binop_register(ASE_BINARY_OP_QUO,
1054 BIGC_T, BIGFR_T, ent_div_BIGC_T_COMPARABLE);
1055 ent_binop_register(ASE_BINARY_OP_QUO,
1056 BIGFR_T, BIGC_T, ent_div_COMPARABLE_BIGC_T);
1059 ent_binop_register(ASE_BINARY_OP_QUO,
1060 BIGC_T, FLOAT_T, ent_div_BIGC_T_COMPARABLE);
1061 ent_binop_register(ASE_BINARY_OP_QUO,
1062 FLOAT_T, BIGC_T, ent_div_COMPARABLE_BIGC_T);
1064 #if defined HAVE_PSEUG && defined WITH_PSEUG
1065 ent_binop_register(ASE_BINARY_OP_QUO,
1066 BIGC_T, BIGG_T, ent_div_BIGC_T_COMPLEX);
1067 ent_binop_register(ASE_BINARY_OP_QUO,
1068 BIGG_T, BIGC_T, ent_div_COMPLEX_BIGC_T);
1070 ent_binop_register(ASE_BINARY_OP_REM,
1071 BIGC_T, BIGC_T, ent_rem_BIGC_T);
1072 ent_binop_register(ASE_BINARY_OP_MOD,
1073 BIGC_T, BIGC_T, ent_mod_BIGC_T);
1077 ent_mpc_unary_reltable_init(void)
1079 ent_unrel_register(ASE_UNARY_REL_ZEROP, BIGC_T, ent_mpc_zerop);
1080 ent_unrel_register(ASE_UNARY_REL_ONEP, BIGC_T, ent_mpc_onep);
1081 ent_unrel_register(ASE_UNARY_REL_UNITP, BIGC_T, ent_mpc_unitp);
1085 ent_mpc_binary_reltable_init(void)
1087 ent_binrel_register(ASE_BINARY_REL_EQUALP,
1088 BIGC_T, BIGC_T, ent_eq_BIGC_T);
1089 ent_binrel_register(ASE_BINARY_REL_NEQP,
1090 BIGC_T, BIGC_T, ent_ne_BIGC_T);
1094 ent_mpc_lifttable_init(void)
1096 ent_lift_register(INT_T, BIGC_T, ent_lift_INT_T_BIGC_T);
1097 #if defined HAVE_MPZ && (defined WITH_GMP || defined WITH_MP)
1098 ent_lift_register(BIGZ_T, BIGC_T, ent_lift_BIGZ_T_BIGC_T);
1100 #if defined HAVE_MPQ && defined WITH_GMP
1101 ent_lift_register(BIGQ_T, BIGC_T, ent_lift_BIGQ_T_BIGC_T);
1103 #if defined HAVE_MPF && defined WITH_GMP
1104 ent_lift_register(BIGF_T, BIGC_T, ent_lift_BIGF_T_BIGC_T);
1106 #if defined HAVE_MPFR && defined WITH_MPFR
1107 ent_lift_register(BIGFR_T, BIGC_T, ent_lift_BIGFR_T_BIGC_T);
1110 ent_lift_register(FLOAT_T, BIGC_T, ent_lift_FLOAT_T_BIGC_T);
1112 ent_lift_register(BIGG_T, BIGC_T, ent_lift_BIGG_T_BIGC_T);
1113 ent_lift_register(BIGC_T, BIGC_T, ent_lift_BIGC_T_BIGC_T);
1116 void init_optables_BIGC_T(void)
1118 ent_mpc_nullary_optable_init();
1119 ent_mpc_unary_optable_init();
1120 ent_mpc_binary_optable_init();
1121 ent_mpc_unary_reltable_init();
1122 ent_mpc_binary_reltable_init();
1123 ent_mpc_lifttable_init();
1126 void init_ent_mpc(void)
1128 bigc_init(ent_scratch_bigc);
1131 void syms_of_ent_mpc(void)
1133 INIT_LRECORD_IMPLEMENTATION(bigc);
1135 DEFSUBR(Fbigc_get_precision);
1136 DEFSUBR(Fbigc_set_precision);
1137 DEFSUBR(Fmake_bigc);
1140 void vars_of_ent_mpc(void)
1142 Fprovide(intern("bigc"));