YAP 7.1.0
gmp_support.c
1/*************************************************************************
2* *
3* YAP Prolog *
4* *
5* Yap Prolog was developed at NCCUP - Universidade do Porto *
6* *
7* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 *
8* *
9**************************************************************************
10* *
11* File: gmp_support.c *
12* Last rev: *
13* mods: *
14* comments: bignum code *
15* *
16*************************************************************************/
17
18#include "Yap.h"
19#include "Yatom.h"
20#include "YapHeap.h"
21#include "YapEval.h"
22#if HAVE_STRING_H
23#include <string.h>
24#endif
25#include <wchar.h>
26
27
28static inline Term
29MkBigAndClose(MP_INT *new)
30{
31 Term t = Yap_MkBigIntTerm(new);
32 mpz_clear(new);
33 if (t == TermNil) {
34 Yap_ArithError(RESOURCE_ERROR_STACK, t, ">>/2");
35 }
36 return t;
37}
38
39static inline Term
40MkRatAndClose(MP_RAT *new)
41{
42 Term t = Yap_MkBigRatTerm(new);
43 mpq_clear(new);
44 if (t == TermNil) {
45 Yap_ArithError(RESOURCE_ERROR_STACK, t, ">>/2");
46 }
47 return t;
48}
49
50/* add i + j using temporary bigint new */
51Term
52Yap_gmp_add_ints(Int i, Int j)
53{
54 MP_INT new;
55
56 mpz_init_set_si(&new,i);
57 if (j > 0) {
58 mpz_add_ui(&new, &new, j);
59 } else {
60 if (j-1 > 0) { /* negative overflow */
61 mpz_sub_ui(&new, &new, -(j+1));
62 mpz_sub_ui(&new, &new, 1);
63 } else {
64 mpz_sub_ui(&new, &new, -j);
65 }
66 }
67 return MkBigAndClose(&new);
68}
69
70Term
71Yap_gmp_sub_ints(Int i, Int j)
72{
73 MP_INT new;
74 Term t;
75
76 mpz_init_set_si(&new,i);
77 if (j > 0) {
78 mpz_sub_ui(&new, &new, j);
79 } else {
80 if (j-1 > 0) { /* negative overflow */
81 mpz_add_ui(&new, &new, -(j+1));
82 mpz_add_ui(&new, &new, 1);
83 } else {
84 mpz_add_ui(&new, &new, -j);
85 }
86 }
87 return MkBigAndClose(&new);
88 t = Yap_MkBigIntTerm(&new);
89 mpz_clear(&new);
90 return t;
91}
92
93Term
94Yap_gmp_mul_ints(Int i, Int j)
95{
96 MP_INT new;
97
98 mpz_init_set_si(&new,i);
99 mpz_mul_si(&new, &new, j);
100 return MkBigAndClose(&new);
101}
102
103Term
104Yap_gmp_sll_ints(Int i, Int j)
105{
106 MP_INT new;
107
108 mpz_init_set_si(&new,i);
109 mpz_mul_2exp(&new, &new, j);
110 return MkBigAndClose(&new);
111}
112
113/* add i + b using temporary bigint new */
114Term
115Yap_gmp_add_int_big(Int i, Term t)
116{
117 CELL *pt = RepAppl(t);
118 if (pt[1] == BIG_INT) {
119 MP_INT new;
120 MP_INT *b = Yap_BigIntOfTerm(t);
121 mpz_init_set_si(&new, i);
122 mpz_add(&new, &new, b);
123 return MkBigAndClose(&new);
124 } else {
125 MP_RAT new;
126 MP_RAT *b = Yap_BigRatOfTerm(t);
127 mpq_init(&new);
128 mpq_set_si(&new, i, 1L);
129 mpq_add(&new, &new, b);
130 return MkRatAndClose(&new);
131 }
132}
133
134/* add i + b using temporary bigint new */
135void
136Yap_gmp_set_bit(Int i, Term t)
137{
138 MP_INT *b = Yap_BigIntOfTerm(t);
139 mpz_setbit(b, i);
140}
141
142/* sub i - b using temporary bigint new */
143Term
144Yap_gmp_sub_int_big(Int i, Term t)
145{
146 CELL *pt = RepAppl(t);
147 if (pt[1] == BIG_INT) {
148 MP_INT new;
149 MP_INT *b = Yap_BigIntOfTerm(t);
150
151 mpz_init_set_si(&new, i);
152 mpz_sub(&new, &new, b);
153 return MkBigAndClose(&new);
154 } else {
155 MP_RAT new;
156 MP_RAT *b = Yap_BigRatOfTerm(t);
157
158 mpq_init(&new);
159 mpq_set_si(&new, i, 1L);
160 mpq_sub(&new, &new, b);
161 return MkRatAndClose(&new);
162 }
163}
164
165/* add i + b using temporary bigint new */
166Term
167Yap_gmp_mul_int_big(Int i, Term t)
168{
169 CELL *pt = RepAppl(t);
170 if (pt[1] == BIG_INT) {
171 MP_INT new;
172 MP_INT *b = Yap_BigIntOfTerm(t);
173
174 mpz_init_set_si(&new, i);
175 mpz_mul(&new, &new, b);
176 return MkBigAndClose(&new);
177 } else {
178 MP_RAT new;
179 MP_RAT *b = Yap_BigRatOfTerm(t);
180
181 mpq_init(&new);
182 mpq_set_si(&new, i, 1L);
183 mpq_mul(&new, &new, b);
184 return MkRatAndClose(&new);
185 }
186}
187
188/* sub i - b using temporary bigint new */
189Term
190Yap_gmp_sub_big_int(Term t, Int i)
191{
192 CELL *pt = RepAppl(t);
193 if (pt[1] == BIG_INT) {
194 MP_INT new;
195 MP_INT *b = Yap_BigIntOfTerm(t);
196
197 mpz_init_set_si(&new, i);
198 mpz_neg(&new, &new);
199 mpz_add(&new, &new, b);
200 return MkBigAndClose(&new);
201 } else {
202 MP_RAT new;
203 MP_RAT *b = Yap_BigRatOfTerm(t);
204
205 mpq_init(&new);
206 mpq_set_si(&new, i, 1L);
207 mpq_sub(&new, b, &new);
208 return MkRatAndClose(&new);
209 }
210}
211
212/* div i / b using temporary bigint new */
213Term
214Yap_gmp_div_int_big(Int i, Term t)
215{
216 CELL *pt = RepAppl(t);
217 if (pt[1] == BIG_INT) {
218 /* cool */
219 return MkIntTerm(0);
220 } else {
221 MP_RAT new;
222 MP_RAT *b = Yap_BigRatOfTerm(t);
223
224 mpq_init(&new);
225 mpq_set_si(&new, i, 1L);
226 mpq_div(&new, &new, b);
227 return MkRatAndClose(&new);
228 }
229}
230
231/* div b / i using temporary bigint new */
232Term
233Yap_gmp_div_big_int(Term t, Int i)
234{
235 CELL *pt = RepAppl(t);
236 if (pt[1] == BIG_INT) {
237 MP_INT new;
238 MP_INT *b = Yap_BigIntOfTerm(t);
239
240 mpz_init_set(&new, b);
241 if ( (-3 / 2) == -2 ) {
242 if (i > 0) {
243 mpz_tdiv_q_ui(&new, &new, i);
244 } else if (i == 0) {
245 Yap_ArithError(EVALUATION_ERROR_ZERO_DIVISOR, MkIntTerm(0), "// /2");
246 } else {
247 /* we do not handle MIN_INT */
248 mpz_tdiv_q_ui(&new, &new, -i);
249 mpz_neg(&new, &new);
250 }
251 } else {
252 if (i > 0) {
253 mpz_fdiv_q_ui(&new, &new, i);
254 } else if (i == 0) {
255 Yap_ArithError(EVALUATION_ERROR_ZERO_DIVISOR, MkIntTerm(0), "// /2");
256 } else {
257 /* we do not handle MIN_INT */
258 mpz_fdiv_q_ui(&new, &new, -i);
259 mpz_neg(&new, &new);
260 }
261 }
262 return MkBigAndClose(&new);
263 } else {
264 MP_RAT new;
265 MP_RAT *b = Yap_BigRatOfTerm(t);
266
267 mpq_init(&new);
268 mpq_set_si(&new, i, 1L);
269 mpq_div(&new, b, &new);
270 return MkRatAndClose(&new);
271 }
272}
273
274/* div b / i using temporary bigint new */
275Term
276Yap_gmp_div2_big_int(Term t, Int i)
277{
278 CELL *pt = RepAppl(t);
279 if (pt[1] == BIG_INT) {
280 MP_INT new;
281 MP_INT *b = Yap_BigIntOfTerm(t);
282
283 mpz_init_set(&new, b);
284 if (i > 0) {
285 mpz_fdiv_q_ui(&new, &new, i);
286 } else if (i == 0) {
287 Yap_ArithError(EVALUATION_ERROR_ZERO_DIVISOR, MkIntTerm(0), "// /2");
288 } else {
289 /* we do not handle MIN_INT */
290 mpz_fdiv_q_ui(&new, &new, -i);
291 mpz_neg(&new, &new);
292 }
293 return MkBigAndClose(&new);
294 } else {
295 MP_RAT new;
296 MP_RAT *b = Yap_BigRatOfTerm(t);
297
298 mpq_init(&new);
299 mpq_set_si(&new, i, 1L);
300 mpq_div(&new, b, &new);
301 return MkRatAndClose(&new);
302 }
303}
304
305/* and i - b using temporary bigint new */
306Term
307Yap_gmp_and_int_big(Int i, Term t)
308{
309 MP_INT new;
310 CELL *pt = RepAppl(t);
311 MP_INT *b;
312 if (pt[1] != BIG_INT) {
313 Yap_ArithError(TYPE_ERROR_INTEGER, t, "/\\/2");
314 }
315 b = Yap_BigIntOfTerm(t);
316
317 mpz_init_set_si(&new, i);
318 mpz_and(&new, &new, b);
319 return MkBigAndClose(&new);
320}
321
322/* or i - b using temporary bigint new */
323Term
324Yap_gmp_ior_int_big(Int i, Term t)
325{
326 MP_INT new;
327 CELL *pt = RepAppl(t);
328 MP_INT *b;
329 if (pt[1] != BIG_INT) {
330 Yap_ArithError(TYPE_ERROR_INTEGER, t, "\\/ /2");
331 }
332 b = Yap_BigIntOfTerm(t);
333
334 mpz_init_set_si(&new, i);
335 mpz_ior(&new, &new, b);
336 return MkBigAndClose(&new);
337}
338
339// cross-compilers...
340#if !defined(HAVE_MPZ_XOR) && !defined(mpz_xor)
341static void
342mpz_xor(MP_INT *new, MP_INT *r1, MP_INT *r2)
343{
344 MP_INT *n2, *n3;
345
346 mpz_new(n2);
347 mpz_new(n3);
348 mpz_ior(new, r1, r2);
349 mpz_com(n2, r1);
350 mpz_and(n2, n2, new);
351 mpz_com(n3, r2);
352 mpz_and(n3, n3, new);
353 mpz_ior(new, n2, n3);
354 mpz_clear(n2);
355 mpz_clear(n3);
356}
357#endif
358
359/* or i - b using temporary bigint new */
360Term
361Yap_gmp_xor_int_big(Int i, Term t)
362{
363 MP_INT new;
364 CELL *pt = RepAppl(t);
365 MP_INT *b;
366 if (pt[1] != BIG_INT) {
367 Yap_ArithError(TYPE_ERROR_INTEGER, t, "#/2");
368 }
369 b = Yap_BigIntOfTerm(t);
370
371 mpz_init_set_si(&new,i);
372 mpz_xor(&new, &new, b);
373 return MkBigAndClose(&new);
374}
375
376/* <<< i + b using temporary bigint new */
377Term
378Yap_gmp_sll_big_int(Term t, Int i)
379{
380 CELL *pt = RepAppl(t);
381 if (pt[1] == BIG_INT) {
382 MP_INT new;
383 MP_INT *b = Yap_BigIntOfTerm(t);
384
385 if (i > 0) {
386 mpz_init(&new);
387 mpz_mul_2exp(&new, b, i);
388 } else if (i == 0) {
389 return t;
390 } else {
391 mpz_init(&new);
392 if (i == Int_MIN) {
393 CACHE_REGS
394 Yap_ArithError(RESOURCE_ERROR_HUGE_INT, MkIntegerTerm(i), "<</2");
395 }
396 mpz_fdiv_q_2exp(&new, b, -i);
397 }
398 return MkBigAndClose(&new);
399 } else {
400 MP_RAT new;
401 MP_RAT *b = Yap_BigRatOfTerm(t);
402
403 if (i > 0) {
404 mpq_init(&new);
405 mpq_mul_2exp (&new, b, i);
406 } else if (i == 0) {
407 return t;
408 } else {
409 mpq_init(&new);
410 mpq_div_2exp (&new, b, i);
411 }
412 return MkRatAndClose(&new);
413 }
414}
415
416Term
417Yap_gmp_add_big_big(Term t1, Term t2)
418{
419 CELL *pt1 = RepAppl(t1);
420 CELL *pt2 = RepAppl(t2);
421 if (pt1[1] == BIG_INT && pt2[1] == BIG_INT) {
422 MP_INT new;
423 MP_INT *b1 = Yap_BigIntOfTerm(t1);
424 MP_INT *b2 = Yap_BigIntOfTerm(t2);
425
426 mpz_init_set(&new, b1);
427 mpz_add(&new, &new, b2);
428 return MkBigAndClose(&new);
429 } else {
430 MP_RAT new;
431 MP_RAT *b1, bb1;
432 MP_RAT *b2, bb2;
433 if (pt1[1] == BIG_INT) {
434 b1 = &bb1;
435 mpq_init(b1);
436 mpq_set_z(b1, Yap_BigIntOfTerm(t1));
437 } else {
438 b1 = Yap_BigRatOfTerm(t1);
439 }
440 if (pt2[1] == BIG_INT) {
441 b2 = &bb2;
442 mpq_init(b2);
443 mpq_set_z(b2, Yap_BigIntOfTerm(t2));
444 } else {
445 b2 = Yap_BigRatOfTerm(t2);
446 }
447 mpq_init(&new);
448 mpq_add(&new, b1, b2);
449 return MkRatAndClose(&new);
450 }
451}
452
453Term
454Yap_gmp_sub_big_big(Term t1, Term t2)
455{
456 CELL *pt1 = RepAppl(t1);
457 CELL *pt2 = RepAppl(t2);
458 if (pt1[1] == BIG_INT && pt2[1] == BIG_INT) {
459 MP_INT new;
460 MP_INT *b1 = Yap_BigIntOfTerm(t1);
461 MP_INT *b2 = Yap_BigIntOfTerm(t2);
462
463 mpz_init_set(&new, b1);
464 mpz_sub(&new, &new, b2);
465 return MkBigAndClose(&new);
466 } else {
467 MP_RAT new;
468 MP_RAT *b1, bb1;
469 MP_RAT *b2, bb2;
470 if (pt1[1] == BIG_INT) {
471 b1 = &bb1;
472 mpq_init(b1);
473 mpq_set_z(b1, Yap_BigIntOfTerm(t1));
474 } else {
475 b1 = Yap_BigRatOfTerm(t1);
476 }
477 if (pt2[1] == BIG_INT) {
478 b2 = &bb2;
479 mpq_init(b2);
480 mpq_set_z(b2, Yap_BigIntOfTerm(t2));
481 } else {
482 b2 = Yap_BigRatOfTerm(t2);
483 }
484 mpq_init(&new);
485 mpq_sub(&new, b1, b2);
486 return MkRatAndClose(&new);
487 }
488}
489
490Term
491Yap_gmp_mul_big_big(Term t1, Term t2)
492{
493 CELL *pt1 = RepAppl(t1);
494 CELL *pt2 = RepAppl(t2);
495 if (pt1[1] == BIG_INT && pt2[1] == BIG_INT) {
496 MP_INT new;
497 MP_INT *b1 = Yap_BigIntOfTerm(t1);
498 MP_INT *b2 = Yap_BigIntOfTerm(t2);
499
500 mpz_init_set(&new, b1);
501 mpz_mul(&new, &new, b2);
502 return MkBigAndClose(&new);
503 } else {
504 MP_RAT new;
505 MP_RAT *b1, bb1;
506 MP_RAT *b2, bb2;
507 int f1 = FALSE, f2 = FALSE;
508
509 if (pt1[1] == BIG_INT) {
510 b1 = &bb1;
511 mpq_init(b1);
512 mpq_set_z(b1, Yap_BigIntOfTerm(t1));
513 f1 = TRUE;
514 } else {
515 b1 = Yap_BigRatOfTerm(t1);
516 }
517 if (pt2[1] == BIG_INT) {
518 b2 = &bb2;
519 mpq_init(b2);
520 mpq_set_z(b2, Yap_BigIntOfTerm(t2));
521 f2 = TRUE;
522 } else {
523 b2 = Yap_BigRatOfTerm(t2);
524 }
525 mpq_init(&new);
526 mpq_mul(&new, b1, b2);
527 if (f1) mpq_clear(b1);
528 if (f2) mpq_clear(b2);
529 return MkRatAndClose(&new);
530 }
531}
532
533/* div i / b using temporary bigint new */
534Term
535Yap_gmp_div_big_big(Term t1, Term t2)
536{
537 CELL *pt1 = RepAppl(t1);
538 CELL *pt2 = RepAppl(t2);
539 if (pt1[1] == BIG_INT && pt2[1] == BIG_INT) {
540 MP_INT new;
541 MP_INT *b1 = Yap_BigIntOfTerm(t1);
542 MP_INT *b2 = Yap_BigIntOfTerm(t2);
543
544 mpz_init_set(&new, b1);
545 if ( (-3 / 2) == -2 ) {
546 mpz_tdiv_q(&new, &new, b2);
547 } else {
548 mpz_fdiv_q(&new, &new, b2);
549 }
550 return MkBigAndClose(&new);
551 } else {
552 MP_RAT new;
553 MP_RAT *b1, bb1;
554 MP_RAT *b2, bb2;
555 if (pt1[1] == BIG_INT) {
556 b1 = &bb1;
557 mpq_init(b1);
558 mpq_set_z(b1, Yap_BigIntOfTerm(t1));
559 } else {
560 b1 = Yap_BigRatOfTerm(t1);
561 }
562 if (pt2[1] == BIG_INT) {
563 b2 = &bb2;
564 mpq_init(b2);
565 mpq_set_z(b2, Yap_BigIntOfTerm(t2));
566 } else {
567 b2 = Yap_BigRatOfTerm(t2);
568 }
569 mpq_init(&new);
570 mpq_div(&new, b1, b2);
571 return MkRatAndClose(&new);
572 }
573}
574
575/* div i div b using temporary bigint new */
576Term
577Yap_gmp_div2_big_big(Term t1, Term t2)
578{
579 CELL *pt1 = RepAppl(t1);
580 CELL *pt2 = RepAppl(t2);
581 if (pt1[1] == BIG_INT && pt2[1] == BIG_INT) {
582 MP_INT new;
583 MP_INT *b1 = Yap_BigIntOfTerm(t1);
584 MP_INT *b2 = Yap_BigIntOfTerm(t2);
585
586 mpz_init_set(&new, b1);
587 mpz_fdiv_q(&new, &new, b2);
588 return MkBigAndClose(&new);
589 } else {
590 MP_RAT new;
591 MP_RAT *b1, bb1;
592 MP_RAT *b2, bb2;
593 if (pt1[1] == BIG_INT) {
594 b1 = &bb1;
595 mpq_init(b1);
596 mpq_set_z(b1, Yap_BigIntOfTerm(t1));
597 } else {
598 b1 = Yap_BigRatOfTerm(t1);
599 }
600 if (pt2[1] == BIG_INT) {
601 b2 = &bb2;
602 mpq_init(b2);
603 mpq_set_z(b2, Yap_BigIntOfTerm(t2));
604 } else {
605 b2 = Yap_BigRatOfTerm(t2);
606 }
607 mpq_init(&new);
608 mpq_div(&new, b1, b2);
609 return MkRatAndClose(&new);
610 }
611}
612
613Term
614Yap_gmp_and_big_big(Term t1, Term t2)
615{
616 CELL *pt1 = RepAppl(t1);
617 CELL *pt2 = RepAppl(t2);
618 if (pt1[1] == BIG_INT && pt2[1] == BIG_INT) {
619 MP_INT new;
620 MP_INT *b1 = Yap_BigIntOfTerm(t1);
621 MP_INT *b2 = Yap_BigIntOfTerm(t2);
622
623 mpz_init_set(&new, b1);
624 mpz_and(&new, &new, b2);
625 return MkBigAndClose(&new);
626 } else {
627 if (pt1[1] != BIG_INT) {
628 Yap_ArithError(TYPE_ERROR_INTEGER, t1, "/\\/2");
629 }
630 }
631 Yap_ArithError(TYPE_ERROR_INTEGER, t2, "/\\/2");
632}
633
634Term
635Yap_gmp_ior_big_big(Term t1, Term t2)
636{
637 CELL *pt1 = RepAppl(t1);
638 CELL *pt2 = RepAppl(t2);
639 if (pt1[1] == BIG_INT && pt2[1] == BIG_INT) {
640 MP_INT new;
641 MP_INT *b1 = Yap_BigIntOfTerm(t1);
642 MP_INT *b2 = Yap_BigIntOfTerm(t2);
643
644 mpz_init_set(&new, b1);
645 mpz_ior(&new, &new, b2);
646 return MkBigAndClose(&new);
647 } else {
648 if (pt1[1] != BIG_INT) {
649 Yap_ArithError(TYPE_ERROR_INTEGER, t1, "\\/ /2");
650 }
651 }
652 Yap_ArithError(TYPE_ERROR_INTEGER, t2, "\\/ /2");
653}
654
655Term
656Yap_gmp_xor_big_big(Term t1, Term t2)
657{
658 CELL *pt1 = RepAppl(t1);
659 CELL *pt2 = RepAppl(t2);
660 if (pt1[1] == BIG_INT && pt2[1] == BIG_INT) {
661 MP_INT new;
662 MP_INT *b1 = Yap_BigIntOfTerm(t1);
663 MP_INT *b2 = Yap_BigIntOfTerm(t2);
664
665 mpz_init_set(&new, b1);
666 mpz_xor(&new, &new, b2);
667 return MkBigAndClose(&new);
668 } else {
669 if (pt1[1] != BIG_INT) {
670 Yap_ArithError(TYPE_ERROR_INTEGER, t1, "\\/ /2");
671 }
672 }
673 Yap_ArithError(TYPE_ERROR_INTEGER, t2, "\\/ /2");
674}
675
676Term
677Yap_gmp_mod_big_big(Term t1, Term t2)
678{
679 CELL *pt1 = RepAppl(t1);
680 CELL *pt2 = RepAppl(t2);
681 if (pt1[1] == BIG_INT && pt2[1] == BIG_INT) {
682 MP_INT new;
683 MP_INT *b1 = Yap_BigIntOfTerm(t1);
684 MP_INT *b2 = Yap_BigIntOfTerm(t2);
685
686 mpz_init(&new);
687 mpz_fdiv_r(&new, b1, b2);
688 return MkBigAndClose(&new);
689 } else {
690 if (pt1[1] != BIG_INT) {
691 Yap_ArithError(TYPE_ERROR_INTEGER, t1, "mod/2");
692 }
693 }
694 Yap_ArithError(TYPE_ERROR_INTEGER, t2, "mod/2");
695}
696
697Term
698Yap_gmp_mod_big_int(Term t, Int i2)
699{
700 CELL *pt = RepAppl(t);
701 if (pt[1] != BIG_INT) {
702 Yap_ArithError(TYPE_ERROR_INTEGER, t, "mod/2");
703 } else {
704 MP_INT *b = Yap_BigIntOfTerm(t);
705 MP_INT new;
706
707 mpz_init_set_si(&new, i2);
708 mpz_fdiv_r(&new, b, &new);
709 return MkBigAndClose(&new);
710 }
711}
712
713Term
714Yap_gmp_mod_int_big(Int i1, Term t)
715{
716 CACHE_REGS
717 CELL *pt = RepAppl(t);
718 if (pt[1] != BIG_INT) {
719 Yap_ArithError(TYPE_ERROR_INTEGER, t, "mod/2");
720 } else {
721 MP_INT *b = Yap_BigIntOfTerm(t);
722 /* integer is much smaller */
723
724 if (mpz_sgn(b) > 0) {
725 /* easy case next */
726 if (i1 > 0) {
727 /* 2 mod 23 -> 2 */
728 return MkIntegerTerm(i1);
729 } else {
730 MP_INT new;
731
732 /* 2 mod -23 -> 21 */
733 mpz_init_set_si(&new, i1);
734 mpz_add(&new, &new, b);
735 return MkBigAndClose(&new);
736 }
737 } else {
738 if (i1 > 0) {
739 MP_INT new;
740
741 /* -2 mod 23 -> 21 */
742 mpz_init_set_si(&new, i1);
743 mpz_add(&new, b, &new);
744 return MkBigAndClose(&new);
745 } else {
746 /* -2 mod -23 -> -2 */
747 return MkIntegerTerm(i1);
748 }
749 }
750 }
751}
752
753Term
754Yap_gmp_rem_big_big(Term t1, Term t2)
755{
756 CELL *pt1 = RepAppl(t1);
757 CELL *pt2 = RepAppl(t2);
758 if (pt1[1] == BIG_INT && pt2[1] == BIG_INT) {
759 MP_INT new;
760 MP_INT *b1 = Yap_BigIntOfTerm(t1);
761 MP_INT *b2 = Yap_BigIntOfTerm(t2);
762
763 mpz_init(&new);
764 mpz_tdiv_r(&new, b1, b2);
765 return MkBigAndClose(&new);
766 } else {
767 if (pt1[1] != BIG_INT) {
768 Yap_ArithError(TYPE_ERROR_INTEGER, t1, "rem/2");
769 }
770 Yap_ArithError(TYPE_ERROR_INTEGER, t2, "rem/2");
771 }
772}
773
774Term
775Yap_gmp_rem_big_int(Term t, Int i2)
776{
777 CELL *pt = RepAppl(t);
778 if (pt[1] != BIG_INT) {
779 Yap_ArithError(TYPE_ERROR_INTEGER, t, "rem/2");
780 } else {
781 MP_INT *b = Yap_BigIntOfTerm(t);
782 MP_INT new;
783
784 mpz_init_set_si(&new, i2);
785 mpz_tdiv_r(&new, b, &new);
786 return MkBigAndClose(&new);
787 }
788}
789
790Term
791Yap_gmp_rem_int_big(Int i1, Term t)
792{
793 CACHE_REGS
794 CELL *pt = RepAppl(t);
795 if (pt[1] != BIG_INT) {
796 Yap_ArithError(TYPE_ERROR_INTEGER, t, "rem/2");
797 } else {
798 /* integer is much smaller */
799 return MkIntegerTerm(i1);
800 }
801}
802
803Term
804Yap_gmp_gcd_big_big(Term t1, Term t2)
805{
806 CELL *pt1 = RepAppl(t1);
807 CELL *pt2 = RepAppl(t2);
808 if (pt1[1] == BIG_INT && pt2[1] == BIG_INT) {
809 MP_INT new;
810 MP_INT *b1 = Yap_BigIntOfTerm(t1);
811 MP_INT *b2 = Yap_BigIntOfTerm(t2);
812
813 mpz_init_set(&new, b1);
814 mpz_gcd(&new, &new, b2);
815 return MkBigAndClose(&new);
816 } else {
817 if (pt1[1] != BIG_INT) {
818 Yap_ArithError(TYPE_ERROR_INTEGER, t1, "gcd/2");
819 }
820 Yap_ArithError(TYPE_ERROR_INTEGER, t2, "gcd/2");
821 }
822}
823
824Term
825Yap_gmp_gcd_int_big(Int i, Term t)
826{
827 CACHE_REGS
828 CELL *pt = RepAppl(t);
829 if (pt[1] != BIG_INT) {
830 Yap_ArithError(TYPE_ERROR_INTEGER, t, "gcd/2");
831 } else {
832 /* integer is much smaller */
833 if (i > 0) {
834 return MkIntegerTerm(mpz_gcd_ui(NULL,Yap_BigIntOfTerm(t),i));
835 } else if (i == 0) {
836 return MkIntTerm(0);
837 } else {
838 return MkIntegerTerm(mpz_gcd_ui(NULL,Yap_BigIntOfTerm(t),-i));
839 }
840 }
841}
842
843Term
844Yap_gmp_float_to_big(Float v)
845{
846 MP_INT new;
847
848 mpz_init_set_d(&new, v);
849 return MkBigAndClose(&new);
850}
851
852Float
853Yap_gmp_to_float(Term t)
854{
855 CELL *pt = RepAppl(t);
856 if (pt[1] == BIG_INT) {
857 MP_INT *b = Yap_BigIntOfTerm(t);
858 return mpz_get_d(b);
859 } else {
860 MP_RAT *b = Yap_BigRatOfTerm(t);
861 return mpq_get_d(b);
862 }
863}
864
865Term
866Yap_gmp_add_float_big(Float d, Term t)
867{
868 CACHE_REGS
869 CELL *pt = RepAppl(t);
870 if (pt[1] == BIG_INT) {
871 MP_INT *b = Yap_BigIntOfTerm(t);
872 return MkFloatTerm(d+mpz_get_d(b));
873 } else {
874 MP_RAT *b = Yap_BigRatOfTerm(t);
875 return MkFloatTerm(d+mpq_get_d(b));
876 }
877}
878
879Term
880Yap_gmp_sub_float_big(Float d, Term t)
881{
882 CACHE_REGS
883 CELL *pt = RepAppl(t);
884 if (pt[1] == BIG_INT) {
885 MP_INT *b = Yap_BigIntOfTerm(t);
886 return MkFloatTerm(d-mpz_get_d(b));
887 } else {
888 MP_RAT *b = Yap_BigRatOfTerm(t);
889 return MkFloatTerm(d-mpq_get_d(b));
890 }
891}
892
893Term
894Yap_gmp_sub_big_float(Term t, Float d)
895{
896 CACHE_REGS
897 CELL *pt = RepAppl(t);
898 if (pt[1] == BIG_INT) {
899 MP_INT *b = Yap_BigIntOfTerm(t);
900 return MkFloatTerm(mpz_get_d(b)-d);
901 } else {
902 MP_RAT *b = Yap_BigRatOfTerm(t);
903 return MkFloatTerm(mpq_get_d(b)-d);
904 }
905}
906
907Term
908Yap_gmp_mul_float_big(Float d, Term t)
909{
910 CACHE_REGS
911 CELL *pt = RepAppl(t);
912 if (pt[1] == BIG_INT) {
913 MP_INT *b = Yap_BigIntOfTerm(t);
914 return MkFloatTerm(d*mpz_get_d(b));
915 } else {
916 MP_RAT *b = Yap_BigRatOfTerm(t);
917 return MkFloatTerm(d*mpq_get_d(b));
918 }
919}
920
921Term
922Yap_gmp_fdiv_float_big(Float d, Term t)
923{
924 CACHE_REGS
925 CELL *pt = RepAppl(t);
926 if (pt[1] == BIG_INT) {
927 MP_INT *b = Yap_BigIntOfTerm(t);
928 return MkFloatTerm(d/mpz_get_d(b));
929 } else {
930 MP_RAT *b = Yap_BigRatOfTerm(t);
931 return MkFloatTerm(d/mpq_get_d(b));
932 }
933}
934
935Term
936Yap_gmp_fdiv_big_float(Term t, Float d)
937{
938 CACHE_REGS
939 CELL *pt = RepAppl(t);
940 if (pt[1] == BIG_INT) {
941 MP_INT *b = Yap_BigIntOfTerm(t);
942 return MkFloatTerm(mpz_get_d(b)/d);
943 } else {
944 MP_RAT *b = Yap_BigRatOfTerm(t);
945 return MkFloatTerm(mpq_get_d(b)/d);
946 }
947}
948
949Term
950Yap_gmp_exp_int_int(Int i1, Int i2)
951{
952 MP_INT new;
953
954 mpz_init_set_si(&new, i1);
955 mpz_pow_ui (&new, &new, (unsigned long int)i2);
956 return MkBigAndClose(&new);
957}
958
959Term
960Yap_gmp_exp_big_int(Term t, Int i)
961{
962 CACHE_REGS
963 MP_INT new;
964
965 CELL *pt = RepAppl(t);
966 if (pt[1] == BIG_INT) {
967 MP_INT *b = Yap_BigIntOfTerm(t);
968
969 if (i > 0) {
970 mpz_init(&new);
971 mpz_pow_ui (&new, b, (unsigned long int)i);
972 } else {
973 MP_INT new;
974 if (i==0) return MkIntTerm(1);
975 mpz_init_set_si(&new, i);
976 mpz_powm (&new, b, &new, b);
977 }
978 return MkBigAndClose(&new);
979 } else {
980 MP_RAT *b = Yap_BigRatOfTerm(t);
981 Float dbl = mpq_get_d(b);
982 return MkFloatTerm(pow(dbl,i));
983 }
984}
985
986Term
987Yap_gmp_exp_int_big(Int i, Term t)
988{
989 CACHE_REGS
990 CELL *pt = RepAppl(t);
991 if (pt[1] == BIG_INT) {
992 Yap_ArithError(RESOURCE_ERROR_HUGE_INT, t, "^/2");
993 } else {
994 MP_INT *b = Yap_BigIntOfTerm(t);
995 Float dbl = mpz_get_d(b);
996 return MkFloatTerm(pow(i,dbl));
997 }
998}
999
1000Term
1001Yap_gmp_exp_big_big(Term t1, Term t2)
1002{
1003 CACHE_REGS
1004 CELL *pt1 = RepAppl(t1);
1005 CELL *pt2 = RepAppl(t2);
1006 Float dbl1, dbl2;
1007
1008 if (pt1[1] == BIG_INT && pt2[1] == BIG_INT) {
1009 Yap_ArithError(RESOURCE_ERROR_HUGE_INT, t2, "^/2");
1010 } else {
1011 if (pt1[1] != BIG_INT) {
1012 dbl1 = mpz_get_d(Yap_BigIntOfTerm(t1));
1013 } else {
1014 dbl1 = mpq_get_d(Yap_BigRatOfTerm(t1));
1015 }
1016 if (pt2[2] != BIG_INT) {
1017 dbl2 = mpz_get_d(Yap_BigIntOfTerm(t2));
1018 } else {
1019 dbl2 = mpq_get_d(Yap_BigRatOfTerm(t2));
1020 }
1021 return MkFloatTerm(pow(dbl1,dbl2));
1022 }
1023}
1024
1025
1026Term
1027Yap_gmp_big_from_64bits(YAP_LONG_LONG i)
1028{
1029 char s[64];
1030 MP_INT new;
1031
1032#ifdef _WIN32
1033 snprintf(s,64,"%I64d", (long long int)i);
1034#elif HAVE_SNPRINTF
1035 snprintf(s, 64, "%lld", (long long int)i);
1036#else
1037 sprintf(s, "%lld", (long long int)i);
1038#endif
1039 mpz_init_set_str (&new, s, 10);
1040 return MkBigAndClose(&new);
1041}
1042
1043Term
1044Yap_gmq_rdiv_int_int(Int i1, Int i2)
1045{
1046 MP_RAT new;
1047
1048 mpq_init(&new);
1049 if (i2 < 0) {
1050 i1 = -i1;
1051 i2 = -i2;
1052 }
1053 mpq_set_si(&new, i1, i2);
1054 mpq_canonicalize(&new);
1055 return MkRatAndClose(&new);
1056}
1057
1058Term
1059Yap_gmq_rdiv_int_big(Int i1, Term t2)
1060{
1061 MP_RAT new;
1062 CELL *pt2 = RepAppl(t2);
1063 mpq_init(&new);
1064 mpq_set_si(&new, i1, 1L);
1065 if (pt2[1] == BIG_INT) {
1066 MP_RAT new2;
1067 MP_INT *b = Yap_BigIntOfTerm(t2);
1068
1069 mpq_init(&new2);
1070 mpq_set_z(&new2, b);
1071 mpq_div(&new,&new,&new2);
1072 mpq_clear(&new2);
1073 } else {
1074 MP_RAT *b = Yap_BigRatOfTerm(t2);
1075 mpq_div(&new,&new,b);
1076 }
1077 return MkRatAndClose(&new);
1078}
1079
1080Term
1081Yap_gmq_rdiv_big_int(Term t1, Int i2)
1082{
1083 MP_RAT new;
1084 CELL *pt1 = RepAppl(t1);
1085
1086 mpq_init(&new);
1087 mpq_set_si(&new, i2, 1L);
1088 if (pt1[1] == BIG_INT) {
1089 MP_INT *b = Yap_BigIntOfTerm(t1);
1090 MP_RAT new2;
1091
1092 mpq_init(&new2);
1093 mpq_set_z(&new2, b);
1094 mpq_div(&new,&new2,&new);
1095 mpq_clear(&new2);
1096 } else {
1097 MP_RAT *b = Yap_BigRatOfTerm(t1);
1098
1099 mpq_div(&new,b,&new);
1100 }
1101 return MkRatAndClose(&new);
1102}
1103
1104Term
1105Yap_gmq_rdiv_big_big(Term t1, Term t2)
1106{
1107 MP_RAT new;
1108 CELL *pt1 = RepAppl(t1);
1109 CELL *pt2 = RepAppl(t2);
1110
1111 mpq_init(&new);
1112 if (pt1[1] == BIG_INT) {
1113 MP_INT *b1 = Yap_BigIntOfTerm(t1);
1114 mpq_set_z(&new, b1);
1115 } else {
1116 MP_RAT *b1 = Yap_BigRatOfTerm(t1);
1117 mpq_set(&new, b1);
1118 }
1119
1120 if (pt2[1] == BIG_INT) {
1121 MP_RAT new2;
1122 MP_INT *b2 = Yap_BigIntOfTerm(t2);
1123
1124 mpq_init(&new2);
1125 mpq_set_z(&new2, b2);
1126 mpq_div(&new,&new,&new2);
1127 mpq_clear(&new2);
1128 } else {
1129 MP_RAT *b2 = Yap_BigRatOfTerm(t2);
1130 mpq_div(&new,&new,b2);
1131 }
1132 return MkRatAndClose(&new);
1133}
1134
1135Term
1136Yap_gmp_fdiv_int_big(Int i1, Term t2)
1137{
1138 CACHE_REGS
1139 MP_RAT new;
1140 MP_RAT *b1, *b2;
1141 MP_RAT bb1, bb2;
1142 Float d;
1143 CELL *pt2 = RepAppl(t2);
1144
1145 b1 = &bb1;
1146 mpq_init(b1);
1147 mpq_set_si(b1, i1, 1L);
1148 if (pt2[1] == BIG_INT) {
1149 b2 = &bb2;
1150 mpq_init(b2);
1151 mpq_set_z(b2, Yap_BigIntOfTerm(t2));
1152 } else {
1153 b2 = Yap_BigRatOfTerm(t2);
1154 }
1155 mpq_init(&new);
1156 mpq_div(&new, b1, b2);
1157 d = mpq_get_d(&new);
1158 mpq_clear(&new);
1159 return MkFloatTerm(d);
1160}
1161
1162Term
1163Yap_gmp_fdiv_big_int(Term t2, Int i1)
1164{
1165 CACHE_REGS
1166 MP_RAT new;
1167 MP_RAT *b1, *b2;
1168 MP_RAT bb1, bb2;
1169 Float d;
1170 CELL *pt2 = RepAppl(t2);
1171
1172 b1 = &bb1;
1173 mpq_init(b1);
1174 mpq_set_si(b1, i1, 1L);
1175 if (pt2[1] == BIG_INT) {
1176 b2 = &bb2;
1177 mpq_init(b2);
1178 mpq_set_z(b2, Yap_BigIntOfTerm(t2));
1179 } else {
1180 b2 = Yap_BigRatOfTerm(t2);
1181 }
1182 mpq_init(&new);
1183 mpq_div(&new, b2, b1);
1184 d = mpq_get_d(&new);
1185 mpq_clear(&new);
1186 return MkFloatTerm(d);
1187}
1188
1189Term
1190Yap_gmp_fdiv_big_big(Term t1, Term t2)
1191{
1192 CACHE_REGS
1193 CELL *pt1 = RepAppl(t1);
1194 CELL *pt2 = RepAppl(t2);
1195 MP_RAT new;
1196 MP_RAT *b1, bb1;
1197 MP_RAT *b2, bb2;
1198 Float d;
1199
1200 if (pt1[1] == BIG_INT) {
1201 b1 = &bb1;
1202 mpq_init(b1);
1203 mpq_set_z(b1, Yap_BigIntOfTerm(t1));
1204 } else {
1205 b1 = Yap_BigRatOfTerm(t1);
1206 }
1207 if (pt2[1] == BIG_INT) {
1208 b2 = &bb2;
1209 mpq_init(b2);
1210 mpq_set_z(b2, Yap_BigIntOfTerm(t2));
1211 } else {
1212 b2 = Yap_BigRatOfTerm(t2);
1213 }
1214 mpq_init(&new);
1215 mpq_div(&new, b1, b2);
1216 d = mpq_get_d(&new);
1217 mpq_clear(&new);
1218 return MkFloatTerm(d);
1219}
1220
1221int
1222Yap_gmp_cmp_big_int(Term t, Int i)
1223{
1224 CELL *pt = RepAppl(t);
1225 if (pt[1] == BIG_INT) {
1226 MP_INT *b = Yap_BigIntOfTerm(t);
1227 return mpz_cmp_si(b,i);
1228 } else {
1229 MP_RAT *b = Yap_BigRatOfTerm(t);
1230 return mpq_cmp_si(b,i,1);
1231 }
1232}
1233
1234int
1235Yap_gmp_cmp_int_big(Int i, Term t)
1236{
1237 CELL *pt = RepAppl(t);
1238 if (pt[1] == BIG_INT) {
1239 MP_INT *b = Yap_BigIntOfTerm(t);
1240 return -mpz_cmp_si(b,i);
1241 } else {
1242 MP_RAT *b = Yap_BigRatOfTerm(t);
1243 return -mpq_cmp_si(b,i,1);
1244 }
1245}
1246
1247int
1248Yap_gmp_cmp_big_float(Term t, Float d)
1249{
1250 CELL *pt = RepAppl(t);
1251 if (pt[1] == BIG_INT) {
1252 MP_INT *b = Yap_BigIntOfTerm(t);
1253 return mpz_cmp_d(b,d);
1254 } else {
1255 MP_RAT *b = Yap_BigRatOfTerm(t);
1256 Float d1 = mpq_get_d(b);
1257 if (d1 < d)
1258 return -1;
1259 if (d1 == d)
1260 return 0;
1261 return 1;
1262 }
1263}
1264
1265int
1266Yap_gmp_cmp_big_big(Term t1, Term t2)
1267{
1268 CELL *pt1 = RepAppl(t1);
1269 CELL *pt2 = RepAppl(t2);
1270 if (pt1[1] == BIG_INT && pt2[1] == BIG_INT) {
1271 MP_INT *b1 = Yap_BigIntOfTerm(t1);
1272 MP_INT *b2 = Yap_BigIntOfTerm(t2);
1273
1274 return mpz_cmp(b1, b2);
1275 } else {
1276 MP_RAT *b1 = NULL, bb1;
1277 int f1 = FALSE;
1278 MP_RAT *b2 = NULL, bb2;
1279 int f2 = FALSE;
1280 if (pt1[1] == BIG_INT) {
1281 b1 = &bb1;
1282 f1 = TRUE;
1283 mpq_init(b1);
1284 mpq_set_z(b1, Yap_BigIntOfTerm(t1));
1285 } else {
1286 b1 = Yap_BigRatOfTerm(t1);
1287 }
1288 if (pt2[1] == BIG_INT) {
1289 b2 = &bb2;
1290 f2 = TRUE;
1291
1292 mpq_init(b2);
1293 mpq_set_z(b2, Yap_BigIntOfTerm(t2));
1294 } else {
1295 b2 = Yap_BigRatOfTerm(t2);
1296 }
1297 if (f1)
1298 mpq_clear(b1);
1299 if (f2)
1300 mpq_clear(b2);
1301 return mpq_cmp(b1, b2);
1302 }
1303}
1304
1305int
1306Yap_gmp_tcmp_big_int(Term t, Int i)
1307{
1308 CELL *pt = RepAppl(t);
1309 if (pt[1] == BIG_INT) {
1310 MP_INT *b = Yap_BigIntOfTerm(t);
1311 return mpz_cmp_si(b,i);
1312 } else {
1313 return -1;
1314 }
1315}
1316
1317int
1318Yap_gmp_tcmp_int_big(Int i, Term t)
1319{
1320 CELL *pt = RepAppl(t);
1321 if (pt[1] == BIG_INT) {
1322 MP_INT *b = Yap_BigIntOfTerm(t);
1323 return -mpz_cmp_si(b,i);
1324 } else {
1325 return 1;
1326 }
1327}
1328
1329int
1330Yap_gmp_tcmp_big_float(Term t, Float d)
1331{
1332 return 1;
1333}
1334
1335int
1336Yap_gmp_tcmp_big_big(Term t1, Term t2)
1337{
1338 CELL *pt1 = RepAppl(t1);
1339 CELL *pt2 = RepAppl(t2);
1340
1341 if (pt1[1] == BIG_INT && pt2[1] == BIG_INT) {
1342 MP_INT *b1 = Yap_BigIntOfTerm(t1);
1343 MP_INT *b2 = Yap_BigIntOfTerm(t2);
1344
1345 return mpz_cmp(b1, b2);
1346 } else {
1347 MP_RAT *b1, *b2;
1348
1349 if (pt1[1] == BIG_INT) {
1350 return 1;
1351 } else if (pt1[1] == BIG_RATIONAL) {
1352 b1 = Yap_BigRatOfTerm(t1);
1353 } else {
1354 return pt1-pt2;
1355 }
1356 if (pt2[1] == BIG_INT) {
1357 return -1;
1358 } else if (pt2[1] == BIG_RATIONAL) {
1359 b2 = Yap_BigRatOfTerm(t2);
1360 } else {
1361 return pt1-pt2;
1362 }
1363 return mpq_cmp(b1, b2);
1364 }
1365}
1366
1367Term
1368Yap_gmp_neg_int(Int i)
1369{
1370 MP_INT new;
1371
1372 mpz_init_set_si(&new, Int_MIN);
1373 mpz_neg(&new, &new);
1374 return MkBigAndClose(&new);
1375}
1376
1377Term
1378Yap_gmp_neg_big(Term t)
1379{
1380 CELL *pt = RepAppl(t);
1381 if (pt[1] == BIG_INT) {
1382 MP_INT *b = Yap_BigIntOfTerm(t);
1383 MP_INT new;
1384 mpz_init_set(&new, b);
1385 mpz_neg(&new, &new);
1386 return MkBigAndClose(&new);
1387 } else {
1388 MP_RAT *b = Yap_BigRatOfTerm(t);
1389 MP_RAT new;
1390 mpq_init(&new);
1391 mpq_neg(&new, b);
1392 return MkRatAndClose(&new);
1393 }
1394}
1395
1396Term
1397Yap_gmp_float_to_rational(Float dbl)
1398{
1399 MP_RAT new;
1400 mpq_init(&new);
1401 mpq_set_d(&new, dbl);
1402 return MkRatAndClose(&new);
1403}
1404
1405/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
1406A is rationalize(Float)
1407
1408Introduced on the suggestion of Richard O'Keefe after the Common Lisp
1409standard. The algorithm is taken from figure 3 in ``A Rational Rotation
1410Method for Robust Geometric Algorithms'' by John Canny, Bruce Donald and
1411Eugene K. Ressler. Found at
1412
1413http://www.cs.dartmouth.edu/~brd/papers/rotations-scg92.pdf
1414- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
1415
1416#ifndef DBL_EPSILON /* normal for IEEE 64-bit double */
1417#define DBL_EPSILON 0.00000000000000022204
1418#endif
1419
1420Term
1421Yap_gmp_float_rationalize(Float dbl)
1422{
1423 Float e0 = dbl, p0 = 0.0, q0 = 1.0;
1424 Float e1 = -1.0, p1 = 1.0, q1 = 0.0;
1425 Float d;
1426 MP_RAT new;
1427
1428 do { Float r = floor(e0/e1);
1429 Float e00 = e0, p00 = p0, q00 = q0;
1430 e0 = e1;
1431 p0 = p1;
1432 q0 = q1;
1433 e1 = e00 - r*e1;
1434 p1 = p00 - r*p1;
1435 q1 = q00 - r*q1;
1436
1437 d = p1/q1 - dbl;
1438 } while(fabs(d) > DBL_EPSILON);
1439
1440 mpz_init_set_d(mpq_numref(&new), p1);
1441 mpz_init_set_d(mpq_denref(&new), q1);
1442 mpq_canonicalize(&new); /* is this needed? */
1443 return MkRatAndClose(&new);
1444}
1445
1446Term
1447Yap_gmp_abs_big(Term t)
1448{
1449 CELL *pt = RepAppl(t);
1450 if (pt[1] == BIG_INT) {
1451 MP_INT *b = Yap_BigIntOfTerm(t);
1452 MP_INT new;
1453 mpz_init_set(&new, b);
1454 mpz_abs(&new, &new);
1455 return MkBigAndClose(&new);
1456 } else {
1457 MP_RAT *b = Yap_BigRatOfTerm(t);
1458 MP_RAT new;
1459 mpq_init(&new);
1460 mpq_abs(&new, b);
1461 return MkRatAndClose(&new);
1462 }
1463}
1464
1465Term
1466Yap_gmp_unot_big(Term t)
1467{
1468 CELL *pt = RepAppl(t);
1469 if (pt[1] == BIG_INT) {
1470 MP_INT *b = Yap_BigIntOfTerm(t);
1471 MP_INT new;
1472 mpz_init_set(&new, b);
1473 mpz_com(&new, &new);
1474 return MkBigAndClose(&new);
1475 } else {
1476 Yap_ArithError(TYPE_ERROR_INTEGER, t, "#/1");
1477 }
1478}
1479
1480Term
1481Yap_gmp_floor(Term t)
1482{
1483 CELL *pt = RepAppl(t);
1484 if (pt[1] == BIG_INT) {
1485 return t;
1486 } else {
1487 MP_RAT *b = Yap_BigRatOfTerm(t);
1488 MP_INT new;
1489 mpz_init(&new);
1490 mpz_set_q(&new, b);
1491 if (mpq_sgn(b) < 0 && mpz_cmp_si(mpq_denref(b),1L) != 0) {
1492 mpz_sub_ui(&new,&new,1L);
1493 }
1494 return MkBigAndClose(&new);
1495 }
1496}
1497
1498Term
1499Yap_gmp_ceiling(Term t)
1500{
1501 CELL *pt = RepAppl(t);
1502 if (pt[1] == BIG_INT) {
1503 return t;
1504 } else {
1505 MP_RAT *b = Yap_BigRatOfTerm(t);
1506 MP_INT new;
1507 mpz_init(&new);
1508 mpz_set_q(&new, b);
1509 if (mpq_sgn(b) > 0 && mpz_cmp_si(mpq_denref(b),1L) != 0) {
1510 mpz_add_ui(&new,&new,1L);
1511 }
1512 return MkBigAndClose(&new);
1513 }
1514}
1515
1516Term
1517Yap_gmp_round(Term t)
1518{
1519 CELL *pt = RepAppl(t);
1520 if (pt[1] == BIG_INT) {
1521 return t;
1522 } else {
1523 MP_RAT *b = Yap_BigRatOfTerm(t);
1524 MP_INT new;
1525 MP_RAT half, q;
1526
1527 mpq_init(&half);
1528 mpq_init(&q);
1529 mpq_set_ui(&half, 1, 2); /* 1/2 */
1530 if ( mpq_sgn(b) > 0 )
1531 mpq_add(&q, b, &half);
1532 else {
1533 mpq_sub(&q, b, &half);
1534 }
1535 mpz_init(&new);
1536 mpz_set_q(&new, &q);
1537 mpq_clear(&half);
1538 mpq_clear(&q);
1539 return MkBigAndClose(&new);
1540 }
1541}
1542
1543Term
1544Yap_gmp_trunc(Term t)
1545{
1546 CELL *pt = RepAppl(t);
1547 if (pt[1] == BIG_INT) {
1548 return t;
1549 } else {
1550 MP_RAT *b = Yap_BigRatOfTerm(t);
1551 MP_INT new;
1552 int sgn = mpq_sgn(b);
1553
1554 if (sgn)
1555 mpq_neg(b, b);
1556 mpz_init(&new);
1557 mpz_set_q(&new, b);
1558 if (sgn) {
1559 mpq_neg(b, b);
1560 mpz_neg(&new, &new);
1561 }
1562 return MkBigAndClose(&new);
1563 }
1564}
1565
1566Term
1567Yap_gmp_float_fractional_part(Term t)
1568{
1569 CELL *pt = RepAppl(t);
1570 if (pt[1] == BIG_INT) {
1571 Yap_ArithError(TYPE_ERROR_FLOAT, t, "X is float_fractional_part(%f)", FloatOfTerm(t));
1572 } else {
1573 MP_RAT *b = Yap_BigRatOfTerm(t);
1574 MP_RAT new;
1575
1576 mpq_init(&new);
1577 mpz_tdiv_q(mpq_numref(&new),
1578 mpq_numref(b),
1579 mpq_denref(b));
1580 mpz_set_ui(mpq_denref(&new), 1);
1581 mpq_sub(&new, b, &new);
1582 return MkRatAndClose(&new);
1583 }
1584}
1585
1586Term
1587Yap_gmp_float_integer_part(Term t)
1588{
1589 CELL *pt = RepAppl(t);
1590 if (pt[1] == BIG_INT) {
1591 Yap_ArithError(TYPE_ERROR_FLOAT, t, "X is float_integer_part(%f)", FloatOfTerm(t));
1592 } else {
1593 MP_RAT *b = Yap_BigRatOfTerm(t);
1594 MP_INT new;
1595
1596 mpz_init(&new);
1597 mpz_tdiv_q(&new,
1598 mpq_numref(b),
1599 mpq_denref(b));
1600 return MkBigAndClose(&new);
1601 }
1602}
1603
1604Term
1605Yap_gmp_sign(Term t)
1606{
1607 CACHE_REGS
1608 CELL *pt = RepAppl(t);
1609 if (pt[1] == BIG_INT) {
1610 return MkIntegerTerm(mpz_sgn(Yap_BigIntOfTerm(t)));
1611 } else {
1612 return MkIntegerTerm(mpq_sgn(Yap_BigRatOfTerm(t)));
1613 }
1614}
1615
1616Term
1617Yap_gmp_lsb(Term t)
1618{
1619 CACHE_REGS
1620 CELL *pt = RepAppl(t);
1621 if (pt[1] == BIG_INT) {
1622 MP_INT *big = Yap_BigIntOfTerm(t);
1623 if ( mpz_sgn(big) <= 0 ) {
1624 Yap_ArithError(DOMAIN_ERROR_NOT_LESS_THAN_ZERO, t,
1625 "lsb/1 received negative bignum");
1626 }
1627 return MkIntegerTerm(mpz_scan1(big,0));
1628 } else {
1629 Yap_ArithError(TYPE_ERROR_INTEGER, t, "lsb");
1630 }
1631}
1632
1633Term
1634Yap_gmp_msb(Term t)
1635{
1636 CACHE_REGS
1637 CELL *pt = RepAppl(t);
1638 if (pt[1] == BIG_INT) {
1639 MP_INT *big = Yap_BigIntOfTerm(t);
1640 if ( mpz_sgn(big) <= 0 ) {
1641 Yap_ArithError(DOMAIN_ERROR_NOT_LESS_THAN_ZERO, t,
1642 "msb/1 received negative bignum");
1643 }
1644 return MkIntegerTerm(mpz_sizeinbase(big,2));
1645 } else {
1646 Yap_ArithError(TYPE_ERROR_INTEGER, t, "popcount");
1647 }
1648}
1649
1650Term
1651Yap_gmp_popcount(Term t)
1652{
1653 CACHE_REGS
1654 CELL *pt = RepAppl(t);
1655 if (pt[1] == BIG_INT) {
1656 MP_INT *big = Yap_BigIntOfTerm(t);
1657 if ( mpz_sgn(big) <= 0 ) {
1658 Yap_ArithError(DOMAIN_ERROR_NOT_LESS_THAN_ZERO, t,
1659 "popcount/1 received negative bignum");
1660 }
1661 return MkIntegerTerm(mpz_popcount(big));
1662 } else {
1663 Yap_ArithError(TYPE_ERROR_INTEGER, t, "popcount");
1664 }
1665}
1666
1667char *
1668Yap_mpz_to_string( MP_INT *b, char *s, size_t sz, int base)
1669{
1670 if (s) {
1671 size_t size = mpz_sizeinbase(b, base);
1672 if (size+2 > sz) {
1673 return NULL;
1674 }
1675 return mpz_get_str (s, base, b);
1676 }
1677 return NULL;
1678}
1679
1680char *
1681Yap_gmp_to_string(Term t, char *s, size_t sz, int base)
1682{
1683 if (RepAppl(t)[1] == BIG_INT) {
1684 MP_INT *b = Yap_BigIntOfTerm(t);
1685
1686 if (s) {
1687 size_t size = mpz_sizeinbase(b, base);
1688 if (size+2 > sz) {
1689 return NULL;
1690 }
1691 }
1692 return mpz_get_str (s, base, b);
1693 } else if (RepAppl(t)[1] == BIG_RATIONAL) {
1694 MP_RAT *b = Yap_BigRatOfTerm(t);
1695 size_t pos;
1696 size_t siz =
1697 mpz_sizeinbase(mpq_numref(b), base)+
1698 mpz_sizeinbase(mpq_denref(b), base)+
1699 8;
1700 if (s) {
1701 if (siz > sz) {
1702 return NULL;
1703 }
1704 } else {
1705 if (!(s = malloc(siz)))
1706 return NULL;
1707 }
1708 strncpy(s,"rdiv(",sz);
1709 pos = strlen(s);
1710 mpz_get_str (s+pos, base, mpq_numref(b));
1711 pos = strlen(s);
1712 s[pos] = ',';
1713 mpz_get_str (s+(pos+1), base, mpq_denref(b));
1714 pos = strlen(s);
1715 s[pos] = ')';
1716 }
1717 return s;
1718}
1719
1720size_t
1721Yap_gmp_to_size(Term t, int base)
1722{
1723 if (RepAppl(t)[1] == BIG_INT) {
1724 MP_INT *b = Yap_BigIntOfTerm(t);
1725 return mpz_sizeinbase(b, base);
1726 } else if (RepAppl(t)[1] == BIG_RATIONAL) {
1727 MP_RAT *b = Yap_BigRatOfTerm(t);
1728 return
1729 mpz_sizeinbase(mpq_numref(b), base)+
1730 mpz_sizeinbase(mpq_denref(b), base)+
1731 8;
1732 }
1733 return 1;
1734}
1735
1736int
1737Yap_term_to_existing_big(Term t, MP_INT *b)
1738{
1739 if (IsVarTerm(t))
1740 return FALSE;
1741 if (IsIntegerTerm(t)) {
1742 mpz_set_si(b,IntegerOfTerm(t));
1743 return TRUE;
1744 }
1745 if (IsBigIntTerm(t)) {
1746 if (RepAppl(t)[1] != BIG_INT)
1747 return FALSE;
1748 mpz_set(b,Yap_BigIntOfTerm(t));
1749 return TRUE;
1750 }
1751 return FALSE;
1752}
1753
1754int
1755Yap_term_to_existing_rat(Term t, MP_RAT *b)
1756{
1757 if (IsVarTerm(t))
1758 return FALSE;
1759 if (IsIntegerTerm(t)) {
1760 mpq_set_si(b, IntegerOfTerm(t), 1);
1761 return TRUE;
1762 }
1763 if (IsBigIntTerm(t)) {
1764 CELL flag = RepAppl(t)[1];
1765 if (flag == BIG_INT) {
1766 mpq_set_z(b, Yap_BigIntOfTerm(t));
1767 return TRUE;
1768 }
1769 if (flag == BIG_RATIONAL) {
1770 mpq_set(b, Yap_BigRatOfTerm(t));
1771 return TRUE;
1772 }
1773 }
1774 return FALSE;
1775}
1776
1777
1778
Main definitions.