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 */
29 #include "ent-gaussian.h"
34 bigg ent_scratch_bigg;
35 static ase_nullary_operation_f Qent_gaussian_zero, Qent_gaussian_one;
39 bigg_print(Lisp_Object obj, Lisp_Object printcharfun, int SXE_UNUSED(escapeflag))
41 Bufbyte *fstr = bigg_to_string(XBIGG_DATA(obj), 10);
42 write_c_string((char*)fstr, printcharfun);
44 fstr = (Bufbyte *)NULL;
49 bigg_equal(Lisp_Object obj1, Lisp_Object obj2, int depth)
51 return bigg_eql(XBIGG_DATA(obj1), XBIGG_DATA(obj2));
58 bigg_hash(Lisp_Object obj, int depth)
60 return bigg_hashcode(XBIGG_DATA(obj));
67 bigg_mark(Lisp_Object obj)
76 bigg_finalise(void *header, int for_disksave)
80 ("Can't dump an emacs containing "
81 "pseudo-gaussian objects",Qt);
87 static const struct lrecord_description bigg_description[] = {
88 { XD_OPAQUE_DATA_PTR, offsetof(Lisp_Bigg, data) },
92 DEFINE_BASIC_LRECORD_IMPLEMENTATION("bigg", bigg,
93 bigg_mark, bigg_print, bigg_finalise,
94 bigg_equal, bigg_hash,
95 bigg_description, Lisp_Bigg);
97 DEFUN("make-bigg", Fmake_bigg, 2, 2, 0, /*
98 Return the Gaussian number whose rational component is REAL-PART
99 and whose imaginary component is IMAGINARY-PART.
101 (real_part, imaginary_part))
103 CHECK_COMPARABLE(real_part);
104 CHECK_COMPARABLE(imaginary_part);
107 Lisp_Object tmp_r = Fcoerce_number(real_part, Qbigz, Qnil);
108 Lisp_Object tmp_i = Fcoerce_number(imaginary_part, Qbigz, Qnil);
109 return make_bigg_bz(XBIGZ_DATA(tmp_r), XBIGZ_DATA(tmp_i));
114 /* basic functions */
115 void bigg_init(bigg g)
117 bigz_init(bigg_re(g));
118 bigz_init(bigg_im(g));
121 void bigg_fini(bigg g)
123 bigz_fini(bigg_re(g));
124 bigz_fini(bigg_im(g));
127 unsigned long bigg_hashcode(bigg g)
129 return (bigz_hashcode(bigg_re(g)) ^
130 bigz_hashcode(bigg_im(g)));
133 Bufbyte *bigg_to_string(bigg g, int base)
137 int intg_len, imag_len;
140 intg_str = (Bufbyte*)bigz_to_string(bigg_re(g), base);
141 imag_str = (Bufbyte*)bigz_to_string(bigg_im(g), base);
143 intg_len = strlen((char*)intg_str);
144 imag_len = strlen((char*)imag_str);
146 sign = bigz_sign(bigg_im(g));
147 neg = (sign >= 0) ? 1 : 0;
149 /* now append the imaginary string */
150 XREALLOC_ARRAY(intg_str, Bufbyte, intg_len + neg + imag_len + 2);
152 intg_str[intg_len] = '+';
153 memmove(&intg_str[intg_len + neg],
156 intg_str[intg_len+neg+imag_len] = 'i';
157 intg_str[intg_len+neg+imag_len+1] = '\0';
163 /***** Bigg: converting assignments *****/
164 void bigg_set(bigg g1,bigg g2)
166 bigz_set(bigg_re(g1), bigg_re(g2));
167 bigz_set(bigg_im(g1), bigg_im(g2));
170 void bigg_set_long(bigg g, long l)
172 bigz_set_long(bigg_re(g), l);
173 bigz_set_long(bigg_im(g), 0L);
176 void bigg_set_long_long(bigg g, long l1, long l2)
178 bigz_set_long(bigg_re(g), l1);
179 bigz_set_long(bigg_im(g), l2);
182 void bigg_set_ulong(bigg g, unsigned long ul)
184 bigz_set_ulong(bigg_re(g), ul);
185 bigz_set_ulong(bigg_im(g), 0UL);
188 void bigg_set_ulong_ulong(bigg g, unsigned long ul1, unsigned long ul2)
190 bigz_set_ulong(bigg_re(g), ul1);
191 bigz_set_ulong(bigg_im(g), ul2);
194 void bigg_set_bigz(bigg g, bigz z)
196 bigz_set(bigg_re(g), z);
197 bigz_set_long(bigg_im(g), 0L);
200 void bigg_set_bigz_bigz(bigg g, bigz z1, bigz z2)
202 bigz_set(bigg_re(g), z1);
203 bigz_set(bigg_im(g), z2);
206 /* void bigc_set_bigg(bigc c, bigg g)
208 * bigc_set_bigfr_bigfr(bigg_re(g), z1);
212 /***** Bigg: comparisons *****/
213 int bigg_eql(bigg g1, bigg g2)
215 return ((bigz_eql(bigg_re(g1), bigg_re(g2))) &&
216 (bigz_eql(bigg_im(g1), bigg_im(g2))));
219 /***** Bigg: arithmetic *****/
220 #if defined HAVE_MPFR && defined WITH_MPFR
221 void bigg_abs(bigfr res, bigg g)
223 /* the absolute archimedean valuation of a+bi is defined as:
226 bigz accu1, accu2, bz;
231 bigz_mul(accu1, bigg_re(g), bigg_re(g));
232 bigz_mul(accu2, bigg_im(g), bigg_im(g));
233 bigz_add(bz, accu1, accu2);
235 bigfr_set_bigz(res, bz);
236 bigfr_sqrt(res, res);
244 void bigg_norm(bigz res, bigg g)
246 /* norm is the square of the absolute archimedean valuation */
251 bigz_mul(accu1, bigg_re(g), bigg_re(g));
252 bigz_mul(accu2, bigg_im(g), bigg_im(g));
253 bigz_add(res, accu1, accu2);
259 void bigg_neg(bigg res, bigg g)
261 /* negation is defined point-wise */
262 bigz_neg(bigg_re(res), bigg_re(g));
263 bigz_neg(bigg_im(res), bigg_im(g));
266 void bigg_conj(bigg res, bigg g)
269 bigz_neg(bigg_im(res), bigg_im(res));
272 void bigg_add(bigg res, bigg g1, bigg g2)
274 /* addition is defined point-wise */
279 bigz_add(accu1, bigg_re(g1), bigg_re(g2));
280 bigz_add(accu2, bigg_im(g1), bigg_im(g2));
281 bigg_set_bigz_bigz(res, accu1, accu2);
287 void bigg_sub(bigg res, bigg g1, bigg g2)
289 /* subtraction is defined point-wise */
290 bigz_sub(bigg_re(res), bigg_re(g1), bigg_re(g2));
291 bigz_sub(bigg_im(res), bigg_im(g1), bigg_im(g2));
294 void bigg_mul(bigg res, bigg g1, bigg g2)
296 /* multiplication is defined as:
297 * (a + bi)*(c + di) = (ac - bd) + (ad + bc)i
299 bigz accu1, accu2, accu3, accu4;
305 bigz_mul(accu1, bigg_re(g1), bigg_re(g2));
306 bigz_mul(accu2, bigg_im(g1), bigg_im(g2));
307 bigz_mul(accu3, bigg_re(g1), bigg_im(g2));
308 bigz_mul(accu4, bigg_im(g1), bigg_re(g2));
310 bigz_sub(bigg_re(res), accu1, accu2);
311 bigz_add(bigg_im(res), accu3, accu4);
319 void bigg_div(bigg res, bigg g1, bigg g2)
321 /* division is defined as:
322 * (a + bi) div (c + di) = ((a+bi)*(c-di)) div (c*c+d*d)
330 /* compute: c^2 + d^2 */
331 bigz_mul(accu1, bigg_re(g2), bigg_re(g2));
332 bigz_mul(accu2, bigg_im(g2), bigg_im(g2));
333 bigz_add(accu1, accu1, accu2);
335 /* do normal multiplication with conjugate of g2 */
336 bigg_conj(accug, g2);
337 bigg_mul(accug, g1, accug);
339 bigg_set(res, accug);
341 /* now divide (g1*conj(g2)) by c^2+d^2 (point-wise) */
342 bigz_div(bigg_re(res), bigg_re(accug), accu1);
343 bigz_div(bigg_im(res), bigg_im(accug), accu1);
350 void bigg_mod(bigg res, bigg g1, bigg g2)
352 /* the modulo relation is defined as:
353 * (a + bi) mod (c + di) ~
354 * (a+bi) - ((a+bi) div (c-di)) * (c+di)
359 /* do normal division */
360 bigg_div(accug, g1, g2);
362 /* now re-multiply g2 */
363 bigg_mul(accug, accug, g2);
365 /* and find the difference */
366 bigg_sub(res, g1, accug);
371 void bigg_pow(bigg res, bigg g1, unsigned long g2)
373 #if defined(HAVE_MPZ) && defined(WITH_GMP)
375 bigz bin, resintg, resimag, tmpbz1, tmpbz2, tmpbz3, intg, imag;
386 bigz_set_long(resintg, 0L);
387 bigz_set_long(resimag, 0L);
389 bigz_set(intg, bigg_re(g1));
390 bigz_set(imag, bigg_im(g1));
392 /* we compute using the binomial coefficients */
393 for (i=0; i<=g2; i++) {
394 mpz_bin_uiui(bin, g2, i);
396 /* real part changes */
397 bigz_pow(tmpbz1, intg, g2-i);
398 bigz_pow(tmpbz2, imag, i);
399 bigz_mul(tmpbz3, tmpbz1, tmpbz2);
400 bigz_mul(bin, bin, tmpbz3);
402 bigz_add(resintg, resintg, bin);
403 } else if (i % 4 == 2) {
404 bigz_sub(resintg, resintg, bin);
407 /* imag part changes */
408 bigz_pow(tmpbz1, intg, g2-i);
409 bigz_pow(tmpbz2, imag, i);
410 bigz_mul(tmpbz3, tmpbz1, tmpbz2);
411 bigz_mul(bin, bin, tmpbz3);
413 bigz_add(resimag, resimag, bin);
414 } else if (i % 4 == 3) {
415 bigz_sub(resimag, resimag, bin);
420 bigg_set_bigz_bigz(res, resintg, resimag);
431 bigg_set_long_long(res, 0L, 0L);
435 Lisp_Object read_bigg_string(char *cp)
446 /* MPZ bigz_set_string has no effect
447 * with initial + sign */
454 /* jump over a leading minus */
458 while ((*cp >= '0' && *cp <= '9'))
461 /* MPZ cannot read numbers with characters after them.
462 * See limitations below in convert GMP-MPZ strings
466 bigz_set_string(bz_re, (char *)end, 0);
469 /* read the imaginary part */
479 if ((*cp == 'i' || *cp == 'I') && (sign == 1)) {
480 /* expand +i to +1i and -i to -1i */
481 bigz_set_long(bz_im, 1L);
482 } else if ((*cp == 'i' || *cp == 'I') && (sign == -1)) {
483 /* expand +i to +1i and -i to -1i */
484 bigz_set_long(bz_im, -1L);
485 } else if (sign == 0) {
486 /* obviously we did not have a+bi,
489 bigz_set(bz_im, bz_re);
490 bigz_set_long(bz_re, 0L);
495 while ((*cp >= '0' && *cp <= '9'))
499 bigz_set_string(bz_im, (char *)end, 0);
503 result = make_bigg_bz(bz_re, bz_im);
512 ent_gaussian_zerop(Lisp_Object o)
514 return (bigz_sign(bigg_re(XBIGG_DATA(o))) == 0 &&
515 bigz_sign(bigg_im(XBIGG_DATA(o))) == 0);
519 ent_gaussian_onep(Lisp_Object o)
521 return ((bigz_fits_long_p(bigg_re(XBIGG_DATA(o))) &&
522 bigz_to_long(bigg_re(XBIGG_DATA(o))) == 1L) &&
523 bigz_sign(bigg_im(XBIGG_DATA(o))) == 0);
527 ent_gaussian_unitp(Lisp_Object o)
529 return (!ent_gaussian_zerop(o) &&
530 (bigz_fits_long_p(bigg_re(XBIGG_DATA(o))) &&
531 (bigz_to_long(bigg_re(XBIGG_DATA(o))) == 0L ||
532 bigz_to_long(bigg_re(XBIGG_DATA(o))) == 1L ||
533 bigz_to_long(bigg_re(XBIGG_DATA(o))) == -1L)) &&
534 (bigz_fits_long_p(bigg_im(XBIGG_DATA(o))) &&
535 (bigz_to_long(bigg_im(XBIGG_DATA(o))) == 0L ||
536 bigz_to_long(bigg_im(XBIGG_DATA(o))) == 1L ||
537 bigz_to_long(bigg_im(XBIGG_DATA(o))) == -1L)));
540 static inline Lisp_Object
541 ent_sum_BIGG_T(Lisp_Object l, Lisp_Object r)
543 bigg_add(ent_scratch_bigg, XBIGG_DATA(l), XBIGG_DATA(r));
544 return make_bigg_bg(ent_scratch_bigg);
546 static inline Lisp_Object
547 ent_sum_BIGG_T_COMPARABLE(Lisp_Object l, Lisp_Object r)
551 r = ent_lift(r, BIGZ_T, NULL);
553 bigg_set_bigz(ent_scratch_bigg, XBIGZ_DATA(r));
554 bigg_add(ent_scratch_bigg, XBIGG_DATA(l), ent_scratch_bigg);
555 return make_bigg_bg(ent_scratch_bigg);
557 static inline Lisp_Object
558 ent_sum_COMPARABLE_BIGG_T(Lisp_Object l, Lisp_Object r)
562 l = ent_lift(l, BIGZ_T, NULL);
564 bigg_set_bigz(ent_scratch_bigg, XBIGZ_DATA(l));
565 bigg_add(ent_scratch_bigg, ent_scratch_bigg, XBIGG_DATA(r));
566 return make_bigg_bg(ent_scratch_bigg);
569 static inline Lisp_Object
570 ent_diff_BIGG_T(Lisp_Object l, Lisp_Object r)
572 bigg_sub(ent_scratch_bigg, XBIGG_DATA(l), XBIGG_DATA(r));
573 return make_bigg_bg(ent_scratch_bigg);
575 static inline Lisp_Object
576 ent_diff_BIGG_T_COMPARABLE(Lisp_Object l, Lisp_Object r)
580 r = ent_lift(r, BIGZ_T, NULL);
582 bigg_set_bigz(ent_scratch_bigg, XBIGZ_DATA(r));
583 bigg_sub(ent_scratch_bigg, XBIGG_DATA(l), ent_scratch_bigg);
584 return make_bigg_bg(ent_scratch_bigg);
586 static inline Lisp_Object
587 ent_diff_COMPARABLE_BIGG_T(Lisp_Object l, Lisp_Object r)
591 l = ent_lift(l, BIGZ_T, NULL);
593 bigg_set_bigz(ent_scratch_bigg, XBIGZ_DATA(l));
594 bigg_sub(ent_scratch_bigg, ent_scratch_bigg, XBIGG_DATA(r));
595 return make_bigg_bg(ent_scratch_bigg);
598 static inline Lisp_Object
599 ent_neg_BIGG_T(Lisp_Object l)
601 bigg_neg(ent_scratch_bigg, XBIGG_DATA(l));
602 return make_bigg_bg(ent_scratch_bigg);
605 static inline Lisp_Object
606 ent_prod_BIGG_T(Lisp_Object l, Lisp_Object r)
608 bigg_mul(ent_scratch_bigg, XBIGG_DATA(l), XBIGG_DATA(r));
609 return make_bigg_bg(ent_scratch_bigg);
611 static inline Lisp_Object
612 ent_prod_BIGG_T_COMPARABLE(Lisp_Object l, Lisp_Object r)
616 r = ent_lift(r, BIGZ_T, NULL);
618 bigg_set_bigz(ent_scratch_bigg, XBIGZ_DATA(r));
619 bigg_mul(ent_scratch_bigg, XBIGG_DATA(l), ent_scratch_bigg);
620 return make_bigg_bg(ent_scratch_bigg);
622 static inline Lisp_Object
623 ent_prod_COMPARABLE_BIGG_T(Lisp_Object l, Lisp_Object r)
627 l = ent_lift(l, BIGZ_T, NULL);
629 bigg_set_bigz(ent_scratch_bigg, XBIGZ_DATA(l));
630 bigg_mul(ent_scratch_bigg, ent_scratch_bigg, XBIGG_DATA(r));
631 return make_bigg_bg(ent_scratch_bigg);
634 static inline Lisp_Object
635 ent_div_BIGG_T(Lisp_Object l, Lisp_Object r)
637 if (ent_gaussian_zerop(r)) {
638 if (!ent_gaussian_zerop(l)) {
639 return make_indef(COMPLEX_INFINITY);
641 return make_indef(NOT_A_NUMBER);
644 bigg_div(ent_scratch_bigg, XBIGG_DATA(l), XBIGG_DATA(r));
645 return make_bigg_bg(ent_scratch_bigg);
647 static inline Lisp_Object
648 ent_div_BIGG_T_COMPARABLE(Lisp_Object l, Lisp_Object r)
652 if (ent_unrel_zerop(l)) {
653 if (!ent_gaussian_zerop(l)) {
654 return make_indef(COMPLEX_INFINITY);
656 return make_indef(NOT_A_NUMBER);
660 r = ent_lift(r, BIGZ_T, NULL);
662 bigg_set_bigz(ent_scratch_bigg, XBIGZ_DATA(r));
663 bigg_div(ent_scratch_bigg, XBIGG_DATA(l), ent_scratch_bigg);
664 return make_bigg_bg(ent_scratch_bigg);
666 static inline Lisp_Object
667 ent_div_COMPARABLE_BIGG_T(Lisp_Object l, Lisp_Object r)
671 if (ent_gaussian_zerop(r)) {
672 if (!ent_unrel_zerop(l)) {
673 return make_indef(COMPLEX_INFINITY);
675 return make_indef(NOT_A_NUMBER);
679 l = ent_lift(l, BIGZ_T, NULL);
681 bigg_set_bigz(ent_scratch_bigg, XBIGZ_DATA(l));
682 bigg_div(ent_scratch_bigg, ent_scratch_bigg, XBIGG_DATA(r));
683 return make_bigg_bg(ent_scratch_bigg);
686 #if defined HAVE_MPC && defined WITH_MPC || \
687 defined HAVE_PSEUC && defined WITH_PSEUC
688 static inline Lisp_Object
689 ent_quo_BIGG_T(Lisp_Object l, Lisp_Object r)
691 Lisp_Object tmp_l, tmp_r;
693 if (ent_gaussian_zerop(r)) {
694 if (!ent_gaussian_zerop(l)) {
695 return make_indef(COMPLEX_INFINITY);
697 return make_indef(NOT_A_NUMBER);
701 bigc_set_prec(ent_scratch_bigc, internal_get_precision(Qnil));
702 tmp_l = Fcoerce_number(l, Qbigc, Qnil);
703 tmp_r = Fcoerce_number(r, Qbigc, Qnil);
704 bigc_div(ent_scratch_bigc, XBIGC_DATA(tmp_l), XBIGC_DATA(tmp_r));
705 return make_bigc_bc(ent_scratch_bigc);
707 static inline Lisp_Object
708 ent_quo_BIGG_T_COMPARABLE(Lisp_Object l, Lisp_Object r)
712 if (ent_unrel_zerop(r)) {
713 if (!ent_gaussian_zerop(l)) {
714 return make_indef(COMPLEX_INFINITY);
716 return make_indef(NOT_A_NUMBER);
720 l = ent_lift(l, BIGC_T, NULL);
721 return ent_binop(ASE_BINARY_OP_QUO, l, r);
723 static inline Lisp_Object
724 ent_quo_COMPARABLE_BIGG_T(Lisp_Object l, Lisp_Object r)
728 if (ent_gaussian_zerop(r)) {
729 if (!ent_unrel_zerop(l)) {
730 return make_indef(COMPLEX_INFINITY);
732 return make_indef(NOT_A_NUMBER);
736 r = ent_lift(r, BIGC_T, NULL);
737 return ent_binop(ASE_BINARY_OP_QUO, l, r);
741 static inline Lisp_Object
742 ent_inv_BIGG_T(Lisp_Object r)
744 if (ent_gaussian_zerop(r)) {
745 return make_indef(COMPLEX_INFINITY);
747 bigg_div(ent_scratch_bigg,
748 XBIGG_DATA(Qent_gaussian_one), XBIGG_DATA(r));
749 return make_bigg_bg(ent_scratch_bigg);
751 static inline Lisp_Object
752 ent_rem_BIGG_T(Lisp_Object l, Lisp_Object r)
754 if (ent_gaussian_zerop(r)) {
755 return make_bigg(0, 0);
757 bigg_mod(ent_scratch_bigg, XBIGG_DATA(l), XBIGG_DATA(r));
758 return make_bigg_bg(ent_scratch_bigg);
760 static inline Lisp_Object
761 ent_pow_BIGG_T_integer(Lisp_Object l, Lisp_Object r)
763 long unsigned int expo = 0UL;
767 } else if (BIGZP(r)) {
768 if (bigz_fits_ulong_p(XBIGZ_DATA(r)))
769 expo = bigz_to_ulong(XBIGZ_DATA(r));
771 Fsignal(Qarith_error, r);
773 Fsignal(Qdomain_error, r);
775 bigg_pow(ent_scratch_bigg, XBIGG_DATA(l), expo);
776 return make_bigg_bg(ent_scratch_bigg);
781 ent_eq_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 ent_ne_bigg(Lisp_Object l, Lisp_Object r)
790 return !(bigz_eql(bigg_re(XBIGG_DATA(l)), bigg_re(XBIGG_DATA(r))) &&
791 bigz_eql(bigg_im(XBIGG_DATA(l)), bigg_im(XBIGG_DATA(r))));
795 static inline Lisp_Object
796 ent_vallt_BIGG_T(Lisp_Object l, Lisp_Object r)
802 bigg_norm(ent_scratch_bigz, XBIGG_DATA(l));
803 bigg_norm(b2, XBIGG_DATA(r));
804 result = bigz_lt(ent_scratch_bigz, b2);
807 return (result) ? Qt : Qnil;
809 static inline Lisp_Object
810 ent_valgt_BIGG_T(Lisp_Object l, Lisp_Object r)
816 bigg_norm(ent_scratch_bigz, XBIGG_DATA(l));
817 bigg_norm(b2, XBIGG_DATA(r));
818 result = bigz_gt(ent_scratch_bigz, b2);
821 return (result) ? Qt : Qnil;
823 static inline Lisp_Object
824 ent_valeq_BIGG_T(Lisp_Object l, Lisp_Object r)
830 bigg_norm(ent_scratch_bigz, XBIGG_DATA(l));
831 bigg_norm(b2, XBIGG_DATA(r));
832 result = bigz_eql(ent_scratch_bigz, b2);
835 return (result) ? Qt : Qnil;
837 static inline Lisp_Object
838 ent_valne_BIGG_T(Lisp_Object l, Lisp_Object r)
844 bigg_norm(ent_scratch_bigz, XBIGG_DATA(l));
845 bigg_norm(b2, XBIGG_DATA(r));
846 result = bigz_eql(ent_scratch_bigz, b2);
849 return (result) ? Qnil : Qt;
855 ent_lift_all_BIGG_T(Lisp_Object number, ent_lift_args_t SXE_UNUSED(la))
857 number = ent_lift(number, BIGZ_T, NULL);
858 bigg_set_bigz(ent_scratch_bigg, XBIGZ_DATA(number));
859 return make_bigg_bg(ent_scratch_bigg);
862 #if defined HAVE_MPC && defined WITH_MPC || \
863 defined HAVE_PSEUC && defined WITH_PSEUC
865 ent_lift_BIGC_T_BIGG_T(Lisp_Object number, ent_lift_args_t SXE_UNUSED(la))
869 re = Freal_part(number);
870 re = ent_lift(re, BIGZ_T, NULL);
871 im = Fimaginary_part(number);
872 im = ent_lift(im, BIGZ_T, NULL);
874 return make_bigg_bz(XBIGZ_DATA(re), XBIGZ_DATA(im));
880 ent_gaussian_nullary_optable_init(void)
882 Qent_gaussian_zero = make_bigg(0L, 0L);
883 Qent_gaussian_one = make_bigg(1L, 0L);
884 staticpro(&Qent_gaussian_zero);
885 staticpro(&Qent_gaussian_one);
887 ent_nullop_register(ASE_NULLARY_OP_ZERO, BIGG_T, Qent_gaussian_zero);
888 ent_nullop_register(ASE_NULLARY_OP_ONE, BIGG_T, Qent_gaussian_one);
892 ent_gaussian_unary_optable_init(void)
894 ent_unop_register(ASE_UNARY_OP_NEG, BIGG_T, ent_neg_BIGG_T);
895 ent_unop_register(ASE_UNARY_OP_INV, BIGG_T, ent_inv_BIGG_T);
899 ent_gaussian_binary_optable_init(void)
902 ent_binop_register(ASE_BINARY_OP_SUM,
903 BIGG_T, BIGG_T, ent_sum_BIGG_T);
904 ent_binop_register(ASE_BINARY_OP_SUM,
905 BIGG_T, INT_T, ent_sum_BIGG_T_COMPARABLE);
906 ent_binop_register(ASE_BINARY_OP_SUM,
907 INT_T, BIGG_T, ent_sum_COMPARABLE_BIGG_T);
908 #if defined HAVE_MPZ && (defined WITH_GMP || defined WITH_MP)
909 ent_binop_register(ASE_BINARY_OP_SUM,
910 BIGG_T, BIGZ_T, ent_sum_BIGG_T_COMPARABLE);
911 ent_binop_register(ASE_BINARY_OP_SUM,
912 BIGZ_T, BIGG_T, ent_sum_COMPARABLE_BIGG_T);
914 #if defined HAVE_MPQ && defined WITH_GMP
915 ent_binop_register(ASE_BINARY_OP_SUM,
916 BIGG_T, BIGQ_T, ent_sum_BIGG_T_COMPARABLE);
917 ent_binop_register(ASE_BINARY_OP_SUM,
918 BIGQ_T, BIGG_T, ent_sum_COMPARABLE_BIGG_T);
920 #if defined HAVE_MPF && defined WITH_GMP
921 ent_binop_register(ASE_BINARY_OP_SUM,
922 BIGG_T, BIGF_T, ent_sum_BIGG_T_COMPARABLE);
923 ent_binop_register(ASE_BINARY_OP_SUM,
924 BIGF_T, BIGG_T, ent_sum_COMPARABLE_BIGG_T);
926 #if defined HAVE_MPFR && defined WITH_MPFR
927 ent_binop_register(ASE_BINARY_OP_SUM,
928 BIGG_T, BIGFR_T, ent_sum_BIGG_T_COMPARABLE);
929 ent_binop_register(ASE_BINARY_OP_SUM,
930 BIGFR_T, BIGG_T, ent_sum_COMPARABLE_BIGG_T);
933 ent_binop_register(ASE_BINARY_OP_SUM,
934 BIGG_T, FLOAT_T, ent_sum_BIGG_T_COMPARABLE);
935 ent_binop_register(ASE_BINARY_OP_SUM,
936 FLOAT_T, BIGG_T, ent_sum_COMPARABLE_BIGG_T);
939 ent_binop_register(ASE_BINARY_OP_DIFF,
940 BIGG_T, BIGG_T, ent_diff_BIGG_T);
941 ent_binop_register(ASE_BINARY_OP_DIFF,
942 BIGG_T, INT_T, ent_diff_BIGG_T_COMPARABLE);
943 ent_binop_register(ASE_BINARY_OP_DIFF,
944 INT_T, BIGG_T, ent_diff_COMPARABLE_BIGG_T);
945 ent_binop_register(ASE_BINARY_OP_DIFF,
946 BIGG_T, BIGZ_T, ent_diff_BIGG_T_COMPARABLE);
947 ent_binop_register(ASE_BINARY_OP_DIFF,
948 BIGZ_T, BIGG_T, ent_diff_COMPARABLE_BIGG_T);
949 #if defined HAVE_MPQ && defined WITH_GMP
950 ent_binop_register(ASE_BINARY_OP_DIFF,
951 BIGG_T, BIGQ_T, ent_diff_BIGG_T_COMPARABLE);
952 ent_binop_register(ASE_BINARY_OP_DIFF,
953 BIGQ_T, BIGG_T, ent_diff_COMPARABLE_BIGG_T);
955 #if defined HAVE_MPF && defined WITH_GMP
956 ent_binop_register(ASE_BINARY_OP_DIFF,
957 BIGG_T, BIGF_T, ent_diff_BIGG_T_COMPARABLE);
958 ent_binop_register(ASE_BINARY_OP_DIFF,
959 BIGF_T, BIGG_T, ent_diff_COMPARABLE_BIGG_T);
961 #if defined HAVE_MPFR && defined WITH_MPFR
962 ent_binop_register(ASE_BINARY_OP_DIFF,
963 BIGG_T, BIGFR_T, ent_diff_BIGG_T_COMPARABLE);
964 ent_binop_register(ASE_BINARY_OP_DIFF,
965 BIGFR_T, BIGG_T, ent_diff_COMPARABLE_BIGG_T);
968 ent_binop_register(ASE_BINARY_OP_DIFF,
969 BIGG_T, FLOAT_T, ent_diff_BIGG_T_COMPARABLE);
970 ent_binop_register(ASE_BINARY_OP_DIFF,
971 FLOAT_T, BIGG_T, ent_diff_COMPARABLE_BIGG_T);
974 ent_binop_register(ASE_BINARY_OP_PROD,
975 BIGG_T, BIGG_T, ent_prod_BIGG_T);
976 ent_binop_register(ASE_BINARY_OP_PROD,
977 BIGG_T, INT_T, ent_prod_BIGG_T_COMPARABLE);
978 ent_binop_register(ASE_BINARY_OP_PROD,
979 INT_T, BIGG_T, ent_prod_COMPARABLE_BIGG_T);
980 ent_binop_register(ASE_BINARY_OP_PROD,
981 BIGG_T, BIGZ_T, ent_prod_BIGG_T_COMPARABLE);
982 ent_binop_register(ASE_BINARY_OP_PROD,
983 BIGZ_T, BIGG_T, ent_prod_COMPARABLE_BIGG_T);
984 #if defined HAVE_MPQ && defined WITH_GMP
985 ent_binop_register(ASE_BINARY_OP_PROD,
986 BIGG_T, BIGQ_T, ent_prod_BIGG_T_COMPARABLE);
987 ent_binop_register(ASE_BINARY_OP_PROD,
988 BIGQ_T, BIGG_T, ent_prod_COMPARABLE_BIGG_T);
990 #if defined HAVE_MPF && defined WITH_GMP
991 ent_binop_register(ASE_BINARY_OP_PROD,
992 BIGG_T, BIGF_T, ent_prod_BIGG_T_COMPARABLE);
993 ent_binop_register(ASE_BINARY_OP_PROD,
994 BIGF_T, BIGG_T, ent_prod_COMPARABLE_BIGG_T);
996 #if defined HAVE_MPFR && defined WITH_MPFR
997 ent_binop_register(ASE_BINARY_OP_PROD,
998 BIGG_T, BIGFR_T, ent_prod_BIGG_T_COMPARABLE);
999 ent_binop_register(ASE_BINARY_OP_PROD,
1000 BIGFR_T, BIGG_T, ent_prod_COMPARABLE_BIGG_T);
1003 ent_binop_register(ASE_BINARY_OP_PROD,
1004 BIGG_T, FLOAT_T, ent_prod_BIGG_T_COMPARABLE);
1005 ent_binop_register(ASE_BINARY_OP_PROD,
1006 FLOAT_T, BIGG_T, ent_prod_COMPARABLE_BIGG_T);
1009 /* divisions and quotients */
1010 ent_binop_register(ASE_BINARY_OP_DIV,
1011 BIGG_T, BIGG_T, ent_div_BIGG_T);
1012 ent_binop_register(ASE_BINARY_OP_DIV,
1013 BIGG_T, INT_T, ent_div_BIGG_T_COMPARABLE);
1014 ent_binop_register(ASE_BINARY_OP_DIV,
1015 INT_T, BIGG_T, ent_div_COMPARABLE_BIGG_T);
1016 ent_binop_register(ASE_BINARY_OP_DIV,
1017 BIGG_T, BIGZ_T, ent_div_BIGG_T_COMPARABLE);
1018 ent_binop_register(ASE_BINARY_OP_DIV,
1019 BIGZ_T, BIGG_T, ent_div_COMPARABLE_BIGG_T);
1020 #if defined HAVE_MPQ && defined WITH_GMP
1021 ent_binop_register(ASE_BINARY_OP_DIV,
1022 BIGG_T, BIGQ_T, ent_div_BIGG_T_COMPARABLE);
1023 ent_binop_register(ASE_BINARY_OP_DIV,
1024 BIGQ_T, BIGG_T, ent_div_COMPARABLE_BIGG_T);
1026 #if defined HAVE_MPF && defined WITH_GMP
1027 ent_binop_register(ASE_BINARY_OP_DIV,
1028 BIGG_T, BIGF_T, ent_div_BIGG_T_COMPARABLE);
1029 ent_binop_register(ASE_BINARY_OP_DIV,
1030 BIGF_T, BIGG_T, ent_div_COMPARABLE_BIGG_T);
1032 #if defined HAVE_MPFR && defined WITH_MPFR
1033 ent_binop_register(ASE_BINARY_OP_DIV,
1034 BIGG_T, BIGFR_T, ent_div_BIGG_T_COMPARABLE);
1035 ent_binop_register(ASE_BINARY_OP_DIV,
1036 BIGFR_T, BIGG_T, ent_div_COMPARABLE_BIGG_T);
1039 ent_binop_register(ASE_BINARY_OP_DIV,
1040 BIGG_T, FLOAT_T, ent_div_BIGG_T_COMPARABLE);
1041 ent_binop_register(ASE_BINARY_OP_DIV,
1042 FLOAT_T, BIGG_T, ent_div_COMPARABLE_BIGG_T);
1045 #if defined HAVE_MPC && defined WITH_MPC || \
1046 defined HAVE_PSEUC && defined WITH_PSEUC
1047 ent_binop_register(ASE_BINARY_OP_QUO,
1048 BIGG_T, BIGG_T, ent_quo_BIGG_T);
1049 ent_binop_register(ASE_BINARY_OP_QUO,
1050 BIGG_T, BIGZ_T, ent_quo_BIGG_T_COMPARABLE);
1051 ent_binop_register(ASE_BINARY_OP_QUO,
1052 BIGZ_T, BIGG_T, ent_quo_COMPARABLE_BIGG_T);
1053 #if defined HAVE_MPQ && defined WITH_GMP
1054 ent_binop_register(ASE_BINARY_OP_QUO,
1055 BIGG_T, BIGQ_T, ent_quo_BIGG_T_COMPARABLE);
1056 ent_binop_register(ASE_BINARY_OP_QUO,
1057 BIGQ_T, BIGG_T, ent_quo_COMPARABLE_BIGG_T);
1059 #if defined HAVE_MPF && defined WITH_GMP
1060 ent_binop_register(ASE_BINARY_OP_QUO,
1061 BIGG_T, BIGF_T, ent_quo_BIGG_T_COMPARABLE);
1062 ent_binop_register(ASE_BINARY_OP_QUO,
1063 BIGF_T, BIGG_T, ent_quo_COMPARABLE_BIGG_T);
1065 #if defined HAVE_MPFR && defined WITH_MPFR
1066 ent_binop_register(ASE_BINARY_OP_QUO,
1067 BIGG_T, BIGFR_T, ent_quo_BIGG_T_COMPARABLE);
1068 ent_binop_register(ASE_BINARY_OP_QUO,
1069 BIGFR_T, BIGG_T, ent_quo_COMPARABLE_BIGG_T);
1072 ent_binop_register(ASE_BINARY_OP_QUO,
1073 BIGG_T, FLOAT_T, ent_quo_BIGG_T_COMPARABLE);
1074 ent_binop_register(ASE_BINARY_OP_QUO,
1075 FLOAT_T, BIGG_T, ent_quo_COMPARABLE_BIGG_T);
1077 #else /* !HAVE_MPC */
1078 ent_binop_register(ASE_BINARY_OP_QUO,
1079 BIGG_T, BIGG_T, ent_div_BIGG_T);
1080 ent_binop_register(ASE_BINARY_OP_QUO,
1081 BIGG_T, BIGZ_T, ent_div_BIGG_T_COMPARABLE);
1082 ent_binop_register(ASE_BINARY_OP_QUO,
1083 BIGZ_T, BIGG_T, ent_div_COMPARABLE_BIGG_T);
1084 #if defined HAVE_MPQ && defined WITH_GMP
1085 ent_binop_register(ASE_BINARY_OP_QUO,
1086 BIGG_T, BIGQ_T, ent_div_BIGG_T_COMPARABLE);
1087 ent_binop_register(ASE_BINARY_OP_QUO,
1088 BIGQ_T, BIGG_T, ent_div_COMPARABLE_BIGG_T);
1090 #if defined HAVE_MPF && defined WITH_GMP
1091 ent_binop_register(ASE_BINARY_OP_QUO,
1092 BIGG_T, BIGF_T, ent_div_BIGG_T_COMPARABLE);
1093 ent_binop_register(ASE_BINARY_OP_QUO,
1094 BIGF_T, BIGG_T, ent_div_COMPARABLE_BIGG_T);
1096 #if defined HAVE_MPFR && defined WITH_MPFR
1097 ent_binop_register(ASE_BINARY_OP_QUO,
1098 BIGG_T, BIGFR_T, ent_div_BIGG_T_COMPARABLE);
1099 ent_binop_register(ASE_BINARY_OP_QUO,
1100 BIGFR_T, BIGG_T, ent_div_COMPARABLE_BIGG_T);
1103 ent_binop_register(ASE_BINARY_OP_QUO,
1104 BIGG_T, FLOAT_T, ent_div_BIGG_T_COMPARABLE);
1105 ent_binop_register(ASE_BINARY_OP_QUO,
1106 FLOAT_T, BIGG_T, ent_div_COMPARABLE_BIGG_T);
1109 ent_binop_register(ASE_BINARY_OP_REM,
1110 BIGG_T, BIGG_T, ent_rem_BIGG_T);
1111 ent_binop_register(ASE_BINARY_OP_MOD,
1112 BIGG_T, BIGG_T, ent_rem_BIGG_T);
1113 ent_binop_register(ASE_BINARY_OP_POW,
1114 BIGG_T, INT_T, ent_pow_BIGG_T_integer);
1115 ent_binop_register(ASE_BINARY_OP_POW,
1116 BIGG_T, BIGZ_T, ent_pow_BIGG_T_integer);
1120 ent_gaussian_unary_reltable_init(void)
1122 ent_unrel_register(ASE_UNARY_REL_ZEROP, BIGG_T, ent_gaussian_zerop);
1123 ent_unrel_register(ASE_UNARY_REL_ONEP, BIGG_T, ent_gaussian_onep);
1124 ent_unrel_register(ASE_UNARY_REL_UNITP, BIGG_T, ent_gaussian_unitp);
1128 ent_gaussian_binary_reltable_init(void)
1130 ent_binrel_register(ASE_BINARY_REL_EQUALP,
1131 BIGG_T, BIGG_T, ent_eq_bigg);
1132 ent_binrel_register(ASE_BINARY_REL_NEQP,
1133 BIGG_T, BIGG_T, ent_ne_bigg);
1137 ent_gaussian_lifttable_init(void)
1139 ent_lift_register(INT_T, BIGG_T, ent_lift_all_BIGG_T);
1140 ent_lift_register(BIGZ_T, BIGC_T, ent_lift_all_BIGG_T);
1141 #if defined HAVE_MPQ && defined WITH_GMP
1142 ent_lift_register(BIGQ_T, BIGG_T, ent_lift_all_BIGG_T);
1144 #if defined HAVE_MPF && defined WITH_GMP
1145 ent_lift_register(BIGF_T, BIGG_T, ent_lift_all_BIGG_T);
1147 #if defined HAVE_MPFR && defined WITH_MPFR
1148 ent_lift_register(BIGFR_T, BIGG_T, ent_lift_all_BIGG_T);
1151 ent_lift_register(FLOAT_T, BIGG_T, ent_lift_all_BIGG_T);
1153 #if defined HAVE_MPC && defined WITH_MPC || \
1154 defined HAVE_PSEUC && defined WITH_PSEUC
1155 ent_lift_register(BIGC_T, BIGG_T, ent_lift_BIGC_T_BIGG_T);
1159 void init_optables_BIGG_T(void)
1161 ent_gaussian_nullary_optable_init();
1162 ent_gaussian_unary_optable_init();
1163 ent_gaussian_binary_optable_init();
1164 ent_gaussian_unary_reltable_init();
1165 ent_gaussian_binary_reltable_init();
1166 ent_gaussian_lifttable_init();
1169 void init_ent_gaussian(void)
1171 bigg_init(ent_scratch_bigg);
1174 void syms_of_ent_gaussian(void)
1176 INIT_LRECORD_IMPLEMENTATION(bigg);
1178 DEFSUBR(Fmake_bigg);
1181 void vars_of_ent_gaussian(void)
1183 Fprovide(intern("bigg"));
1184 Fprovide(intern("gaussian"));