2 ent-gaussian.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 */
30 #include "ent-float.h"
34 #include "ent-gaussian.h"
39 bigg ent_scratch_bigg;
40 static ase_nullary_operation_f Qent_gaussian_zero, Qent_gaussian_one;
44 bigg_print(Lisp_Object obj, Lisp_Object printcharfun, int SXE_UNUSED(escapeflag))
46 Bufbyte *fstr = bigg_to_string(XBIGG_DATA(obj), 10);
47 write_c_string((char*)fstr, printcharfun);
49 fstr = (Bufbyte *)NULL;
54 bigg_equal(Lisp_Object obj1, Lisp_Object obj2, int SXE_UNUSED(depth))
56 return bigg_eql(XBIGG_DATA(obj1), XBIGG_DATA(obj2));
60 bigg_hash(Lisp_Object obj, int SXE_UNUSED(depth))
62 return bigg_hashcode(XBIGG_DATA(obj));
66 bigg_mark(Lisp_Object SXE_UNUSED(obj))
72 bigg_finalise(void *SXE_UNUSED(header), int for_disksave)
76 ("Can't dump an emacs containing "
77 "pseudo-gaussian objects",Qt);
80 static const struct lrecord_description bigg_description[] = {
81 { XD_OPAQUE_DATA_PTR, offsetof(Lisp_Bigg, data) },
85 DEFINE_BASIC_LRECORD_IMPLEMENTATION("bigg", bigg,
86 bigg_mark, bigg_print, bigg_finalise,
87 bigg_equal, bigg_hash,
88 bigg_description, Lisp_Bigg);
90 DEFUN("make-bigg", Fmake_bigg, 2, 2, 0, /*
91 Return the Gaussian number whose rational component is REAL-PART
92 and whose imaginary component is IMAGINARY-PART.
94 (real_part, imaginary_part))
96 CHECK_COMPARABLE(real_part);
97 CHECK_COMPARABLE(imaginary_part);
100 Lisp_Object tmp_r = Fcoerce_number(real_part, Qbigz, Qnil);
101 Lisp_Object tmp_i = Fcoerce_number(imaginary_part, Qbigz, Qnil);
102 return make_bigg_bz(XBIGZ_DATA(tmp_r), XBIGZ_DATA(tmp_i));
107 /* basic functions */
108 void bigg_init(bigg g)
110 bigz_init(bigg_re(g));
111 bigz_init(bigg_im(g));
114 void bigg_fini(bigg g)
116 bigz_fini(bigg_re(g));
117 bigz_fini(bigg_im(g));
120 unsigned long bigg_hashcode(bigg g)
122 return (bigz_hashcode(bigg_re(g)) ^
123 bigz_hashcode(bigg_im(g)));
126 Bufbyte *bigg_to_string(bigg g, int base)
130 int intg_len, imag_len;
133 intg_str = (Bufbyte*)bigz_to_string(bigg_re(g), base);
134 imag_str = (Bufbyte*)bigz_to_string(bigg_im(g), base);
136 intg_len = strlen((char*)intg_str);
137 imag_len = strlen((char*)imag_str);
139 sign = bigz_sign(bigg_im(g));
140 neg = (sign >= 0) ? 1 : 0;
142 /* now append the imaginary string */
143 XREALLOC_ARRAY(intg_str, Bufbyte, intg_len + neg + imag_len + 2);
145 intg_str[intg_len] = '+';
146 memmove(&intg_str[intg_len + neg],
149 intg_str[intg_len+neg+imag_len] = 'i';
150 intg_str[intg_len+neg+imag_len+1] = '\0';
156 /***** Bigg: converting assignments *****/
157 void bigg_set(bigg g1,bigg g2)
159 bigz_set(bigg_re(g1), bigg_re(g2));
160 bigz_set(bigg_im(g1), bigg_im(g2));
163 void bigg_set_long(bigg g, long l)
165 bigz_set_long(bigg_re(g), l);
166 bigz_set_long(bigg_im(g), 0L);
169 void bigg_set_long_long(bigg g, long l1, long l2)
171 bigz_set_long(bigg_re(g), l1);
172 bigz_set_long(bigg_im(g), l2);
175 void bigg_set_ulong(bigg g, unsigned long ul)
177 bigz_set_ulong(bigg_re(g), ul);
178 bigz_set_ulong(bigg_im(g), 0UL);
181 void bigg_set_ulong_ulong(bigg g, unsigned long ul1, unsigned long ul2)
183 bigz_set_ulong(bigg_re(g), ul1);
184 bigz_set_ulong(bigg_im(g), ul2);
187 void bigg_set_bigz(bigg g, bigz z)
189 bigz_set(bigg_re(g), z);
190 bigz_set_long(bigg_im(g), 0L);
193 void bigg_set_bigz_bigz(bigg g, bigz z1, bigz z2)
195 bigz_set(bigg_re(g), z1);
196 bigz_set(bigg_im(g), z2);
199 /* void bigc_set_bigg(bigc c, bigg g)
201 * bigc_set_bigfr_bigfr(bigg_re(g), z1);
205 /***** Bigg: comparisons *****/
206 int bigg_eql(bigg g1, bigg g2)
208 return ((bigz_eql(bigg_re(g1), bigg_re(g2))) &&
209 (bigz_eql(bigg_im(g1), bigg_im(g2))));
212 /***** Bigg: arithmetic *****/
213 #if defined HAVE_MPFR && defined WITH_MPFR
214 void bigg_abs(bigfr res, bigg g)
216 /* the absolute archimedean valuation of a+bi is defined as:
219 bigz accu1, accu2, bz;
224 bigz_mul(accu1, bigg_re(g), bigg_re(g));
225 bigz_mul(accu2, bigg_im(g), bigg_im(g));
226 bigz_add(bz, accu1, accu2);
228 bigfr_set_bigz(res, bz);
229 bigfr_sqrt(res, res);
237 void bigg_norm(bigz res, bigg g)
239 /* norm is the square of the absolute archimedean valuation */
244 bigz_mul(accu1, bigg_re(g), bigg_re(g));
245 bigz_mul(accu2, bigg_im(g), bigg_im(g));
246 bigz_add(res, accu1, accu2);
252 void bigg_neg(bigg res, bigg g)
254 /* negation is defined point-wise */
255 bigz_neg(bigg_re(res), bigg_re(g));
256 bigz_neg(bigg_im(res), bigg_im(g));
259 void bigg_conj(bigg res, bigg g)
262 bigz_neg(bigg_im(res), bigg_im(res));
265 void bigg_add(bigg res, bigg g1, bigg g2)
267 /* addition is defined point-wise */
272 bigz_add(accu1, bigg_re(g1), bigg_re(g2));
273 bigz_add(accu2, bigg_im(g1), bigg_im(g2));
274 bigg_set_bigz_bigz(res, accu1, accu2);
280 void bigg_sub(bigg res, bigg g1, bigg g2)
282 /* subtraction is defined point-wise */
283 bigz_sub(bigg_re(res), bigg_re(g1), bigg_re(g2));
284 bigz_sub(bigg_im(res), bigg_im(g1), bigg_im(g2));
287 void bigg_mul(bigg res, bigg g1, bigg g2)
289 /* multiplication is defined as:
290 * (a + bi)*(c + di) = (ac - bd) + (ad + bc)i
292 bigz accu1, accu2, accu3, accu4;
298 bigz_mul(accu1, bigg_re(g1), bigg_re(g2));
299 bigz_mul(accu2, bigg_im(g1), bigg_im(g2));
300 bigz_mul(accu3, bigg_re(g1), bigg_im(g2));
301 bigz_mul(accu4, bigg_im(g1), bigg_re(g2));
303 bigz_sub(bigg_re(res), accu1, accu2);
304 bigz_add(bigg_im(res), accu3, accu4);
312 void bigg_div(bigg res, bigg g1, bigg g2)
314 /* division is defined as:
315 * (a + bi) div (c + di) = ((a+bi)*(c-di)) div (c*c+d*d)
323 /* compute: c^2 + d^2 */
324 bigz_mul(accu1, bigg_re(g2), bigg_re(g2));
325 bigz_mul(accu2, bigg_im(g2), bigg_im(g2));
326 bigz_add(accu1, accu1, accu2);
328 /* do normal multiplication with conjugate of g2 */
329 bigg_conj(accug, g2);
330 bigg_mul(accug, g1, accug);
332 bigg_set(res, accug);
334 /* now divide (g1*conj(g2)) by c^2+d^2 (point-wise) */
335 bigz_div(bigg_re(res), bigg_re(accug), accu1);
336 bigz_div(bigg_im(res), bigg_im(accug), accu1);
343 void bigg_mod(bigg res, bigg g1, bigg g2)
345 /* the modulo relation is defined as:
346 * (a + bi) mod (c + di) ~
347 * (a+bi) - ((a+bi) div (c-di)) * (c+di)
352 /* do normal division */
353 bigg_div(accug, g1, g2);
355 /* now re-multiply g2 */
356 bigg_mul(accug, accug, g2);
358 /* and find the difference */
359 bigg_sub(res, g1, accug);
364 void bigg_pow(bigg res, bigg g1, unsigned long g2)
366 #if defined(HAVE_MPZ) && defined(WITH_GMP)
368 bigz bin, resintg, resimag, tmpbz1, tmpbz2, tmpbz3, intg, imag;
379 bigz_set_long(resintg, 0L);
380 bigz_set_long(resimag, 0L);
382 bigz_set(intg, bigg_re(g1));
383 bigz_set(imag, bigg_im(g1));
385 /* we compute using the binomial coefficients */
386 for (i=0; i<=g2; i++) {
387 mpz_bin_uiui(bin, g2, i);
389 /* real part changes */
390 bigz_pow(tmpbz1, intg, g2-i);
391 bigz_pow(tmpbz2, imag, i);
392 bigz_mul(tmpbz3, tmpbz1, tmpbz2);
393 bigz_mul(bin, bin, tmpbz3);
395 bigz_add(resintg, resintg, bin);
396 } else if (i % 4 == 2) {
397 bigz_sub(resintg, resintg, bin);
400 /* imag part changes */
401 bigz_pow(tmpbz1, intg, g2-i);
402 bigz_pow(tmpbz2, imag, i);
403 bigz_mul(tmpbz3, tmpbz1, tmpbz2);
404 bigz_mul(bin, bin, tmpbz3);
406 bigz_add(resimag, resimag, bin);
407 } else if (i % 4 == 3) {
408 bigz_sub(resimag, resimag, bin);
413 bigg_set_bigz_bigz(res, resintg, resimag);
424 bigg_set_long_long(res, 0L, 0L);
428 Lisp_Object read_bigg_string(char *cp)
439 /* MPZ bigz_set_string has no effect
440 * with initial + sign */
447 /* jump over a leading minus */
451 while ((*cp >= '0' && *cp <= '9'))
454 /* MPZ cannot read numbers with characters after them.
455 * See limitations below in convert GMP-MPZ strings
459 bigz_set_string(bz_re, (char *)end, 0);
462 /* read the imaginary part */
472 if ((*cp == 'i' || *cp == 'I') && (sign == 1)) {
473 /* expand +i to +1i and -i to -1i */
474 bigz_set_long(bz_im, 1L);
475 } else if ((*cp == 'i' || *cp == 'I') && (sign == -1)) {
476 /* expand +i to +1i and -i to -1i */
477 bigz_set_long(bz_im, -1L);
478 } else if (sign == 0) {
479 /* obviously we did not have a+bi,
482 bigz_set(bz_im, bz_re);
483 bigz_set_long(bz_re, 0L);
488 while ((*cp >= '0' && *cp <= '9'))
492 bigz_set_string(bz_im, (char *)end, 0);
496 result = make_bigg_bz(bz_re, bz_im);
505 ent_gaussian_zerop(Lisp_Object o)
507 return (bigz_sign(bigg_re(XBIGG_DATA(o))) == 0 &&
508 bigz_sign(bigg_im(XBIGG_DATA(o))) == 0);
512 ent_gaussian_onep(Lisp_Object o)
514 return ((bigz_fits_long_p(bigg_re(XBIGG_DATA(o))) &&
515 bigz_to_long(bigg_re(XBIGG_DATA(o))) == 1L) &&
516 bigz_sign(bigg_im(XBIGG_DATA(o))) == 0);
520 ent_gaussian_unitp(Lisp_Object o)
522 return (!ent_gaussian_zerop(o) &&
523 (bigz_fits_long_p(bigg_re(XBIGG_DATA(o))) &&
524 (bigz_to_long(bigg_re(XBIGG_DATA(o))) == 0L ||
525 bigz_to_long(bigg_re(XBIGG_DATA(o))) == 1L ||
526 bigz_to_long(bigg_re(XBIGG_DATA(o))) == -1L)) &&
527 (bigz_fits_long_p(bigg_im(XBIGG_DATA(o))) &&
528 (bigz_to_long(bigg_im(XBIGG_DATA(o))) == 0L ||
529 bigz_to_long(bigg_im(XBIGG_DATA(o))) == 1L ||
530 bigz_to_long(bigg_im(XBIGG_DATA(o))) == -1L)));
533 static inline Lisp_Object
534 ent_sum_BIGG_T(Lisp_Object l, Lisp_Object r)
536 bigg_add(ent_scratch_bigg, XBIGG_DATA(l), XBIGG_DATA(r));
537 return make_bigg_bg(ent_scratch_bigg);
539 static inline Lisp_Object
540 ent_sum_BIGG_T_COMPARABLE(Lisp_Object l, Lisp_Object r)
544 r = ent_lift(r, BIGZ_T, NULL);
546 bigg_set_bigz(ent_scratch_bigg, XBIGZ_DATA(r));
547 bigg_add(ent_scratch_bigg, XBIGG_DATA(l), ent_scratch_bigg);
548 return make_bigg_bg(ent_scratch_bigg);
550 static inline Lisp_Object
551 ent_sum_COMPARABLE_BIGG_T(Lisp_Object l, Lisp_Object r)
555 l = ent_lift(l, BIGZ_T, NULL);
557 bigg_set_bigz(ent_scratch_bigg, XBIGZ_DATA(l));
558 bigg_add(ent_scratch_bigg, ent_scratch_bigg, XBIGG_DATA(r));
559 return make_bigg_bg(ent_scratch_bigg);
562 static inline Lisp_Object
563 ent_diff_BIGG_T(Lisp_Object l, Lisp_Object r)
565 bigg_sub(ent_scratch_bigg, XBIGG_DATA(l), XBIGG_DATA(r));
566 return make_bigg_bg(ent_scratch_bigg);
568 static inline Lisp_Object
569 ent_diff_BIGG_T_COMPARABLE(Lisp_Object l, Lisp_Object r)
573 r = ent_lift(r, BIGZ_T, NULL);
575 bigg_set_bigz(ent_scratch_bigg, XBIGZ_DATA(r));
576 bigg_sub(ent_scratch_bigg, XBIGG_DATA(l), ent_scratch_bigg);
577 return make_bigg_bg(ent_scratch_bigg);
579 static inline Lisp_Object
580 ent_diff_COMPARABLE_BIGG_T(Lisp_Object l, Lisp_Object r)
584 l = ent_lift(l, BIGZ_T, NULL);
586 bigg_set_bigz(ent_scratch_bigg, XBIGZ_DATA(l));
587 bigg_sub(ent_scratch_bigg, ent_scratch_bigg, XBIGG_DATA(r));
588 return make_bigg_bg(ent_scratch_bigg);
591 static inline Lisp_Object
592 ent_neg_BIGG_T(Lisp_Object l)
594 bigg_neg(ent_scratch_bigg, XBIGG_DATA(l));
595 return make_bigg_bg(ent_scratch_bigg);
598 static inline Lisp_Object
599 ent_prod_BIGG_T(Lisp_Object l, Lisp_Object r)
601 bigg_mul(ent_scratch_bigg, XBIGG_DATA(l), XBIGG_DATA(r));
602 return make_bigg_bg(ent_scratch_bigg);
604 static inline Lisp_Object
605 ent_prod_BIGG_T_COMPARABLE(Lisp_Object l, Lisp_Object r)
609 r = ent_lift(r, BIGZ_T, NULL);
611 bigg_set_bigz(ent_scratch_bigg, XBIGZ_DATA(r));
612 bigg_mul(ent_scratch_bigg, XBIGG_DATA(l), ent_scratch_bigg);
613 return make_bigg_bg(ent_scratch_bigg);
615 static inline Lisp_Object
616 ent_prod_COMPARABLE_BIGG_T(Lisp_Object l, Lisp_Object r)
620 l = ent_lift(l, BIGZ_T, NULL);
622 bigg_set_bigz(ent_scratch_bigg, XBIGZ_DATA(l));
623 bigg_mul(ent_scratch_bigg, ent_scratch_bigg, XBIGG_DATA(r));
624 return make_bigg_bg(ent_scratch_bigg);
627 static inline Lisp_Object
628 ent_div_BIGG_T(Lisp_Object l, Lisp_Object r)
630 if (ent_gaussian_zerop(r)) {
631 if (!ent_gaussian_zerop(l)) {
632 return make_indef(COMPLEX_INFINITY);
634 return make_indef(NOT_A_NUMBER);
637 bigg_div(ent_scratch_bigg, XBIGG_DATA(l), XBIGG_DATA(r));
638 return make_bigg_bg(ent_scratch_bigg);
640 static inline Lisp_Object
641 ent_div_BIGG_T_COMPARABLE(Lisp_Object l, Lisp_Object r)
645 if (ent_unrel_zerop(l)) {
646 if (!ent_gaussian_zerop(l)) {
647 return make_indef(COMPLEX_INFINITY);
649 return make_indef(NOT_A_NUMBER);
653 r = ent_lift(r, BIGZ_T, NULL);
655 bigg_set_bigz(ent_scratch_bigg, XBIGZ_DATA(r));
656 bigg_div(ent_scratch_bigg, XBIGG_DATA(l), ent_scratch_bigg);
657 return make_bigg_bg(ent_scratch_bigg);
659 static inline Lisp_Object
660 ent_div_COMPARABLE_BIGG_T(Lisp_Object l, Lisp_Object r)
664 if (ent_gaussian_zerop(r)) {
665 if (!ent_unrel_zerop(l)) {
666 return make_indef(COMPLEX_INFINITY);
668 return make_indef(NOT_A_NUMBER);
672 l = ent_lift(l, BIGZ_T, NULL);
674 bigg_set_bigz(ent_scratch_bigg, XBIGZ_DATA(l));
675 bigg_div(ent_scratch_bigg, ent_scratch_bigg, XBIGG_DATA(r));
676 return make_bigg_bg(ent_scratch_bigg);
679 #if defined HAVE_MPC && defined WITH_MPC || \
680 defined HAVE_PSEUC && defined WITH_PSEUC
681 static inline Lisp_Object
682 ent_quo_BIGG_T(Lisp_Object l, Lisp_Object r)
684 Lisp_Object tmp_l, tmp_r;
686 if (ent_gaussian_zerop(r)) {
687 if (!ent_gaussian_zerop(l)) {
688 return make_indef(COMPLEX_INFINITY);
690 return make_indef(NOT_A_NUMBER);
694 bigc_set_prec(ent_scratch_bigc, internal_get_precision(Qnil));
695 tmp_l = Fcoerce_number(l, Qbigc, Qnil);
696 tmp_r = Fcoerce_number(r, Qbigc, Qnil);
697 bigc_div(ent_scratch_bigc, XBIGC_DATA(tmp_l), XBIGC_DATA(tmp_r));
698 return make_bigc_bc(ent_scratch_bigc);
700 static inline Lisp_Object
701 ent_quo_BIGG_T_COMPARABLE(Lisp_Object l, Lisp_Object r)
705 if (ent_unrel_zerop(r)) {
706 if (!ent_gaussian_zerop(l)) {
707 return make_indef(COMPLEX_INFINITY);
709 return make_indef(NOT_A_NUMBER);
713 l = ent_lift(l, BIGC_T, NULL);
714 return ent_binop(ASE_BINARY_OP_QUO, l, r);
716 static inline Lisp_Object
717 ent_quo_COMPARABLE_BIGG_T(Lisp_Object l, Lisp_Object r)
721 if (ent_gaussian_zerop(r)) {
722 if (!ent_unrel_zerop(l)) {
723 return make_indef(COMPLEX_INFINITY);
725 return make_indef(NOT_A_NUMBER);
729 r = ent_lift(r, BIGC_T, NULL);
730 return ent_binop(ASE_BINARY_OP_QUO, l, r);
734 static inline Lisp_Object
735 ent_inv_BIGG_T(Lisp_Object r)
737 if (ent_gaussian_zerop(r)) {
738 return make_indef(COMPLEX_INFINITY);
740 bigg_div(ent_scratch_bigg,
741 XBIGG_DATA(Qent_gaussian_one), XBIGG_DATA(r));
742 return make_bigg_bg(ent_scratch_bigg);
744 static inline Lisp_Object
745 ent_rem_BIGG_T(Lisp_Object l, Lisp_Object r)
747 if (ent_gaussian_zerop(r)) {
748 return make_bigg(0, 0);
750 bigg_mod(ent_scratch_bigg, XBIGG_DATA(l), XBIGG_DATA(r));
751 return make_bigg_bg(ent_scratch_bigg);
753 static inline Lisp_Object
754 ent_pow_BIGG_T_integer(Lisp_Object l, Lisp_Object r)
756 long unsigned int expo = 0UL;
760 } else if (BIGZP(r)) {
761 if (bigz_fits_ulong_p(XBIGZ_DATA(r)))
762 expo = bigz_to_ulong(XBIGZ_DATA(r));
764 Fsignal(Qarith_error, r);
766 Fsignal(Qdomain_error, r);
768 bigg_pow(ent_scratch_bigg, XBIGG_DATA(l), expo);
769 return make_bigg_bg(ent_scratch_bigg);
774 ent_eq_bigg(Lisp_Object l, Lisp_Object r)
776 return (bigz_eql(bigg_re(XBIGG_DATA(l)), bigg_re(XBIGG_DATA(r))) &&
777 bigz_eql(bigg_im(XBIGG_DATA(l)), bigg_im(XBIGG_DATA(r))));
781 ent_ne_bigg(Lisp_Object l, Lisp_Object r)
783 return !(bigz_eql(bigg_re(XBIGG_DATA(l)), bigg_re(XBIGG_DATA(r))) &&
784 bigz_eql(bigg_im(XBIGG_DATA(l)), bigg_im(XBIGG_DATA(r))));
788 static inline Lisp_Object
789 ent_vallt_BIGG_T(Lisp_Object l, Lisp_Object r)
795 bigg_norm(ent_scratch_bigz, XBIGG_DATA(l));
796 bigg_norm(b2, XBIGG_DATA(r));
797 result = bigz_lt(ent_scratch_bigz, b2);
800 return (result) ? Qt : Qnil;
802 static inline Lisp_Object
803 ent_valgt_BIGG_T(Lisp_Object l, Lisp_Object r)
809 bigg_norm(ent_scratch_bigz, XBIGG_DATA(l));
810 bigg_norm(b2, XBIGG_DATA(r));
811 result = bigz_gt(ent_scratch_bigz, b2);
814 return (result) ? Qt : Qnil;
816 static inline Lisp_Object
817 ent_valeq_BIGG_T(Lisp_Object l, Lisp_Object r)
823 bigg_norm(ent_scratch_bigz, XBIGG_DATA(l));
824 bigg_norm(b2, XBIGG_DATA(r));
825 result = bigz_eql(ent_scratch_bigz, b2);
828 return (result) ? Qt : Qnil;
830 static inline Lisp_Object
831 ent_valne_BIGG_T(Lisp_Object l, Lisp_Object r)
837 bigg_norm(ent_scratch_bigz, XBIGG_DATA(l));
838 bigg_norm(b2, XBIGG_DATA(r));
839 result = bigz_eql(ent_scratch_bigz, b2);
842 return (result) ? Qnil : Qt;
848 ent_lift_all_BIGG_T(Lisp_Object number, ent_lift_args_t SXE_UNUSED(la))
850 number = ent_lift(number, BIGZ_T, NULL);
851 bigg_set_bigz(ent_scratch_bigg, XBIGZ_DATA(number));
852 return make_bigg_bg(ent_scratch_bigg);
855 #if defined HAVE_MPC && defined WITH_MPC || \
856 defined HAVE_PSEUC && defined WITH_PSEUC
858 ent_lift_BIGC_T_BIGG_T(Lisp_Object number, ent_lift_args_t SXE_UNUSED(la))
862 re = Freal_part(number);
863 re = ent_lift(re, BIGZ_T, NULL);
864 im = Fimaginary_part(number);
865 im = ent_lift(im, BIGZ_T, NULL);
867 return make_bigg_bz(XBIGZ_DATA(re), XBIGZ_DATA(im));
873 ent_gaussian_nullary_optable_init(void)
875 Qent_gaussian_zero = make_bigg(0L, 0L);
876 Qent_gaussian_one = make_bigg(1L, 0L);
877 staticpro(&Qent_gaussian_zero);
878 staticpro(&Qent_gaussian_one);
880 ent_nullop_register(ASE_NULLARY_OP_ZERO, BIGG_T, Qent_gaussian_zero);
881 ent_nullop_register(ASE_NULLARY_OP_ONE, BIGG_T, Qent_gaussian_one);
885 ent_gaussian_unary_optable_init(void)
887 ent_unop_register(ASE_UNARY_OP_NEG, BIGG_T, ent_neg_BIGG_T);
888 ent_unop_register(ASE_UNARY_OP_INV, BIGG_T, ent_inv_BIGG_T);
892 ent_gaussian_binary_optable_init(void)
895 ent_binop_register(ASE_BINARY_OP_SUM,
896 BIGG_T, BIGG_T, ent_sum_BIGG_T);
897 ent_binop_register(ASE_BINARY_OP_SUM,
898 BIGG_T, INT_T, ent_sum_BIGG_T_COMPARABLE);
899 ent_binop_register(ASE_BINARY_OP_SUM,
900 INT_T, BIGG_T, ent_sum_COMPARABLE_BIGG_T);
901 #if defined HAVE_MPZ && (defined WITH_GMP || defined WITH_MP)
902 ent_binop_register(ASE_BINARY_OP_SUM,
903 BIGG_T, BIGZ_T, ent_sum_BIGG_T_COMPARABLE);
904 ent_binop_register(ASE_BINARY_OP_SUM,
905 BIGZ_T, BIGG_T, ent_sum_COMPARABLE_BIGG_T);
907 #if defined HAVE_MPQ && defined WITH_GMP
908 ent_binop_register(ASE_BINARY_OP_SUM,
909 BIGG_T, BIGQ_T, ent_sum_BIGG_T_COMPARABLE);
910 ent_binop_register(ASE_BINARY_OP_SUM,
911 BIGQ_T, BIGG_T, ent_sum_COMPARABLE_BIGG_T);
913 #if defined HAVE_MPF && defined WITH_GMP
914 ent_binop_register(ASE_BINARY_OP_SUM,
915 BIGG_T, BIGF_T, ent_sum_BIGG_T_COMPARABLE);
916 ent_binop_register(ASE_BINARY_OP_SUM,
917 BIGF_T, BIGG_T, ent_sum_COMPARABLE_BIGG_T);
919 #if defined HAVE_MPFR && defined WITH_MPFR
920 ent_binop_register(ASE_BINARY_OP_SUM,
921 BIGG_T, BIGFR_T, ent_sum_BIGG_T_COMPARABLE);
922 ent_binop_register(ASE_BINARY_OP_SUM,
923 BIGFR_T, BIGG_T, ent_sum_COMPARABLE_BIGG_T);
926 ent_binop_register(ASE_BINARY_OP_SUM,
927 BIGG_T, FLOAT_T, ent_sum_BIGG_T_COMPARABLE);
928 ent_binop_register(ASE_BINARY_OP_SUM,
929 FLOAT_T, BIGG_T, ent_sum_COMPARABLE_BIGG_T);
932 ent_binop_register(ASE_BINARY_OP_DIFF,
933 BIGG_T, BIGG_T, ent_diff_BIGG_T);
934 ent_binop_register(ASE_BINARY_OP_DIFF,
935 BIGG_T, INT_T, ent_diff_BIGG_T_COMPARABLE);
936 ent_binop_register(ASE_BINARY_OP_DIFF,
937 INT_T, BIGG_T, ent_diff_COMPARABLE_BIGG_T);
938 ent_binop_register(ASE_BINARY_OP_DIFF,
939 BIGG_T, BIGZ_T, ent_diff_BIGG_T_COMPARABLE);
940 ent_binop_register(ASE_BINARY_OP_DIFF,
941 BIGZ_T, BIGG_T, ent_diff_COMPARABLE_BIGG_T);
942 #if defined HAVE_MPQ && defined WITH_GMP
943 ent_binop_register(ASE_BINARY_OP_DIFF,
944 BIGG_T, BIGQ_T, ent_diff_BIGG_T_COMPARABLE);
945 ent_binop_register(ASE_BINARY_OP_DIFF,
946 BIGQ_T, BIGG_T, ent_diff_COMPARABLE_BIGG_T);
948 #if defined HAVE_MPF && defined WITH_GMP
949 ent_binop_register(ASE_BINARY_OP_DIFF,
950 BIGG_T, BIGF_T, ent_diff_BIGG_T_COMPARABLE);
951 ent_binop_register(ASE_BINARY_OP_DIFF,
952 BIGF_T, BIGG_T, ent_diff_COMPARABLE_BIGG_T);
954 #if defined HAVE_MPFR && defined WITH_MPFR
955 ent_binop_register(ASE_BINARY_OP_DIFF,
956 BIGG_T, BIGFR_T, ent_diff_BIGG_T_COMPARABLE);
957 ent_binop_register(ASE_BINARY_OP_DIFF,
958 BIGFR_T, BIGG_T, ent_diff_COMPARABLE_BIGG_T);
961 ent_binop_register(ASE_BINARY_OP_DIFF,
962 BIGG_T, FLOAT_T, ent_diff_BIGG_T_COMPARABLE);
963 ent_binop_register(ASE_BINARY_OP_DIFF,
964 FLOAT_T, BIGG_T, ent_diff_COMPARABLE_BIGG_T);
967 ent_binop_register(ASE_BINARY_OP_PROD,
968 BIGG_T, BIGG_T, ent_prod_BIGG_T);
969 ent_binop_register(ASE_BINARY_OP_PROD,
970 BIGG_T, INT_T, ent_prod_BIGG_T_COMPARABLE);
971 ent_binop_register(ASE_BINARY_OP_PROD,
972 INT_T, BIGG_T, ent_prod_COMPARABLE_BIGG_T);
973 ent_binop_register(ASE_BINARY_OP_PROD,
974 BIGG_T, BIGZ_T, ent_prod_BIGG_T_COMPARABLE);
975 ent_binop_register(ASE_BINARY_OP_PROD,
976 BIGZ_T, BIGG_T, ent_prod_COMPARABLE_BIGG_T);
977 #if defined HAVE_MPQ && defined WITH_GMP
978 ent_binop_register(ASE_BINARY_OP_PROD,
979 BIGG_T, BIGQ_T, ent_prod_BIGG_T_COMPARABLE);
980 ent_binop_register(ASE_BINARY_OP_PROD,
981 BIGQ_T, BIGG_T, ent_prod_COMPARABLE_BIGG_T);
983 #if defined HAVE_MPF && defined WITH_GMP
984 ent_binop_register(ASE_BINARY_OP_PROD,
985 BIGG_T, BIGF_T, ent_prod_BIGG_T_COMPARABLE);
986 ent_binop_register(ASE_BINARY_OP_PROD,
987 BIGF_T, BIGG_T, ent_prod_COMPARABLE_BIGG_T);
989 #if defined HAVE_MPFR && defined WITH_MPFR
990 ent_binop_register(ASE_BINARY_OP_PROD,
991 BIGG_T, BIGFR_T, ent_prod_BIGG_T_COMPARABLE);
992 ent_binop_register(ASE_BINARY_OP_PROD,
993 BIGFR_T, BIGG_T, ent_prod_COMPARABLE_BIGG_T);
996 ent_binop_register(ASE_BINARY_OP_PROD,
997 BIGG_T, FLOAT_T, ent_prod_BIGG_T_COMPARABLE);
998 ent_binop_register(ASE_BINARY_OP_PROD,
999 FLOAT_T, BIGG_T, ent_prod_COMPARABLE_BIGG_T);
1002 /* divisions and quotients */
1003 ent_binop_register(ASE_BINARY_OP_DIV,
1004 BIGG_T, BIGG_T, ent_div_BIGG_T);
1005 ent_binop_register(ASE_BINARY_OP_DIV,
1006 BIGG_T, INT_T, ent_div_BIGG_T_COMPARABLE);
1007 ent_binop_register(ASE_BINARY_OP_DIV,
1008 INT_T, BIGG_T, ent_div_COMPARABLE_BIGG_T);
1009 ent_binop_register(ASE_BINARY_OP_DIV,
1010 BIGG_T, BIGZ_T, ent_div_BIGG_T_COMPARABLE);
1011 ent_binop_register(ASE_BINARY_OP_DIV,
1012 BIGZ_T, BIGG_T, ent_div_COMPARABLE_BIGG_T);
1013 #if defined HAVE_MPQ && defined WITH_GMP
1014 ent_binop_register(ASE_BINARY_OP_DIV,
1015 BIGG_T, BIGQ_T, ent_div_BIGG_T_COMPARABLE);
1016 ent_binop_register(ASE_BINARY_OP_DIV,
1017 BIGQ_T, BIGG_T, ent_div_COMPARABLE_BIGG_T);
1019 #if defined HAVE_MPF && defined WITH_GMP
1020 ent_binop_register(ASE_BINARY_OP_DIV,
1021 BIGG_T, BIGF_T, ent_div_BIGG_T_COMPARABLE);
1022 ent_binop_register(ASE_BINARY_OP_DIV,
1023 BIGF_T, BIGG_T, ent_div_COMPARABLE_BIGG_T);
1025 #if defined HAVE_MPFR && defined WITH_MPFR
1026 ent_binop_register(ASE_BINARY_OP_DIV,
1027 BIGG_T, BIGFR_T, ent_div_BIGG_T_COMPARABLE);
1028 ent_binop_register(ASE_BINARY_OP_DIV,
1029 BIGFR_T, BIGG_T, ent_div_COMPARABLE_BIGG_T);
1032 ent_binop_register(ASE_BINARY_OP_DIV,
1033 BIGG_T, FLOAT_T, ent_div_BIGG_T_COMPARABLE);
1034 ent_binop_register(ASE_BINARY_OP_DIV,
1035 FLOAT_T, BIGG_T, ent_div_COMPARABLE_BIGG_T);
1038 #if defined HAVE_MPC && defined WITH_MPC || \
1039 defined HAVE_PSEUC && defined WITH_PSEUC
1040 ent_binop_register(ASE_BINARY_OP_QUO,
1041 BIGG_T, BIGG_T, ent_quo_BIGG_T);
1042 ent_binop_register(ASE_BINARY_OP_QUO,
1043 BIGG_T, BIGZ_T, ent_quo_BIGG_T_COMPARABLE);
1044 ent_binop_register(ASE_BINARY_OP_QUO,
1045 BIGZ_T, BIGG_T, ent_quo_COMPARABLE_BIGG_T);
1046 #if defined HAVE_MPQ && defined WITH_GMP
1047 ent_binop_register(ASE_BINARY_OP_QUO,
1048 BIGG_T, BIGQ_T, ent_quo_BIGG_T_COMPARABLE);
1049 ent_binop_register(ASE_BINARY_OP_QUO,
1050 BIGQ_T, BIGG_T, ent_quo_COMPARABLE_BIGG_T);
1052 #if defined HAVE_MPF && defined WITH_GMP
1053 ent_binop_register(ASE_BINARY_OP_QUO,
1054 BIGG_T, BIGF_T, ent_quo_BIGG_T_COMPARABLE);
1055 ent_binop_register(ASE_BINARY_OP_QUO,
1056 BIGF_T, BIGG_T, ent_quo_COMPARABLE_BIGG_T);
1058 #if defined HAVE_MPFR && defined WITH_MPFR
1059 ent_binop_register(ASE_BINARY_OP_QUO,
1060 BIGG_T, BIGFR_T, ent_quo_BIGG_T_COMPARABLE);
1061 ent_binop_register(ASE_BINARY_OP_QUO,
1062 BIGFR_T, BIGG_T, ent_quo_COMPARABLE_BIGG_T);
1065 ent_binop_register(ASE_BINARY_OP_QUO,
1066 BIGG_T, FLOAT_T, ent_quo_BIGG_T_COMPARABLE);
1067 ent_binop_register(ASE_BINARY_OP_QUO,
1068 FLOAT_T, BIGG_T, ent_quo_COMPARABLE_BIGG_T);
1070 #else /* !HAVE_MPC */
1071 ent_binop_register(ASE_BINARY_OP_QUO,
1072 BIGG_T, BIGG_T, ent_div_BIGG_T);
1073 ent_binop_register(ASE_BINARY_OP_QUO,
1074 BIGG_T, BIGZ_T, ent_div_BIGG_T_COMPARABLE);
1075 ent_binop_register(ASE_BINARY_OP_QUO,
1076 BIGZ_T, BIGG_T, ent_div_COMPARABLE_BIGG_T);
1077 #if defined HAVE_MPQ && defined WITH_GMP
1078 ent_binop_register(ASE_BINARY_OP_QUO,
1079 BIGG_T, BIGQ_T, ent_div_BIGG_T_COMPARABLE);
1080 ent_binop_register(ASE_BINARY_OP_QUO,
1081 BIGQ_T, BIGG_T, ent_div_COMPARABLE_BIGG_T);
1083 #if defined HAVE_MPF && defined WITH_GMP
1084 ent_binop_register(ASE_BINARY_OP_QUO,
1085 BIGG_T, BIGF_T, ent_div_BIGG_T_COMPARABLE);
1086 ent_binop_register(ASE_BINARY_OP_QUO,
1087 BIGF_T, BIGG_T, ent_div_COMPARABLE_BIGG_T);
1089 #if defined HAVE_MPFR && defined WITH_MPFR
1090 ent_binop_register(ASE_BINARY_OP_QUO,
1091 BIGG_T, BIGFR_T, ent_div_BIGG_T_COMPARABLE);
1092 ent_binop_register(ASE_BINARY_OP_QUO,
1093 BIGFR_T, BIGG_T, ent_div_COMPARABLE_BIGG_T);
1096 ent_binop_register(ASE_BINARY_OP_QUO,
1097 BIGG_T, FLOAT_T, ent_div_BIGG_T_COMPARABLE);
1098 ent_binop_register(ASE_BINARY_OP_QUO,
1099 FLOAT_T, BIGG_T, ent_div_COMPARABLE_BIGG_T);
1102 ent_binop_register(ASE_BINARY_OP_REM,
1103 BIGG_T, BIGG_T, ent_rem_BIGG_T);
1104 ent_binop_register(ASE_BINARY_OP_MOD,
1105 BIGG_T, BIGG_T, ent_rem_BIGG_T);
1106 ent_binop_register(ASE_BINARY_OP_POW,
1107 BIGG_T, INT_T, ent_pow_BIGG_T_integer);
1108 ent_binop_register(ASE_BINARY_OP_POW,
1109 BIGG_T, BIGZ_T, ent_pow_BIGG_T_integer);
1113 ent_gaussian_unary_reltable_init(void)
1115 ent_unrel_register(ASE_UNARY_REL_ZEROP, BIGG_T, ent_gaussian_zerop);
1116 ent_unrel_register(ASE_UNARY_REL_ONEP, BIGG_T, ent_gaussian_onep);
1117 ent_unrel_register(ASE_UNARY_REL_UNITP, BIGG_T, ent_gaussian_unitp);
1121 ent_gaussian_binary_reltable_init(void)
1123 ent_binrel_register(ASE_BINARY_REL_EQUALP,
1124 BIGG_T, BIGG_T, ent_eq_bigg);
1125 ent_binrel_register(ASE_BINARY_REL_NEQP,
1126 BIGG_T, BIGG_T, ent_ne_bigg);
1130 ent_gaussian_lifttable_init(void)
1132 ent_lift_register(INT_T, BIGG_T, ent_lift_all_BIGG_T);
1133 ent_lift_register(BIGZ_T, BIGC_T, ent_lift_all_BIGG_T);
1134 #if defined HAVE_MPQ && defined WITH_GMP
1135 ent_lift_register(BIGQ_T, BIGG_T, ent_lift_all_BIGG_T);
1137 #if defined HAVE_MPF && defined WITH_GMP
1138 ent_lift_register(BIGF_T, BIGG_T, ent_lift_all_BIGG_T);
1140 #if defined HAVE_MPFR && defined WITH_MPFR
1141 ent_lift_register(BIGFR_T, BIGG_T, ent_lift_all_BIGG_T);
1144 ent_lift_register(FLOAT_T, BIGG_T, ent_lift_all_BIGG_T);
1146 #if defined HAVE_MPC && defined WITH_MPC || \
1147 defined HAVE_PSEUC && defined WITH_PSEUC
1148 ent_lift_register(BIGC_T, BIGG_T, ent_lift_BIGC_T_BIGG_T);
1152 void init_optables_BIGG_T(void)
1154 ent_gaussian_nullary_optable_init();
1155 ent_gaussian_unary_optable_init();
1156 ent_gaussian_binary_optable_init();
1157 ent_gaussian_unary_reltable_init();
1158 ent_gaussian_binary_reltable_init();
1159 ent_gaussian_lifttable_init();
1162 void init_ent_gaussian(void)
1164 bigg_init(ent_scratch_bigg);
1167 void syms_of_ent_gaussian(void)
1169 INIT_LRECORD_IMPLEMENTATION(bigg);
1171 DEFSUBR(Fmake_bigg);
1174 void vars_of_ent_gaussian(void)
1176 Fprovide(intern("bigg"));
1177 Fprovide(intern("gaussian"));