1 /*** ase-resclass.c -- Residue Class Rings for SXEmacs
3 * Copyright (C) 2006 - 2008 Sebastian Freundt
5 * Author: Sebastian Freundt <hroptatyr@sxemacs.org>
7 * This file is part of SXEmacs.
9 * Redistribution and use in source and binary forms, with or without
10 * modification, are permitted provided that the following conditions
13 * 1. Redistributions of source code must retain the above copyright
14 * notice, this list of conditions and the following disclaimer.
16 * 2. Redistributions in binary form must reproduce the above copyright
17 * notice, this list of conditions and the following disclaimer in the
18 * documentation and/or other materials provided with the distribution.
20 * 3. Neither the name of the author nor the names of any contributors
21 * may be used to endorse or promote products derived from this
22 * software without specific prior written permission.
24 * THIS SOFTWARE IS PROVIDED BY THE AUTHOR "AS IS" AND ANY EXPRESS OR
25 * IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
26 * WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
27 * DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE
28 * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
29 * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
30 * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR
31 * BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
32 * WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE
33 * OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN
34 * IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
38 /* Synched up with: Not in FSF. */
43 #include "ase-resclass.h"
45 #define EMOD_ASE_DEBUG_RESC(args...) EMOD_ASE_DEBUG("[RESC]: " args)
47 PROVIDE(ase_resclass);
48 REQUIRE(ase_resclass, "ase");
50 Lisp_Object Qase_resclass;
51 Lisp_Object Qase_resc_rng, Qase_resc_rng_p, Qase_resc_elm, Qase_resc_elm_p;
52 static int sane_small;
55 static ase_nullary_operation_f Qase_resclass_zero, Qase_resclass_one;
60 _resc_rng_buffer_size(ase_resc_rng_t a)
62 /* returns a sane size for buffer allocation */
63 #if defined HAVE_MPZ && (defined WITH_GMP || defined WITH_MP)
64 if (ase_resc_rng_smallp(a))
67 return (mpz_sizeinbase(ase_resc_rng_ring(a), 10) + 7) & -3;
74 _ase_resc_rng_to_string(char *buf, int len, ase_resc_rng_t a)
76 if (ase_resc_rng_smallp(a))
77 snprintf(buf, len, "%ld", a->small_ring);
79 resc_rng_to_string(buf, len, ase_resc_rng_ring(a));
84 _ase_resc_rng_prnt(ase_resc_rng_t a, Lisp_Object pcf)
86 int sane_sz = sizeof(char)*_resc_rng_buffer_size(a);
87 char *fstr = alloca(sane_sz);
88 _ase_resc_rng_to_string(fstr, sane_sz, a);
89 write_c_string("Z/", pcf);
90 write_c_string(fstr, pcf);
91 write_c_string("Z", pcf);
96 ase_resc_rng_prnt(Lisp_Object obj, Lisp_Object pcf, int unused)
98 EMOD_ASE_DEBUG_RESC("i:0x%016lx@0x%016lx (rc:%d)\n",
99 (long unsigned int)(XASE_RESC_RNG(obj)),
100 (long unsigned int)obj, 1);
101 write_c_string("#<", pcf);
102 print_internal(XDYNACAT_TYPE(obj), pcf, unused);
103 write_c_string(" ", pcf);
104 _ase_resc_rng_prnt(XASE_RESC_RNG(obj), pcf);
105 if (XASE_RESC_RNG_SMALLP(obj))
106 write_c_string(", small", pcf);
107 write_c_string(">", pcf);
111 _resc_elm_buffer_size(ase_resc_elm_t a)
113 /* returns a sane size for buffer allocation */
114 #if defined HAVE_MPZ && (defined WITH_GMP || defined WITH_MP)
115 if (ase_resc_rng_smallp(a))
118 return (mpz_sizeinbase(ase_resc_elm_data(a), 10) + 7) & -3;
125 _ase_resc_elm_to_string(char *buf, int len, ase_resc_elm_t a)
127 if (ase_resc_elm_smallp(a))
128 snprintf(buf, len, "%ld", a->small_data);
130 resc_elm_to_string(buf, len, ase_resc_elm_data(a));
135 _ase_resc_elm_prnt(ase_resc_elm_t a, Lisp_Object pcf)
137 int sane_sz_rng = sizeof(char)*_resc_rng_buffer_size(
138 XASE_RESC_RNG(ase_resc_elm_ring(a)));
139 int sane_sz_elm = sizeof(char)*_resc_elm_buffer_size(a);
140 char *rng_str = alloca(sane_sz_rng);
141 char *elm_str = alloca(sane_sz_elm);
143 _ase_resc_rng_to_string(rng_str, sane_sz_rng,
144 XASE_RESC_RNG(ase_resc_elm_ring(a)));
145 _ase_resc_elm_to_string(elm_str, sane_sz_elm, a);
147 write_c_string(elm_str, pcf);
148 write_c_string("+", pcf);
149 write_c_string(rng_str, pcf);
150 write_c_string("Z", pcf);
155 ase_resc_elm_prnt(Lisp_Object obj, Lisp_Object pcf, int unused)
157 EMOD_ASE_DEBUG_RESC("i:0x%016lx@0x%016lx (rc:%d)\n",
158 (long unsigned int)(XASE_RESC_ELM(obj)),
159 (long unsigned int)obj, 1);
160 write_c_string("#<", pcf);
161 print_internal(XDYNACAT_TYPE(obj), pcf, unused);
162 write_c_string(" ", pcf);
163 _ase_resc_elm_prnt(XASE_RESC_ELM(obj), pcf);
164 if (XASE_RESC_ELM_SMALLP(obj))
165 write_c_string(", small", pcf);
166 write_c_string(">", pcf);
169 /* stuff for the dynacat, markers */
171 _ase_resc_rng_mark(ase_resc_rng_t a)
179 ase_resc_rng_mark(Lisp_Object obj)
181 EMOD_ASE_DEBUG_RESC("i:0x%016lx@0x%016lx (rc:%d) shall be marked...\n",
182 (long unsigned int)(XASE_RESC_RNG(obj)),
183 (long unsigned int)obj, 1);
184 _ase_resc_rng_mark(XASE_RESC_RNG(obj));
189 _ase_resc_elm_mark(ase_resc_elm_t a)
191 mark_object(ase_resc_elm_ring(a));
195 ase_resc_elm_mark(Lisp_Object obj)
197 EMOD_ASE_DEBUG_RESC("i:0x%016lx@0x%016lx (rc:%d) shall be marked...\n",
198 (long unsigned int)(XASE_RESC_ELM(obj)),
199 (long unsigned int)obj, 1);
200 _ase_resc_elm_mark(XASE_RESC_ELM(obj));
204 /* stuff for the dynacat, finalisers */
206 _ase_resc_rng_fini(ase_resc_rng_t a)
208 if (!ase_resc_rng_smallp(a))
209 resc_rng_fini(ase_resc_rng_ring(a));
214 ase_resc_rng_fini(Lisp_Object obj, int unused)
216 ase_resc_rng_t a = XASE_RESC_RNG(obj);
218 EMOD_ASE_DEBUG_GC("i:0x%016lx@0x%016lx (rc:%d) shall be freed...\n",
219 (long unsigned int)(a), obj, 1);
221 _ase_resc_rng_fini(a);
227 _ase_resc_elm_fini(ase_resc_elm_t a)
229 if (!ase_resc_elm_smallp(a))
230 resc_elm_fini(ase_resc_elm_data(a));
235 ase_resc_elm_fini(Lisp_Object obj, int unused)
237 ase_resc_elm_t a = XASE_RESC_ELM(obj);
239 EMOD_ASE_DEBUG_GC("i:0x%016lx@0x%016lx (rc:%d) shall be freed...\n",
240 (long unsigned int)(a), obj, 1);
242 _ase_resc_elm_fini(a);
248 static inline Lisp_Object
249 _ase_wrap_resc_rng(ase_resc_rng_t a)
253 result = make_dynacat(a);
254 XDYNACAT(result)->type = Qase_resc_rng;
258 ase_interval_incref(a);
261 set_dynacat_printer(result, ase_resc_rng_prnt);
262 set_dynacat_marker(result, ase_resc_rng_mark);
263 set_dynacat_finaliser(result, ase_resc_rng_fini);
264 set_dynacat_intprinter(
265 result, (dynacat_intprinter_f)_ase_resc_rng_prnt);
267 EMOD_ASE_DEBUG_RESC("i:0x%016lx (rc:%d) "
268 "shall be wrapped to 0x%016lx...\n",
269 (long unsigned int)a, 1,
270 (long unsigned int)result);
276 _ase_make_resc_rng(Lisp_Object modulus)
278 ase_resc_rng_t a = xnew(struct ase_resc_rng_s);
282 a->small_ring = XINT(modulus);
283 #if defined HAVE_MPZ && (defined WITH_GMP || defined WITH_MP)
284 } else if (BIGZP(modulus)) {
286 resc_rng_init(ase_resc_rng_ring(a));
287 resc_rng_set_bigz(ase_resc_rng_ring(a), XBIGZ_DATA(modulus));
291 EMOD_ASE_DEBUG_RESC("i:0x%016lx (rc:0) shall be created...\n",
292 (long unsigned int)a);
296 /* specialised versions for the lisp reader */
297 static inline ase_resc_rng_t
298 __ase_make_resc_rng_eint(EMACS_INT modulus)
300 ase_resc_rng_t a = xnew(struct ase_resc_rng_s);
303 a->small_ring = modulus;
304 EMOD_ASE_DEBUG_RESC("i:0x%016lx (rc:0) shall be created...\n",
305 (long unsigned int)a);
308 #if defined HAVE_MPZ && (defined WITH_GMP || defined WITH_MP)
309 static inline ase_resc_rng_t
310 __ase_make_resc_rng_bigz(resc_rng modulus)
312 ase_resc_rng_t a = xnew(struct ase_resc_rng_s);
316 EMOD_ASE_DEBUG_RESC("i:0x%016lx (rc:0) shall be created...\n",
317 (long unsigned int)a);
323 ase_make_resc_rng(Lisp_Object modulus)
325 ase_resc_rng_t a = NULL;
326 Lisp_Object result = Qnil;
328 a = _ase_make_resc_rng(modulus);
329 XSETASE_RESC_RNG(result, a);
335 _ase_wrap_resc_elm(ase_resc_elm_t a)
339 result = make_dynacat(a);
340 XDYNACAT(result)->type = Qase_resc_elm;
344 ase_interval_incref(a);
347 set_dynacat_printer(result, ase_resc_elm_prnt);
348 set_dynacat_marker(result, ase_resc_elm_mark);
349 set_dynacat_finaliser(result, ase_resc_elm_fini);
350 set_dynacat_intprinter(
351 result, (dynacat_intprinter_f)_ase_resc_elm_prnt);
353 EMOD_ASE_DEBUG_RESC("i:0x%016lx (rc:%d) "
354 "shall be wrapped to 0x%016lx...\n",
355 (long unsigned int)a, 1,
356 (long unsigned int)result);
362 _ase_resc_elm_canonicalise_small(ase_resc_elm_t a)
364 if ((a->small_data = a->small_data %
365 XASE_RESC_RNG(ase_resc_elm_ring(a))->small_ring) < 0)
367 XASE_RESC_RNG(ase_resc_elm_ring(a))->small_ring;
370 #if defined HAVE_MPZ && (defined WITH_GMP || defined WITH_MP)
372 _ase_resc_elm_canonicalise_big(ase_resc_elm_t a)
374 bigz_mod(ase_resc_elm_data(a), ase_resc_elm_data(a),
375 XASE_RESC_RNG_RING(ase_resc_elm_ring(a)));
380 _ase_resc_elm_canonicalise(ase_resc_elm_t a)
382 #if defined HAVE_MPZ && (defined WITH_GMP || defined WITH_MP)
383 if (LIKELY(ase_resc_elm_smallp(a))) {
384 _ase_resc_elm_canonicalise_small(a);
386 _ase_resc_elm_canonicalise_big(a);
389 ase_resc_elm_sdata(a) =
390 ase_resc_elm_sdata(a) %
391 XASE_RESC_RNG_SRING(ase_resc_elm_ring(a));
397 _ase_make_resc_elm(Lisp_Object class, Lisp_Object ring)
399 ase_resc_elm_t a = xnew(struct ase_resc_elm_s);
401 ase_resc_elm_ring(a) = ring;
403 if (!(a->smallp = XASE_RESC_RNG(ring)->smallp)) {
404 resc_elm_init(ase_resc_elm_data(a));
407 EMOD_ASE_DEBUG_RESC("i:0x%016lx (rc:0) shall be created...\n",
408 (long unsigned int)a);
410 if (INTP(class) && a->smallp) {
411 a->small_data = XINT(class);
412 } else if (INTP(class)) {
413 resc_elm_set_eint(ase_resc_elm_data(a), XINT(class));
414 #if defined HAVE_MPZ && (defined WITH_GMP || defined WITH_MP)
415 } else if (BIGZP(class) && a->smallp) {
416 Lisp_Object newcl = _ent_binop(
419 INT_T, make_int(XASE_RESC_RNG(ring)->small_ring));
420 a->small_data = XINT(newcl);
422 } else if (BIGZP(class)) {
423 resc_elm_set_bigz(ase_resc_elm_data(a),
428 _ase_resc_elm_canonicalise(a);
432 /* specialised versions for the lisp reader */
433 static ase_resc_elm_t
434 __ase_make_resc_elm_eint(EMACS_INT class)
436 ase_resc_elm_t a = xnew(struct ase_resc_elm_s);
439 a->small_data = class;
440 EMOD_ASE_DEBUG_RESC("i:%p (rc:0) shall be created...\n", a);
443 #if defined HAVE_MPZ && (defined WITH_GMP || defined WITH_MP)
444 static ase_resc_elm_t
445 __ase_make_resc_elm_bigz(resc_elm class)
447 ase_resc_elm_t a = xnew(struct ase_resc_elm_s);
451 EMOD_ASE_DEBUG_RESC("i:%p (rc:0) shall be created...\n", a);
457 ase_make_resc_elm(Lisp_Object class, Lisp_Object ring)
459 ase_resc_elm_t a = NULL;
460 Lisp_Object result = Qnil;
462 a = _ase_make_resc_elm(class, ring);
463 XSETASE_RESC_ELM(result, a);
469 /* basic functions */
470 /* read a resclass off the wire */
471 /* the next 4 funs are hooked in the lisp reader (lread.c) */
473 ase_resc_rng_from_string(char *cp)
475 ase_resc_rng_t r = NULL;
478 EMACS_INT small_ring;
487 while ((*cp >= '0' && *cp <= '9'))
490 /* MPZ cannot read numbers with characters after them.
491 * See limitations of GMP-MPZ strings
496 small_ring = strtol(start, &tail, 10);
498 r = __ase_make_resc_rng_eint(small_ring);
499 #if defined HAVE_MPZ && (defined WITH_GMP || defined WITH_MP)
500 } else if (errno == ERANGE) {
503 resc_rng_set_string(ring, start);
504 r = __ase_make_resc_rng_bigz(ring);
511 /* generate and return the ring */
512 return _ase_wrap_resc_rng(r);
516 ase_resc_elm_from_string(char *cp)
518 ase_resc_elm_t e = NULL;
519 ase_resc_rng_t r = NULL;
522 EMACS_INT small_ring;
525 /* MPZ bigz_set_string has no effect
526 * with initial + sign */
533 /* jump over a leading minus */
537 while ((*cp >= '0' && *cp <= '9'))
540 /* MPZ cannot read numbers with characters after them.
541 * See limitations of GMP-MPZ strings
546 small_elm = strtol(start, &tail, 10);
548 e = __ase_make_resc_elm_eint(small_elm);
549 #if defined HAVE_MPZ && (defined WITH_GMP || defined WITH_MP)
550 } else if (errno == ERANGE) {
553 resc_elm_set_string(elm, start);
554 e = __ase_make_resc_elm_bigz(elm);
561 /* read the modulus */
565 while ((*cp >= '0' && *cp <= '9'))
570 small_ring = strtol(start, &tail, 10);
572 r = __ase_make_resc_rng_eint(small_ring);
573 #if defined HAVE_MPZ && (defined WITH_GMP || defined WITH_MP)
574 } else if (errno == ERANGE) {
577 resc_rng_set_string(ring, start);
578 r = __ase_make_resc_rng_bigz(ring);
585 /* now we have 4 possibilites: */
586 if (e->smallp && r->smallp) {
587 e->ring = _ase_wrap_resc_rng(r);
588 _ase_resc_elm_canonicalise_small(e);
589 return _ase_wrap_resc_elm(e);
590 #if defined HAVE_MPZ && (defined WITH_GMP || defined WITH_MP)
591 } else if (e->smallp) {
592 /* the class is small, the ring is not,
593 * thus we have to promote the class now */
594 resc_elm_init(ase_resc_elm_data(e));
595 resc_elm_set_eint(ase_resc_elm_data(e), e->small_data);
597 e->ring = _ase_wrap_resc_rng(r);
598 _ase_resc_elm_canonicalise_big(e);
599 return _ase_wrap_resc_elm(e);
600 } else if (r->smallp) {
601 /* we're in deep shit, the class is bigz, the ring is small
602 * and to make it worse, we can't use the ENT mod table */
603 bigz_set_long(ent_scratch_bigz, r->small_ring);
604 bigz_mod(ent_scratch_bigz,
605 ase_resc_elm_data(e), ent_scratch_bigz);
606 /* now ent_scratch_bigz should fit into a long */
607 e->small_data = bigz_to_long(ent_scratch_bigz);
609 /* finish the temporarily assigned big data slot */
610 resc_elm_fini(ase_resc_elm_data(e));
611 e->ring = _ase_wrap_resc_rng(r);
612 /* no need to canonicalise */
613 return _ase_wrap_resc_elm(e);
615 /* phew, finally an easy case */
616 e->ring = _ase_wrap_resc_rng(r);
617 _ase_resc_elm_canonicalise_big(e);
618 return _ase_wrap_resc_elm(e);
629 /* for complex numbers */
630 #define INTERMEDIATE_UNARY_SYMBOL 32
632 #define DOT_CHAR2 128
633 #define TRAIL_INT2 256
635 #define EXP_INT2 1024
641 ase_resc_rng_string_p(const char *cp)
644 const Bufbyte *ucp = (const Bufbyte *)cp;
647 /* parse the residue class */
649 if (*ucp++ == 'Z' && *ucp++ == '/')
652 /* check if we had a int number until here */
653 if (!(state == (LEAD_Z)))
656 /* now look for the modulus */
658 if (*ucp >= '1' && *ucp <= '9') {
660 while (*ucp >= '0' && *ucp <= '9')
667 return (((*ucp == 0) || (*ucp == ' ') || (*ucp == '\t') ||
668 (*ucp == '\n') || (*ucp == '\r') || (*ucp == '\f')) &&
669 (state == (LEAD_INT2 | Z_CHAR)));
673 ase_resc_elm_string_p(const char *cp)
676 const Bufbyte *ucp = (const Bufbyte *)cp;
679 /* parse the residue class */
681 if (*ucp == '+' || *ucp == '-')
684 if (*ucp >= '0' && *ucp <= '9') {
686 while (*ucp >= '0' && *ucp <= '9')
690 /* check if we had a int number until here */
691 if (!(state == (LEAD_INT)))
694 /* now look for the residue class ring */
697 state |= INTERMEDIATE_UNARY_SYMBOL;
701 if (*ucp >= '1' && *ucp <= '9') {
703 while (*ucp >= '0' && *ucp <= '9')
710 return (((*ucp == 0) || (*ucp == ' ') || (*ucp == '\t') ||
711 (*ucp == '\n') || (*ucp == '\r') || (*ucp == '\f')) &&
712 (state == (INTERMEDIATE_UNARY_SYMBOL | LEAD_INT2 | Z_CHAR)));
718 ent_intersection_factor_module(Lisp_Object *l, Lisp_Object *r)
720 Lisp_Object result_ring;
722 /* return a resulting ring by intersection of the rings in l and r and
723 * coerce l and r to that ring.
726 if (!bigz_eql(XRESC_RNG_DATA(XRESC_ELM_RING(*l)),
727 XRESC_RNG_DATA(XRESC_ELM_RING(*r)))) {
729 /* find a ring by intersection */
730 bigz_lcm(ent_scratch_bigz,
731 XRESC_RNG_DATA(XRESC_ELM_RING(*l)),
732 XRESC_RNG_DATA(XRESC_ELM_RING(*r)));
733 result_ring = make_resc_rng_bz(ent_scratch_bigz);
735 /* coerce the left ring element to the lcm-ring */
736 bigz_div(ent_scratch_bigz,
737 XRESC_RNG_DATA(result_ring),
738 XRESC_RNG_DATA(XRESC_ELM_RING(*l)));
739 bigz_mul(ent_scratch_bigz,
742 *l = make_resc_elm_bz(ent_scratch_bigz, result_ring);
744 /* coerce the right ring element to the lcm-ring */
745 bigz_div(ent_scratch_bigz,
746 XRESC_RNG_DATA(result_ring),
747 XRESC_RNG_DATA(XRESC_ELM_RING(*r)));
748 bigz_mul(ent_scratch_bigz,
751 *r = make_resc_elm_bz(ent_scratch_bigz, result_ring);
754 result_ring = XRESC_ELM_RING(*l);
761 ase_resclass_check_rings(Lisp_Object l, Lisp_Object r)
763 if (XASE_RESC_ELM_SMALLP(l) ^ XASE_RESC_ELM_SMALLP(r)) {
765 Fsignal(Qdomain_error, list2(
766 XASE_RESC_ELM_RING(l), XASE_RESC_ELM_RING(r)));
768 } else if (XASE_RESC_ELM_SMALLP(l) &&
769 XASE_RESC_RNG_SRING(XASE_RESC_ELM_RING(l)) ==
770 XASE_RESC_RNG_SRING(XASE_RESC_ELM_RING(r))) {
772 #if defined HAVE_MPZ && (defined WITH_GMP || defined WITH_MP)
773 } else if (!XASE_RESC_ELM_SMALLP(l) &&
774 bigz_eql(XASE_RESC_RNG_RING(XASE_RESC_ELM_RING(l)),
775 XASE_RESC_RNG_RING(XASE_RESC_ELM_RING(r)))) {
783 static inline Lisp_Object
784 ase_resclass_sum_small(Lisp_Object l, Lisp_Object r, Lisp_Object result_ring)
787 XASE_RESC_ELM(l)->small_data + XASE_RESC_ELM(r)->small_data;
788 return ase_make_resc_elm(make_int(sum), result_ring);
791 #if defined HAVE_MPZ && (defined WITH_GMP || defined WITH_MP)
792 static inline Lisp_Object
793 ase_resclass_sum_big(Lisp_Object l, Lisp_Object r, Lisp_Object result_ring)
795 ase_resc_elm_t e = NULL;
796 bigz_add(ent_scratch_bigz,
797 XASE_RESC_ELM_DATA(l), XASE_RESC_ELM_DATA(r));
798 e = __ase_make_resc_elm_bigz(ent_scratch_bigz);
800 e->ring = result_ring;
801 _ase_resc_elm_canonicalise_big(e);
802 return _ase_wrap_resc_elm(e);
807 ase_resclass_sum(Lisp_Object l, Lisp_Object r)
809 ase_resclass_check_rings(l, r);
812 result_ring = ent_intersection_factor_module(&l, &r);
815 if (XASE_RESC_ELM_SMALLP(l) && XASE_RESC_ELM_SMALLP(r)) {
816 return ase_resclass_sum_small(l, r, XASE_RESC_ELM_RING(l));
818 #if defined HAVE_MPZ && (defined WITH_GMP || defined WITH_MP)
819 return ase_resclass_sum_big(l, r, XASE_RESC_ELM_RING(l));
826 static inline Lisp_Object
827 ase_resclass_sum_intg_small(
828 Lisp_Object l, Lisp_Object intg, Lisp_Object result_ring)
832 XASE_RESC_ELM(l)->small_data + XINT(intg);
833 return ase_make_resc_elm(make_int(sum), result_ring);
834 #if defined HAVE_MPZ && (defined WITH_GMP || defined WITH_MP)
835 } else if (BIGZP(intg)) {
837 bigz_set_long(ent_scratch_bigz,
838 XASE_RESC_RNG(XASE_RESC_ELM_RING(l))->small_ring);
839 bigz_mod(ent_scratch_bigz, XBIGZ_DATA(intg), ent_scratch_bigz);
840 sum = XASE_RESC_ELM(l)->small_data +
841 bigz_to_long(ent_scratch_bigz);
842 return ase_make_resc_elm(make_int(sum), result_ring);
848 #if defined HAVE_MPZ && (defined WITH_GMP || defined WITH_MP)
849 static inline Lisp_Object
850 ase_resclass_sum_intg_big(
851 Lisp_Object l, Lisp_Object intg, Lisp_Object result_ring)
854 ase_resc_elm_t e = NULL;
855 bigz_set_long(ent_scratch_bigz, XINT(intg));
856 bigz_add(ent_scratch_bigz,
857 XASE_RESC_ELM_DATA(l), ent_scratch_bigz);
858 e = __ase_make_resc_elm_bigz(ent_scratch_bigz);
860 e->ring = result_ring;
861 _ase_resc_elm_canonicalise_big(e);
862 return _ase_wrap_resc_elm(e);
863 } else if (BIGZP(intg)) {
864 ase_resc_elm_t e = NULL;
865 bigz_add(ent_scratch_bigz,
866 XASE_RESC_ELM_DATA(l), XBIGZ_DATA(intg));
867 e = __ase_make_resc_elm_bigz(ent_scratch_bigz);
869 e->ring = result_ring;
870 _ase_resc_elm_canonicalise_big(e);
871 return _ase_wrap_resc_elm(e);
878 ase_resclass_sum_intg(Lisp_Object l, Lisp_Object r)
880 if (INTEGERP(l) && XASE_RESC_ELM_SMALLP(r)) {
881 return ase_resclass_sum_intg_small(
882 r, l, XASE_RESC_ELM_RING(r));
883 } else if (INTEGERP(r) && XASE_RESC_ELM_SMALLP(l)) {
884 return ase_resclass_sum_intg_small(
885 l, r, XASE_RESC_ELM_RING(l));
886 #if defined HAVE_MPZ && (defined WITH_GMP || defined WITH_MP)
887 } else if (INTEGERP(l)) {
888 return ase_resclass_sum_intg_big(
889 r, l, XASE_RESC_ELM_RING(r));
890 } else if (INTEGERP(r)) {
891 return ase_resclass_sum_intg_big(
892 l, r, XASE_RESC_ELM_RING(l));
899 static inline Lisp_Object
900 ase_resclass_diff_small(Lisp_Object l, Lisp_Object r, Lisp_Object result_ring)
903 XASE_RESC_ELM(l)->small_data - XASE_RESC_ELM(r)->small_data;
904 return ase_make_resc_elm(make_int(diff), result_ring);
907 #if defined HAVE_MPZ && (defined WITH_GMP || defined WITH_MP)
908 static inline Lisp_Object
909 ase_resclass_diff_big(Lisp_Object l, Lisp_Object r, Lisp_Object result_ring)
911 ase_resc_elm_t e = NULL;
912 bigz_sub(ent_scratch_bigz,
913 XASE_RESC_ELM_DATA(l), XASE_RESC_ELM_DATA(r));
914 e = __ase_make_resc_elm_bigz(ent_scratch_bigz);
916 e->ring = result_ring;
917 _ase_resc_elm_canonicalise_big(e);
918 return _ase_wrap_resc_elm(e);
923 ase_resclass_diff(Lisp_Object l, Lisp_Object r)
925 ase_resclass_check_rings(l, r);
928 result_ring = ent_intersection_factor_module(&l, &r);
931 if (XASE_RESC_ELM_SMALLP(l) && XASE_RESC_ELM_SMALLP(r)) {
932 return ase_resclass_diff_small(l, r, XASE_RESC_ELM_RING(l));
934 #if defined HAVE_MPZ && (defined WITH_GMP || defined WITH_MP)
935 return ase_resclass_diff_big(l, r, XASE_RESC_ELM_RING(l));
942 static inline Lisp_Object
943 ase_resclass_diff_intg_small(
944 Lisp_Object l, Lisp_Object intg, Lisp_Object result_ring)
948 XASE_RESC_ELM(l)->small_data - XINT(intg);
949 return ase_make_resc_elm(make_int(diff), result_ring);
950 #if defined HAVE_MPZ && (defined WITH_GMP || defined WITH_MP)
951 } else if (BIGZP(intg)) {
953 bigz_set_long(ent_scratch_bigz,
954 XASE_RESC_RNG(XASE_RESC_ELM_RING(l))->small_ring);
955 bigz_mod(ent_scratch_bigz, XBIGZ_DATA(intg), ent_scratch_bigz);
956 diff = XASE_RESC_ELM(l)->small_data -
957 bigz_to_long(ent_scratch_bigz);
958 return ase_make_resc_elm(make_int(diff), result_ring);
964 #if defined HAVE_MPZ && (defined WITH_GMP || defined WITH_MP)
965 static inline Lisp_Object
966 ase_resclass_diff_intg_big(
967 Lisp_Object l, Lisp_Object intg, Lisp_Object result_ring)
970 ase_resc_elm_t e = NULL;
971 bigz_set_long(ent_scratch_bigz, XINT(intg));
972 bigz_sub(ent_scratch_bigz,
973 XASE_RESC_ELM_DATA(l), ent_scratch_bigz);
974 e = __ase_make_resc_elm_bigz(ent_scratch_bigz);
976 e->ring = result_ring;
977 _ase_resc_elm_canonicalise_big(e);
978 return _ase_wrap_resc_elm(e);
979 } else if (BIGZP(intg)) {
980 ase_resc_elm_t e = NULL;
981 bigz_sub(ent_scratch_bigz,
982 XASE_RESC_ELM_DATA(l), XBIGZ_DATA(intg));
983 e = __ase_make_resc_elm_bigz(ent_scratch_bigz);
985 e->ring = result_ring;
986 _ase_resc_elm_canonicalise_big(e);
987 return _ase_wrap_resc_elm(e);
994 ase_resclass_diff_intg(Lisp_Object l, Lisp_Object r)
996 if (XASE_RESC_ELM_SMALLP(l)) {
997 return ase_resclass_diff_intg_small(
998 l, r, XASE_RESC_ELM_RING(l));
999 #if defined HAVE_MPZ && (defined WITH_GMP || defined WITH_MP)
1001 return ase_resclass_diff_intg_big(
1002 l, r, XASE_RESC_ELM_RING(l));
1009 static inline Lisp_Object
1010 ase_resclass_prod_small(Lisp_Object l, Lisp_Object r, Lisp_Object result_ring)
1013 XASE_RESC_ELM(l)->small_data * XASE_RESC_ELM(r)->small_data;
1014 return ase_make_resc_elm(make_int(prod), result_ring);
1017 #if defined HAVE_MPZ && (defined WITH_GMP || defined WITH_MP)
1018 static inline Lisp_Object
1019 ase_resclass_prod_big(Lisp_Object l, Lisp_Object r, Lisp_Object result_ring)
1021 ase_resc_elm_t e = NULL;
1022 bigz_mul(ent_scratch_bigz,
1023 XASE_RESC_ELM_DATA(l), XASE_RESC_ELM_DATA(r));
1024 e = __ase_make_resc_elm_bigz(ent_scratch_bigz);
1026 e->ring = result_ring;
1027 _ase_resc_elm_canonicalise_big(e);
1028 return _ase_wrap_resc_elm(e);
1033 ase_resclass_prod(Lisp_Object l, Lisp_Object r)
1035 ase_resclass_check_rings(l, r);
1038 result_ring = ent_intersection_factor_module(&l, &r);
1041 if (XASE_RESC_ELM_SMALLP(l) && XASE_RESC_ELM_SMALLP(r)) {
1042 return ase_resclass_prod_small(l, r, XASE_RESC_ELM_RING(l));
1044 #if defined HAVE_MPZ && (defined WITH_GMP || defined WITH_MP)
1045 return ase_resclass_prod_big(l, r, XASE_RESC_ELM_RING(l));
1051 static inline Lisp_Object
1052 ase_resclass_prod_intg_small(
1053 Lisp_Object l, Lisp_Object intg, Lisp_Object result_ring)
1057 XASE_RESC_ELM(l)->small_data * XINT(intg);
1058 return ase_make_resc_elm(make_int(prod), result_ring);
1059 #if defined HAVE_MPZ && (defined WITH_GMP || defined WITH_MP)
1060 } else if (BIGZP(intg)) {
1062 bigz_set_long(ent_scratch_bigz,
1063 XASE_RESC_RNG(XASE_RESC_ELM_RING(l))->small_ring);
1064 bigz_mod(ent_scratch_bigz, XBIGZ_DATA(intg), ent_scratch_bigz);
1065 prod = XASE_RESC_ELM(l)->small_data *
1066 bigz_to_long(ent_scratch_bigz);
1067 return ase_make_resc_elm(make_int(prod), result_ring);
1073 #if defined HAVE_MPZ && (defined WITH_GMP || defined WITH_MP)
1074 static inline Lisp_Object
1075 ase_resclass_prod_intg_big(
1076 Lisp_Object l, Lisp_Object intg, Lisp_Object result_ring)
1079 ase_resc_elm_t e = NULL;
1080 bigz_set_long(ent_scratch_bigz, XINT(intg));
1081 bigz_mul(ent_scratch_bigz,
1082 XASE_RESC_ELM_DATA(l), ent_scratch_bigz);
1083 e = __ase_make_resc_elm_bigz(ent_scratch_bigz);
1085 e->ring = result_ring;
1086 _ase_resc_elm_canonicalise_big(e);
1087 return _ase_wrap_resc_elm(e);
1088 } else if (BIGZP(intg)) {
1089 ase_resc_elm_t e = NULL;
1090 bigz_mul(ent_scratch_bigz,
1091 XASE_RESC_ELM_DATA(l), XBIGZ_DATA(intg));
1092 e = __ase_make_resc_elm_bigz(ent_scratch_bigz);
1094 e->ring = result_ring;
1095 _ase_resc_elm_canonicalise_big(e);
1096 return _ase_wrap_resc_elm(e);
1103 ase_resclass_prod_intg(Lisp_Object l, Lisp_Object r)
1105 if (INTEGERP(l) && XASE_RESC_ELM_SMALLP(r)) {
1106 return ase_resclass_prod_intg_small(
1107 r, l, XASE_RESC_ELM_RING(r));
1108 } else if (INTEGERP(r) && XASE_RESC_ELM_SMALLP(l)) {
1109 return ase_resclass_prod_intg_small(
1110 l, r, XASE_RESC_ELM_RING(l));
1111 #if defined HAVE_MPZ && (defined WITH_GMP || defined WITH_MP)
1112 } else if (INTEGERP(l)) {
1113 return ase_resclass_prod_intg_big(
1114 r, l, XASE_RESC_ELM_RING(r));
1115 } else if (INTEGERP(r)) {
1116 return ase_resclass_prod_intg_big(
1117 l, r, XASE_RESC_ELM_RING(l));
1125 ase_resclass_div(Lisp_Object l, Lisp_Object r)
1127 ase_object_type_t idx = ase_optable_index_typesym(Qase_resc_elm);
1128 Lisp_Object inv = _ent_unop(ASE_UNARY_OP_INV, idx, r);
1129 Lisp_Object mul = _ent_binop(ASE_BINARY_OP_PROD, idx, l, idx, inv);
1134 ase_resclass_div_INT_T(Lisp_Object l, Lisp_Object r)
1136 ase_object_type_t idx = ase_optable_index_typesym(Qase_resc_elm);
1137 Lisp_Object inv = _ent_unop(ASE_UNARY_OP_INV, idx, l);
1138 Lisp_Object mul = _ent_binop(ASE_BINARY_OP_PROD, idx, inv, INT_T, r);
1143 ase_resclass_INT_T_div(Lisp_Object l, Lisp_Object r)
1145 ase_object_type_t idx = ase_optable_index_typesym(Qase_resc_elm);
1146 Lisp_Object inv = _ent_unop(ASE_UNARY_OP_INV, idx, r);
1147 Lisp_Object mul = _ent_binop(ASE_BINARY_OP_PROD, idx, l, INT_T, inv);
1152 ase_resclass_div_BIGZ_T(Lisp_Object l, Lisp_Object r)
1154 ase_object_type_t idx = ase_optable_index_typesym(Qase_resc_elm);
1155 Lisp_Object inv = _ent_unop(ASE_UNARY_OP_INV, idx, l);
1156 Lisp_Object mul = _ent_binop(ASE_BINARY_OP_PROD, idx, inv, BIGZ_T, r);
1161 ase_resclass_BIGZ_T_div(Lisp_Object l, Lisp_Object r)
1163 ase_object_type_t idx = ase_optable_index_typesym(Qase_resc_elm);
1164 Lisp_Object inv = _ent_unop(ASE_UNARY_OP_INV, idx, r);
1165 Lisp_Object mul = _ent_binop(ASE_BINARY_OP_PROD, idx, l, BIGZ_T, inv);
1169 #if defined HAVE_MPZ && (defined WITH_GMP || defined WITH_MP)
1171 ase_resclass_pow(Lisp_Object l, Lisp_Object r)
1173 Lisp_Object rng = XASE_RESC_ELM_RING(l);
1178 bigz_set_long(expo, ent_int(r));
1179 } else if (BIGZP(r)) {
1180 bigz_set(expo, XBIGZ_DATA(r));
1182 Fsignal(Qoperation_error, r);
1185 if (XASE_RESC_ELM_SMALLP(l)) {
1190 bigz_set_long(tmp, XASE_RESC_RNG_SRING(rng));
1191 bigz_set_long(ent_scratch_bigz, XASE_RESC_ELM_SDATA(l));
1192 mpz_powm(ent_scratch_bigz, ent_scratch_bigz, expo, tmp);
1193 res = bigz_to_long(ent_scratch_bigz);
1196 return ase_make_resc_elm(make_int(res), rng);
1198 ase_resc_elm_t e = NULL;
1199 mpz_powm(ent_scratch_bigz, XASE_RESC_ELM_DATA(l),
1200 expo, XASE_RESC_RNG_RING(l));
1201 e = __ase_make_resc_elm_bigz(ent_scratch_bigz);
1203 e->ring = XASE_RESC_ELM_RING(l);
1204 _ase_resc_elm_canonicalise_big(e);
1206 return _ase_wrap_resc_elm(e);
1214 ase_resclass_neg(Lisp_Object l)
1216 Lisp_Object rng = XASE_RESC_ELM_RING(l);
1217 if (XASE_RESC_ELM_SMALLP(l)) {
1219 XASE_RESC_RNG_SRING(rng) - XASE_RESC_ELM_SDATA(l);
1220 return ase_make_resc_elm(make_int(sum), rng);
1221 #if defined HAVE_MPZ && (defined WITH_GMP || defined WITH_MP)
1223 ase_resc_elm_t e = NULL;
1224 bigz_set(ent_scratch_bigz, XASE_RESC_RNG_RING(rng));
1225 bigz_sub(ent_scratch_bigz,
1226 ent_scratch_bigz, XASE_RESC_ELM_DATA(l));
1227 e = __ase_make_resc_elm_bigz(ent_scratch_bigz);
1230 _ase_resc_elm_canonicalise_big(e);
1231 return _ase_wrap_resc_elm(e);
1237 #if defined HAVE_MPZ && (defined WITH_GMP || defined WITH_MP)
1239 ase_resclass_inv(Lisp_Object r)
1241 Lisp_Object rng = XASE_RESC_ELM_RING(r);
1245 if (XASE_RESC_ELM_SMALLP(r)) {
1248 bigz_set_long(tmp, XASE_RESC_ELM_SDATA(r));
1249 bigz_set_long(ent_scratch_bigz, XASE_RESC_RNG_SRING(rng));
1250 state = mpz_invert(ent_scratch_bigz, tmp, ent_scratch_bigz);
1253 state = mpz_invert(ent_scratch_bigz,
1254 XASE_RESC_ELM_DATA(r),
1255 XASE_RESC_RNG_RING(rng));
1259 error("cannot operate on zero divisor");
1263 if (XASE_RESC_ELM_SMALLP(r)) {
1264 return ase_make_resc_elm(
1265 make_int(bigz_to_long(ent_scratch_bigz)), rng);
1267 ase_resc_elm_t e = __ase_make_resc_elm_bigz(ent_scratch_bigz);
1270 _ase_resc_elm_canonicalise_big(e);
1271 return _ase_wrap_resc_elm(e);
1279 ase_resclass_eq(Lisp_Object l, Lisp_Object r)
1281 ase_resclass_check_rings(l, r);
1283 if (XASE_RESC_ELM_SMALLP(l)) {
1284 return (XASE_RESC_ELM_SDATA(l) == XASE_RESC_ELM_SDATA(r));
1285 #if defined HAVE_MPZ && (defined WITH_GMP || defined WITH_MP)
1286 } else if (!XASE_RESC_ELM_SMALLP(l)) {
1287 return bigz_eql(XASE_RESC_ELM_DATA(l), XASE_RESC_ELM_DATA(r));
1294 ase_resclass_ne(Lisp_Object l, Lisp_Object r)
1296 ase_resclass_check_rings(l, r);
1298 if (XASE_RESC_ELM_SMALLP(l)) {
1299 return (XASE_RESC_ELM_SDATA(l) != XASE_RESC_ELM_SDATA(r));
1300 #if defined HAVE_MPZ && (defined WITH_GMP || defined WITH_MP)
1301 } else if (!XASE_RESC_ELM_SMALLP(l)) {
1302 return !bigz_eql(XASE_RESC_ELM_DATA(l), XASE_RESC_ELM_DATA(r));
1309 ase_resclass_zerop(Lisp_Object elm)
1311 if (XASE_RESC_ELM_SMALLP(elm)) {
1312 return (XASE_RESC_ELM_SDATA(elm) == 0);
1313 #if defined HAVE_MPZ && (defined WITH_GMP || defined WITH_MP)
1314 } else if (!XASE_RESC_ELM_SMALLP(elm)) {
1315 # define __d XASE_RESC_ELM_DATA(elm)
1316 return (bigz_fits_long_p(__d) && bigz_to_long(__d) == 0);
1324 ase_resclass_onep(Lisp_Object elm)
1326 if (XASE_RESC_ELM_SMALLP(elm)) {
1327 return (XASE_RESC_ELM_SDATA(elm) == 1);
1328 #if defined HAVE_MPZ && (defined WITH_GMP || defined WITH_MP)
1329 } else if (!XASE_RESC_ELM_SMALLP(elm)) {
1330 # define __d XASE_RESC_ELM_DATA(elm)
1331 return (bigz_fits_long_p(__d) && bigz_to_long(__d) == 1);
1338 #if defined HAVE_MPZ && (defined WITH_GMP || defined WITH_MP)
1340 ase_resclass_unitp(Lisp_Object elm)
1342 Lisp_Object rng = XASE_RESC_ELM_RING(elm);
1346 if (XASE_RESC_ELM_SMALLP(elm)) {
1348 bigz_set_long(tmp, XASE_RESC_ELM_SDATA(elm));
1349 bigz_set_long(ent_scratch_bigz, XASE_RESC_RNG_SRING(rng));
1350 state = mpz_invert(ent_scratch_bigz, tmp, ent_scratch_bigz);
1353 state = mpz_invert(ent_scratch_bigz,
1354 XASE_RESC_ELM_DATA(elm),
1355 XASE_RESC_RNG_RING(rng));
1362 #if defined HAVE_MPZ && (defined WITH_GMP || defined WITH_MP)
1364 ase_resclass_lift_to_BIGZ_T(Lisp_Object number, ent_lift_args_t SXE_UNUSED(la))
1366 if (XASE_RESC_ELM_SMALLP(number)) {
1367 make_bigz(XASE_RESC_ELM_SDATA(number));
1369 return make_bigz_bz(XASE_RESC_ELM_DATA(number));
1376 ase_resclass_lift_to_INT_T(Lisp_Object number, ent_lift_args_t SXE_UNUSED(la))
1378 if (XASE_RESC_ELM_SMALLP(number)) {
1379 return make_int(XASE_RESC_ELM_SDATA(number));
1380 #if defined HAVE_MPZ && (defined WITH_GMP || defined WITH_MP)
1382 return make_int(bigz_to_long(XASE_RESC_ELM_DATA(number)));
1390 ase_resclass_lift_to_FLOAT_T(Lisp_Object number, ent_lift_args_t SXE_UNUSED(la))
1392 if (XASE_RESC_ELM_SMALLP(number)) {
1393 return make_float(XASE_RESC_ELM_SDATA(number));
1394 #if defined HAVE_MPZ && (defined WITH_GMP || defined WITH_MP)
1396 return make_float(bigz_to_fpfloat(XASE_RESC_ELM_DATA(number)));
1405 ent_resclass_nullary_optable_init(void)
1407 ent_nullop_register(ASE_NULLARY_OP_ZERO, INDEF_T, Qzero);
1408 ent_nullop_register(ASE_NULLARY_OP_ONE, INDEF_T, Qone);
1412 ent_resclass_unary_optable_init(void)
1414 ase_object_type_t idx = ase_optable_index_typesym(Qase_resc_elm);
1415 ent_unop_register(ASE_UNARY_OP_NEG, idx, ase_resclass_neg);
1416 #if defined HAVE_MPZ && (defined WITH_GMP || defined WITH_MP)
1417 ent_unop_register(ASE_UNARY_OP_INV, idx, ase_resclass_inv);
1422 ent_resclass_binary_optable_init(void)
1424 ase_object_type_t idx = ase_optable_index_typesym(Qase_resc_elm);
1426 ent_binop_register(ASE_BINARY_OP_SUM,
1427 idx, idx, ase_resclass_sum);
1428 ent_binop_register(ASE_BINARY_OP_SUM,
1429 idx, INT_T, ase_resclass_sum_intg);
1430 ent_binop_register(ASE_BINARY_OP_SUM,
1431 INT_T, idx, ase_resclass_sum_intg);
1432 ent_binop_register(ASE_BINARY_OP_SUM,
1433 idx, BIGZ_T, ase_resclass_sum_intg);
1434 ent_binop_register(ASE_BINARY_OP_SUM,
1435 BIGZ_T, idx, ase_resclass_sum_intg);
1437 ent_binop_register(ASE_BINARY_OP_DIFF,
1438 idx, idx, ase_resclass_diff);
1439 ent_binop_register(ASE_BINARY_OP_DIFF,
1440 idx, INT_T, ase_resclass_diff_intg);
1441 ent_binop_register(ASE_BINARY_OP_DIFF,
1442 idx, BIGZ_T, ase_resclass_diff_intg);
1444 ent_binop_register(ASE_BINARY_OP_PROD,
1445 idx, idx, ase_resclass_prod);
1446 ent_binop_register(ASE_BINARY_OP_PROD,
1447 idx, INT_T, ase_resclass_prod_intg);
1448 ent_binop_register(ASE_BINARY_OP_PROD,
1449 INT_T, idx, ase_resclass_prod_intg);
1450 ent_binop_register(ASE_BINARY_OP_PROD,
1451 idx, BIGZ_T, ase_resclass_prod_intg);
1452 ent_binop_register(ASE_BINARY_OP_PROD,
1453 BIGZ_T, idx, ase_resclass_prod_intg);
1455 ent_binop_register(ASE_BINARY_OP_DIV,
1456 idx, idx, ase_resclass_div);
1457 ent_binop_register(ASE_BINARY_OP_QUO,
1458 idx, idx, ase_resclass_div);
1459 ent_binop_register(ASE_BINARY_OP_DIV,
1460 idx, INT_T, ase_resclass_div_INT_T);
1461 ent_binop_register(ASE_BINARY_OP_QUO,
1462 idx, INT_T, ase_resclass_div_INT_T);
1463 ent_binop_register(ASE_BINARY_OP_DIV,
1464 INT_T, idx, ase_resclass_INT_T_div);
1465 ent_binop_register(ASE_BINARY_OP_QUO,
1466 INT_T, idx, ase_resclass_INT_T_div);
1467 ent_binop_register(ASE_BINARY_OP_DIV,
1468 idx, BIGZ_T, ase_resclass_div_BIGZ_T);
1469 ent_binop_register(ASE_BINARY_OP_QUO,
1470 idx, BIGZ_T, ase_resclass_div_BIGZ_T);
1471 ent_binop_register(ASE_BINARY_OP_DIV,
1472 BIGZ_T, idx, ase_resclass_BIGZ_T_div);
1473 ent_binop_register(ASE_BINARY_OP_QUO,
1474 BIGZ_T, idx, ase_resclass_BIGZ_T_div);
1476 #if defined HAVE_MPZ && (defined WITH_GMP || defined WITH_MP)
1477 ent_binop_register(ASE_BINARY_OP_POW,
1478 idx, INT_T, ase_resclass_pow);
1479 ent_binop_register(ASE_BINARY_OP_POW,
1480 idx, BIGZ_T, ase_resclass_pow);
1485 ent_resclass_unary_reltable_init(void)
1487 ase_object_type_t idx = ase_optable_index_typesym(Qase_resc_elm);
1488 ent_unrel_register(ASE_UNARY_REL_ZEROP, idx, ase_resclass_zerop);
1489 ent_unrel_register(ASE_UNARY_REL_ONEP, idx, ase_resclass_onep);
1490 #if defined HAVE_MPZ && (defined WITH_GMP || defined WITH_MP)
1491 ent_unrel_register(ASE_UNARY_REL_UNITP, idx, ase_resclass_unitp);
1496 ent_resclass_binary_reltable_init(void)
1498 ase_object_type_t idx = ase_optable_index_typesym(Qase_resc_elm);
1499 ent_binrel_register(ASE_BINARY_REL_EQUALP,
1500 idx, idx, ase_resclass_eq);
1501 ent_binrel_register(ASE_BINARY_REL_NEQP,
1502 idx, idx, ase_resclass_ne);
1506 ent_resclass_lifttable_init(void)
1508 ase_object_type_t idx = ase_optable_index_typesym(Qase_resc_elm);
1509 ent_lift_register(idx, INT_T, ase_resclass_lift_to_INT_T);
1510 #if defined HAVE_MPZ && (defined WITH_GMP || defined WITH_MP)
1511 ent_lift_register(idx, BIGZ_T, ase_resclass_lift_to_BIGZ_T);
1514 ent_lift_register(idx, FLOAT_T, ase_resclass_lift_to_FLOAT_T);
1520 DEFUN("make-residue-class-ring", Fmake_residue_class_ring, 1, 1, 0, /*
1521 Return a residue class ring of size MODULUS (>= 2).
1525 CHECK_INTEGER(modulus);
1526 if (NILP(Fnonnegativep(modulus)))
1527 error("cannot create ring with negative modulus");
1528 if (ent_unrel_zerop(modulus))
1529 error("cannot create ring of size 0");
1530 if (ent_unrel_onep(modulus))
1531 error("ring is identical to Z");
1533 return ase_make_resc_rng(modulus);
1537 DEFUN("make-residue-class", Fmake_residue_class, 2, 2, 0, /*
1538 Return the residue class of ELEMENT in RING.
1542 CHECK_ASE_RESC_RNG(ring);
1543 CHECK_INTEGER(element);
1545 return ase_make_resc_elm(element, ring);
1549 DEFUN("residue-class-ring", Fresidue_class_ring, 1, 1, 0, /*
1550 Return the parental residue class ring (the world) of RESCLASS.
1554 CHECK_ASE_RESC_ELM(resclass);
1556 return XASE_RESC_ELM_RING(resclass);
1561 D3FUN("residue-class-modulus", Fresidue_class_modulus, 1, 1, 0, /*
1562 Return the modulus of the residue class ring RING-OR-ELEMENT,
1563 or the modulus of a residue class, respectively.
1569 if (!ASE_RESC_ELM_P(ring_or_element) &&
1570 !ASE_RESC_RNG_P(ring_or_element)) {
1571 return wrong_type_argument(Qase_resc_elm_p, ring_or_element);
1574 if (ASE_RESC_ELM_P(ring_or_element))
1575 rng = XASE_RESC_ELM_RING(ring_or_element);
1576 else if (ASE_RESC_RNG_P(ring_or_element))
1577 rng = ring_or_element;
1581 return make_bigz_bz(XASE_RESC_RNG_RING(rng));
1585 D3FUN("residue-class-representant", Fresidue_class_representant, 1, 1, 0, /*
1586 Return the representant of the residue class ELEMENT lifted
1587 to the ring of rational integers.
1591 CHECK_ASE_RESC_ELM(element);
1593 return make_bigz_bz(XASE_RESC_ELM_DATA(element));
1598 DEFUN ("residue-class-ring-p", Fresidue_class_ring_p, 1, 1, 0, /*
1599 Return t if OBJECT is a residue class ring, nil otherwise.
1603 return ASE_RESC_RNG_P(object) ? Qt : Qnil;
1607 DEFUN ("residue-class-p", Fresidue_class_p, 1, 1, 0, /*
1608 Return t if OBJECT is a residue class, nil otherwise.
1612 return ASE_RESC_ELM_P(object) ? Qt : Qnil;
1615 /* from number-to-string */
1616 #ifdef HAVE_RESCLASS
1617 if (RESC_ELMP(number)) {
1618 char *estr = (char*)resc_elm_to_string(
1619 XRESC_ELM_DATA(number), 10);
1620 char *rstr = (char*)resc_rng_to_string(
1621 XRESC_RNG_DATA(XRESC_ELM_RING(number)), 10);
1622 int elen = strlen(estr);
1623 int rlen = strlen(rstr);
1626 XREALLOC_ARRAY(estr, char, elen+1+rlen+1 + 1);
1627 strncat(estr, "+", 1);
1628 strncat(estr, rstr, rlen);
1629 strncat(estr, "Z", 1);
1630 result = build_string(estr);
1637 /* from zero-divisor-p */
1638 #ifdef HAVE_RESCLASS
1643 if (mpz_invert(bz, XRESC_ELM_DATA(number),
1644 XRESC_RNG_DATA(XRESC_ELM_RING(number))))
1655 /* initialiser code */
1656 #define EMODNAME ase_resclass
1659 ase_resclass_binary_optable_init(void)
1661 ent_resclass_nullary_optable_init();
1662 ent_resclass_unary_optable_init();
1663 ent_resclass_binary_optable_init();
1664 ent_resclass_unary_reltable_init();
1665 ent_resclass_binary_reltable_init();
1666 ent_resclass_lifttable_init();
1672 DEFSUBR(Fmake_residue_class_ring);
1673 DEFSUBR(Fmake_residue_class);
1674 DEFSUBR(Fresidue_class_ring);
1676 DEFSUBR(Fresidue_class_modulus);
1677 DEFSUBR(Fresidue_class_representant);
1679 DEFSUBR(Fresidue_class_ring_p);
1680 DEFSUBR(Fresidue_class_p);
1682 DEFSYMBOL(Qase_resclass);
1683 DEFASETYPE_WITH_OPS(Qase_resc_rng, "ase:residue-class-ring");
1684 defsymbol(&Qase_resc_rng_p, "ase:residue-class-ring-p");
1685 DEFASETYPE_WITH_OPS(Qase_resc_elm, "ase:residue-class");
1686 defsymbol(&Qase_resc_elm_p, "ase:residue-class-p");
1688 ase_resclass_binary_optable_init();
1690 Fprovide(Qase_resclass);
1691 Fprovide(intern("resclass"));
1697 EMOD_PUBREINIT(void)
1699 sane_small = (snprintf(NULL, 0, "%ld", EMACS_INT_MAX) + 7) & -3;
1700 /* defined in lread.c, declared in ent.h */
1701 ase_resc_rng_pred_f = ase_resc_rng_string_p;
1702 ase_resc_rng_f = ase_resc_rng_from_string;
1703 ase_resc_elm_pred_f = ase_resc_elm_string_p;
1704 ase_resc_elm_f = ase_resc_elm_from_string;
1708 EMOD_PUBDEINIT(void)
1710 Frevoke(Qase_resclass);
1711 Frevoke(intern("resclass"));
1714 /* ent-resclass.c ends here */