YAP 7.1.0
arith2.c
Go to the documentation of this file.
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: arith2.c *
12 * Last rev: *
13 * mods: *
14 * comments: arithmetical expression evaluation *
15 * *
16 *************************************************************************/
17#ifdef SCCS
18static char SccsId[] = "%W% %G%";
19#endif
20
128#include "Yap.h"
129#include "Yatom.h"
130#include "YapHeap.h"
131#include "YapEval.h"
132
133#include "arith2.h"
134
135typedef struct init_un_eval {
136 char *OpName;
137 arith2_op f;
139
140
141static Term
142p_mod(Term t1, Term t2 USES_REGS) {
143 switch (ETypeOfTerm(t1)) {
144 case (CELL)long_int_e:
145 switch (ETypeOfTerm(t2)) {
146 case (CELL)long_int_e:
147 /* two integers */
148 {
149 Int i1 = IntegerOfTerm(t1);
150 Int i2 = IntegerOfTerm(t2);
151 Int mod;
152
153 if (i2 == 0)
154 Yap_ArithError(EVALUATION_ERROR_ZERO_DIVISOR, t2, "X is " Int_FORMAT " mod 0", i1);
155 if (i1 == Int_MIN && i2 == -1) {
156 return MkIntTerm(0);
157 }
158 mod = i1%i2;
159 if (mod && (mod ^ i2) < 0)
160 mod += i2;
161 RINT(mod);
162 }
163 case (CELL)double_e:
164 Yap_ArithError(TYPE_ERROR_INTEGER, t2, "mod/2");
165 case (CELL)big_int_e:
166#ifdef USE_GMP
167 return Yap_gmp_mod_int_big(IntegerOfTerm(t1), t2);
168#endif
169 default:
170 RERROR();
171 break;
172 }
173 case (CELL)double_e:
174 Yap_ArithError(TYPE_ERROR_INTEGER, t1, "mod/2");
175 case (CELL)big_int_e:
176#ifdef USE_GMP
177 switch (ETypeOfTerm(t2)) {
178 case long_int_e:
179 /* modulo between bignum and integer */
180 {
181 Int i2 = IntegerOfTerm(t2);
182
183 if (i2 == 0)
184 Yap_ArithError(EVALUATION_ERROR_ZERO_DIVISOR, t2, "X is ... mod 0");
185 return Yap_gmp_mod_big_int(t1, i2);
186 }
187 case (CELL)big_int_e:
188 /* two bignums */
189 return Yap_gmp_mod_big_big(t1, t2);
190 case double_e:
191 Yap_ArithError(TYPE_ERROR_INTEGER, t2, "mod/2");
192 default:
193 RERROR();
194 }
195#endif
196 default:
197 RERROR();
198 }
199}
200
201static Term
202p_div2(Term t1, Term t2 USES_REGS) {
203 switch (ETypeOfTerm(t1)) {
204 case (CELL)long_int_e:
205 switch (ETypeOfTerm(t2)) {
206 case (CELL)long_int_e:
207 /* two integers */
208 {
209 Int i1 = IntegerOfTerm(t1);
210 Int i2 = IntegerOfTerm(t2);
211 Int res, mod;
212
213 if (i2 == 0)
214 Yap_ArithError(EVALUATION_ERROR_ZERO_DIVISOR, t2, "X is " Int_FORMAT " div 0", i1);
215 if (i1 == Int_MIN && i2 == -1) {
216#ifdef USE_GMP
217 return Yap_gmp_add_ints(Int_MAX, 1);
218#else
219 Yap_ArithError(EVALUATION_ERROR_INT_OVERFLOW, t1,
220 "// /2 with %d and %d", i1, i2);
221#endif
222 }
223 mod = i1%i2;
224 if (mod && (mod ^ i2) < 0)
225 mod += i2;
226 res = (i1 - mod) / i2;
227 RINT(res);
228 }
229 case (CELL)double_e:
230 Yap_ArithError(TYPE_ERROR_INTEGER, t2, "div/2");
231 case (CELL)big_int_e:
232#ifdef USE_GMP
233 return Yap_gmp_div_int_big(IntegerOfTerm(t1), t2);
234#endif
235 default:
236 RERROR();
237 break;
238 }
239 case (CELL)double_e:
240 Yap_ArithError(TYPE_ERROR_INTEGER, t2, "div/2");
241 case (CELL)big_int_e:
242#ifdef USE_GMP
243 switch (ETypeOfTerm(t2)) {
244 case long_int_e:
245 /* modulo between bignum and integer */
246 {
247 Int i2 = IntegerOfTerm(t2);
248
249 if (i2 == 0)
250 Yap_ArithError(EVALUATION_ERROR_ZERO_DIVISOR, t2, "X is ... div 0");
251 return Yap_gmp_div2_big_int(t1, i2);
252 }
253 case (CELL)big_int_e:
254 /* two bignums */
255 return Yap_gmp_div2_big_big(t1, t2);
256 case double_e:
257 Yap_ArithError(TYPE_ERROR_INTEGER, t2, "div/2");
258 default:
259 RERROR();
260 }
261#endif
262 default:
263 RERROR();
264 }
265}
266
267static Term
268p_rem(Term t1, Term t2 USES_REGS) {
269 switch (ETypeOfTerm(t1)) {
270 case (CELL)long_int_e:
271 switch (ETypeOfTerm(t2)) {
272 case (CELL)long_int_e:
273 /* two integers */
274 {
275 Int i1 = IntegerOfTerm(t1);
276 Int i2 = IntegerOfTerm(t2);
277
278 if (i2 == 0)
279 Yap_ArithError(EVALUATION_ERROR_ZERO_DIVISOR, t2, "X is " Int_FORMAT " rem 0", i1);
280 if (i1 == Int_MIN && i2 == -1) {
281 return MkIntTerm(0);
282 }
283 RINT(i1%i2);
284 }
285 case (CELL)double_e:
286 Yap_ArithError(TYPE_ERROR_INTEGER, t2, "rem/2");
287 case (CELL)big_int_e:
288#ifdef USE_GMP
289 return Yap_gmp_rem_int_big(IntegerOfTerm(t1), t2);
290#endif
291 default:
292 RERROR();
293 }
294 break;
295 case (CELL)double_e:
296 Yap_ArithError(TYPE_ERROR_INTEGER, t1, "rem/2");
297 case (CELL)big_int_e:
298#ifdef USE_GMP
299 switch (ETypeOfTerm(t2)) {
300 case long_int_e:
301 if (IntegerOfTerm(t2) == 0)
302 Yap_ArithError(EVALUATION_ERROR_ZERO_DIVISOR, t2, "X is ... rem 0");
303 return Yap_gmp_rem_big_int(t1, IntegerOfTerm(t2));
304 case (CELL)big_int_e:
305 /* two bignums */
306 return Yap_gmp_rem_big_big(t1, t2);
307 case double_e:
308 Yap_ArithError(TYPE_ERROR_INTEGER, t2, "rem/2");
309 default:
310 RERROR();
311 }
312#endif
313 default:
314 RERROR();
315 }
316}
317
318
319static Term
320p_rdiv(Term t1, Term t2 USES_REGS) {
321#ifdef USE_GMP
322 switch (ETypeOfTerm(t1)) {
323 case (CELL)double_e:
324 Yap_ArithError(TYPE_ERROR_INTEGER, t2, "rdiv/2");
325 case (CELL)long_int_e:
326 switch (ETypeOfTerm(t2)) {
327 case (CELL)long_int_e:
328 /* two integers */
329 {
330 Int i1 = IntegerOfTerm(t1);
331 Int i2 = IntegerOfTerm(t2);
332
333 if (i2 == 0)
334 Yap_ArithError(EVALUATION_ERROR_ZERO_DIVISOR, t2, "X is " Int_FORMAT " rdiv 0", i1);
335 return Yap_gmq_rdiv_int_int(i1, i2);
336 }
337 case (CELL)big_int_e:
338 /* I know the term is much larger, so: */
339 return Yap_gmq_rdiv_int_big(IntegerOfTerm(t1), t2);
340 default:
341 RERROR();
342 }
343 break;
344 case (CELL)big_int_e:
345 switch (ETypeOfTerm(t2)) {
346 case long_int_e:
347 if (IntegerOfTerm(t2) == 0)
348 Yap_ArithError(EVALUATION_ERROR_ZERO_DIVISOR, t2, "X is ... rdiv 0");
349 /* I know the term is much larger, so: */
350 return Yap_gmq_rdiv_big_int(t1, IntegerOfTerm(t2));
351 case (CELL)big_int_e:
352 return Yap_gmq_rdiv_big_big(t1, t2);
353 case double_e:
354 Yap_ArithError(TYPE_ERROR_INTEGER, t2, "rdiv/2");
355 default:
356 RERROR();
357 }
358 default:
359 RERROR();
360 }
361#else
362 RERROR();
363#endif
364}
365
366
367/*
368 Floating point division: /
369*/
370static Term
371p_fdiv(Term t1, Term t2 USES_REGS)
372{
373 switch (ETypeOfTerm(t1)) {
374 case long_int_e:
375 switch (ETypeOfTerm(t2)) {
376 case long_int_e:
377 {
378 Int i2 = IntegerOfTerm(t2);
379
380 /* two integers */
381 RFLOAT((((Float)IntegerOfTerm(t1))/(Float)i2));
382 }
383 case double_e:
384 {
385 /* integer, double */
386 Float fl1 = (Float)IntegerOfTerm(t1);
387 Float fl2 = FloatOfTerm(t2);
388 RFLOAT(fl1/fl2);
389 }
390 case (CELL)big_int_e:
391#ifdef USE_GMP
392 return Yap_gmp_fdiv_int_big(IntegerOfTerm(t1), t2);
393#endif
394 default:
395 RERROR();
396 }
397 break;
398 case double_e:
399 switch (ETypeOfTerm(t2)) {
400 case long_int_e:
401 /* float / integer */
402 {
403 Int i2 = IntegerOfTerm(t2);
404 RFLOAT(FloatOfTerm(t1)/(Float)i2);
405 }
406 case double_e:
407 {
408 Float f2 = FloatOfTerm(t2);
409 RFLOAT(FloatOfTerm(t1)/f2);
410 }
411 case big_int_e:
412#ifdef USE_GMP
413 return Yap_gmp_fdiv_float_big(FloatOfTerm(t1), t2);
414#endif
415 default:
416 RERROR();
417 }
418 break;
419 case big_int_e:
420#ifdef USE_GMP
421 switch (ETypeOfTerm(t2)) {
422 case long_int_e:
423 return Yap_gmp_fdiv_big_int(t1, IntegerOfTerm(t2));
424 case big_int_e:
425 /* two bignums*/
426 return Yap_gmp_fdiv_big_big(t1, t2);
427 case double_e:
428 return Yap_gmp_fdiv_big_float(t1, FloatOfTerm(t2));
429 default:
430 RERROR();
431 }
432#endif
433 default:
434 RERROR();
435 }
436 RERROR();
437}
438
439/*
440 xor #
441*/
442static Term
443p_xor(Term t1, Term t2 USES_REGS)
444{
445 switch (ETypeOfTerm(t1)) {
446 case long_int_e:
447
448 switch (ETypeOfTerm(t2)) {
449 case long_int_e:
450 /* two integers */
451 RINT(IntegerOfTerm(t1) ^ IntegerOfTerm(t2));
452 case double_e:
453 Yap_ArithError(TYPE_ERROR_INTEGER, t2, "#/2");
454 case big_int_e:
455#ifdef USE_GMP
456 return Yap_gmp_xor_int_big(IntegerOfTerm(t1), t2);
457#endif
458 default:
459 RERROR();
460 }
461 break;
462 case double_e:
463 Yap_ArithError(TYPE_ERROR_INTEGER, t1, "#/2");
464 case big_int_e:
465#ifdef USE_GMP
466 switch (ETypeOfTerm(t2)) {
467 case long_int_e:
468 return Yap_gmp_xor_int_big(IntegerOfTerm(t2), t1);
469 case big_int_e:
470 return Yap_gmp_xor_big_big(t1, t2);
471 case double_e:
472 Yap_ArithError(TYPE_ERROR_INTEGER, t2, "#/2");
473 default:
474 RERROR();
475 }
476#endif
477 default:
478 RERROR();
479 }
480 RERROR();
481}
482
483/*
484 atan2: arc tangent x/y
485*/
486static Term
487p_atan2(Term t1, Term t2 USES_REGS)
488{
489 switch (ETypeOfTerm(t1)) {
490 case long_int_e:
491 switch (ETypeOfTerm(t2)) {
492 case long_int_e:
493 /* two integers */
494 RFLOAT(atan2(IntegerOfTerm(t1),IntegerOfTerm(t2)));
495 case double_e:
496 RFLOAT(atan2(IntegerOfTerm(t1),FloatOfTerm(t2)));
497 case big_int_e:
498#ifdef USE_GMP
499 {
500 Int i1 = IntegerOfTerm(t1);
501 Float f2 = Yap_gmp_to_float(t2);
502 RFLOAT(atan2(i1,f2));
503 }
504#endif
505 default:
506 RERROR();
507 break;
508 }
509 case double_e:
510 switch (ETypeOfTerm(t2)) {
511 case long_int_e:
512 /* float / integer */
513 {
514 Int i2 = IntegerOfTerm(t2);
515 RFLOAT(atan2(FloatOfTerm(t1),i2));
516 }
517 case double_e:
518 {
519 Float f2 = FloatOfTerm(t2);
520 RFLOAT(atan2(FloatOfTerm(t1),f2));
521 }
522 case big_int_e:
523#ifdef USE_GMP
524 {
525 RFLOAT(atan2(FloatOfTerm(t1),Yap_gmp_to_float(t2)));
526 }
527#endif
528 default:
529 RERROR();
530 }
531 break;
532 case big_int_e:
533#ifdef USE_GMP
534 {
535 Float dbl1 = Yap_gmp_to_float(t1);
536 switch (ETypeOfTerm(t2)) {
537 case long_int_e:
538 {
539 Int i = IntegerOfTerm(t2);
540 RFLOAT(atan2(dbl1,i));
541 }
542 case big_int_e:
543 /* two bignums */
544 RFLOAT(atan2(dbl1,Yap_gmp_to_float(t2)));
545 case double_e:
546 {
547 Float dbl = FloatOfTerm(t2);
548 RFLOAT(atan2(dbl1,dbl));
549 }
550 default:
551 RERROR();
552 }
553 }
554#endif
555 default:
556 RERROR();
557 }
558 RERROR();
559}
560
561
562/*
563 power: x^y
564*/
565static Term
566p_power(Term t1, Term t2 USES_REGS)
567{
568 switch (ETypeOfTerm(t1)) {
569 case long_int_e:
570 switch (ETypeOfTerm(t2)) {
571 case long_int_e:
572 {
573 Int i2 = IntegerOfTerm(t2);
574
575 /* two integers */
576 RFLOAT(pow(IntegerOfTerm(t1),i2));
577 }
578 case double_e:
579 {
580 /* integer, double */
581 Float fl1 = (Float)IntegerOfTerm(t1);
582 Float fl2 = FloatOfTerm(t2);
583 RFLOAT(pow(fl1,fl2));
584 }
585 case big_int_e:
586#ifdef USE_GMP
587 {
588 Int i1 = IntegerOfTerm(t1);
589 Float f2 = Yap_gmp_to_float(t2);
590 RFLOAT(pow(i1,f2));
591 }
592#endif
593 default:
594 RERROR();
595 }
596 break;
597 case double_e:
598 switch (ETypeOfTerm(t2)) {
599 case long_int_e:
600 /* float / integer */
601 {
602 Int i2 = IntegerOfTerm(t2);
603 RFLOAT(pow(FloatOfTerm(t1),i2));
604 }
605 case double_e:
606 {
607 Float f2 = FloatOfTerm(t2);
608 RFLOAT(pow(FloatOfTerm(t1),f2));
609 }
610 case big_int_e:
611#ifdef USE_GMP
612 {
613 RFLOAT(pow(FloatOfTerm(t1),Yap_gmp_to_float(t2)));
614 }
615#endif
616 default:
617 RERROR();
618 }
619 break;
620 case big_int_e:
621#ifdef USE_GMP
622 switch (ETypeOfTerm(t2)) {
623 case long_int_e:
624 {
625 Int i = IntegerOfTerm(t2);
626 RFLOAT(pow(Yap_gmp_to_float(t1),i));
627 }
628 case big_int_e:
629 /* two bignums */
630 RFLOAT(pow(Yap_gmp_to_float(t1),Yap_gmp_to_float(t2)));
631 case double_e:
632 {
633 Float dbl = FloatOfTerm(t2);
634 RFLOAT(pow(Yap_gmp_to_float(t1),dbl));
635 }
636 default:
637 RERROR();
638 }
639#endif
640 default:
641 RERROR();
642 }
643 RERROR();
644}
645
646/* next function is adapted from:
647 Inline C++ integer exponentiation routines
648 Version 1.01
649 Copyright (C) 1999-2004 John C. Bowman <bowman@math.ualberta.ca>
650*/
651static inline Int
652ipow(Int x, Int p)
653{
654 Int r;
655
656 if (p == 0) return ((CELL)1);
657 if (x == 0 && p > 0) return 0L;
658 if(p < 0)
659 return (-p % 2) ? x : ((CELL)1);
660
661 r = ((CELL)1);
662 for(;;) {
663 if(p & 1) {
664 if (mul_overflow((r*x), r, x)) {
665 return 0;
666 }
667 r *= x;
668 }
669 if((p >>= 1) == 0) return r;
670 if (mul_overflow((x*x), x, x)) {
671 return 0;
672 }
673 x *= x;
674 }
675}
676
677
678/*
679 power: x^y
680*/
681static Term
682p_exp(Term t1, Term t2 USES_REGS)
683{
684 switch (ETypeOfTerm(t1)) {
685 case long_int_e:
686 switch (ETypeOfTerm(t2)) {
687 case long_int_e:
688 {
689 Int i1 = IntegerOfTerm(t1);
690 Int i2 = IntegerOfTerm(t2);
691 Int pow;
692
693 if (i2 < 0) {
694 Yap_ArithError(DOMAIN_ERROR_NOT_LESS_THAN_ZERO, t2,
695 "%d ^ %d", i1, i2);
696 }
697 pow = ipow(i1,i2);
698#ifdef USE_GMP
699 /* two integers */
700 if ((i1 && !pow)) {
701 /* overflow */
702 return Yap_gmp_exp_int_int(i1, i2);
703 }
704#endif
705 RINT(pow);
706 }
707 case double_e:
708 {
709 /* integer, double */
710 Float fl1 = (Float)IntegerOfTerm(t1);
711 Float fl2 = FloatOfTerm(t2);
712 RFLOAT(pow(fl1,fl2));
713 }
714 case big_int_e:
715#ifdef USE_GMP
716 {
717 Int i = IntegerOfTerm(t1);
718 return Yap_gmp_exp_int_big(i,t2);
719 }
720#endif
721 default:
722 RERROR();
723 }
724 break;
725 case double_e:
726 switch (ETypeOfTerm(t2)) {
727 case long_int_e:
728 /* float / integer */
729 {
730 Int i2 = IntegerOfTerm(t2);
731 RFLOAT(pow(FloatOfTerm(t1),i2));
732 }
733 case double_e:
734 {
735 Float f2 = FloatOfTerm(t2);
736 RFLOAT(pow(FloatOfTerm(t1),f2));
737 }
738 case big_int_e:
739#ifdef USE_GMP
740 {
741 RFLOAT(pow(FloatOfTerm(t1),Yap_gmp_to_float(t2)));
742 }
743#endif
744 default:
745 RERROR();
746 }
747 break;
748 case big_int_e:
749#ifdef USE_GMP
750 switch (ETypeOfTerm(t2)) {
751 case long_int_e:
752 {
753 Int i = IntegerOfTerm(t2);
754 return Yap_gmp_exp_big_int(t1,i);
755 }
756 case big_int_e:
757 /* two bignums, makes no sense */
758 return Yap_gmp_exp_big_big(t1,t2);
759 case double_e:
760 {
761 Float dbl = FloatOfTerm(t2);
762 RFLOAT(pow(Yap_gmp_to_float(t1),dbl));
763 }
764 default:
765 RERROR();
766 }
767#endif
768 default:
769 RERROR();
770 }
771 RERROR();
772}
773
774static Int
775gcd(Int m11,Int m21 USES_REGS)
776{
777 /* Blankinship algorithm, provided by Miguel Filgueiras */
778 Int m12=1, m22=0, k;
779
780 while (m11>0 && m21>0)
781 if (m11<m21) {
782 k = m21/m11; m21 -= k*m11; m22 -= k*m12;
783 } else {
784 k=m11/m21; m11 -= k*m21; m12 -= k*m22;
785 }
786 if (m11<0 || m21<0) { /* overflow? */
787 /* Oflow = 1; */
788 Yap_ArithError(EVALUATION_ERROR_INT_OVERFLOW, MkIntegerTerm(m11),
789 "gcd/2 with %d and %d", m11, m21);
790 return(1);
791 }
792 if (m11) return(m11);
793 return(m21);
794}
795
796#ifdef GCD_MULT
797Int gcdmult(Int m11,Int m21,Int *pm11) /* *pm11 gets multiplier of m11 */
798{
799 Int m12=1, m22=0, k;
800
801 while (m11 && m21)
802 if (m11<m21) {
803 k = m21/m11; m21 -= k*m11; m22 -= k*m12;
804 } else {
805 k=m11/m21; m11 -= k*m21; m12 -= k*m22;
806 }
807 if (m11<0 || m21<0) { /* overflow? */
808 /* Oflow = 1; */
809 Yap_ArithError(EVALUATION_ERROR_INT_OVERFLOW, MkIntegerTerm(m11),
810 "gcdmult/2 with %d and %d", m11, m21);
811 return(1);
812 }
813 if (m11) {
814 *pm11 = m12; return(m11);
815 }
816 *pm11 = m22;
817 return(m21);
818}
819#endif
820
821/*
822 module gcd
823*/
824static Term
825p_gcd(Term t1, Term t2 USES_REGS)
826{
827 switch (ETypeOfTerm(t1)) {
828 case long_int_e:
829 switch (ETypeOfTerm(t2)) {
830 case long_int_e:
831 /* two integers */
832 {
833 Int i1 = IntegerOfTerm(t1), i2 = IntegerOfTerm(t2);
834 i1 = (i1 >= 0 ? i1 : -i1);
835 i2 = (i2 >= 0 ? i2 : -i2);
836
837 RINT(gcd(i1,i2 PASS_REGS));
838 }
839 case double_e:
840 Yap_ArithError(TYPE_ERROR_INTEGER, t2, "gcd/2");
841 case big_int_e:
842#ifdef USE_GMP
843 return Yap_gmp_gcd_int_big(IntegerOfTerm(t1), t2);
844#endif
845 default:
846 RERROR();
847 }
848 break;
849 case double_e:
850 Yap_ArithError(TYPE_ERROR_INTEGER, t1, "gcd/2");
851 case big_int_e:
852#ifdef USE_GMP
853 switch (ETypeOfTerm(t2)) {
854 case long_int_e:
855 return Yap_gmp_gcd_int_big(IntegerOfTerm(t2), t1);
856 case big_int_e:
857 return Yap_gmp_gcd_big_big(t1, t2);
858 case double_e:
859 Yap_ArithError(TYPE_ERROR_INTEGER, t2, "gcd/2");
860 default:
861 RERROR();
862 }
863#endif
864 default:
865 RERROR();
866 }
867 RERROR();
868}
869
870/*
871 minimum: min(x,y)
872*/
873static Term
874p_min(Term t1, Term t2)
875{
876 switch (ETypeOfTerm(t1)) {
877 case long_int_e:
878 switch (ETypeOfTerm(t2)) {
879 case long_int_e:
880 {
881 Int i1 = IntegerOfTerm(t1);
882 Int i2 = IntegerOfTerm(t2);
883 return((i1 < i2 ? t1 : t2));
884 }
885 case double_e:
886 {
887 /* integer, double */
888 Int i = IntegerOfTerm(t1);
889 Float fl = FloatOfTerm(t2);
890 if (i <= fl) {
891 return t1;
892 }
893 return t2;
894 }
895 case big_int_e:
896#ifdef USE_GMP
897 if (Yap_gmp_cmp_int_big(IntegerOfTerm(t1), t2) < 0) {
898 return t1;
899 }
900 return t2;
901#endif
902 default:
903 RERROR();
904 }
905 break;
906 case double_e:
907 switch (ETypeOfTerm(t2)) {
908 case long_int_e:
909 /* float / integer */
910 {
911 Int i = IntegerOfTerm(t2);
912 Float fl = FloatOfTerm(t1);
913 if (i <= fl) {
914 return t2;
915 }
916 return t1;
917 }
918 case double_e:
919 {
920 Float fl1 = FloatOfTerm(t1);
921 Float fl2 = FloatOfTerm(t2);
922 if (fl1 <= fl2) {
923 return t1;
924 }
925 return t2;
926 }
927 case big_int_e:
928#ifdef USE_GMP
929 if (Yap_gmp_cmp_float_big(FloatOfTerm(t1), t2) < 0) {
930 return t1;
931 }
932 return t2;
933#endif
934 default:
935 RERROR();
936 }
937 break;
938 case big_int_e:
939#ifdef USE_GMP
940 switch (ETypeOfTerm(t2)) {
941 case long_int_e:
942 if (Yap_gmp_cmp_big_int(t1, IntegerOfTerm(t2)) < 0) {
943 return t1;
944 }
945 return t2;
946 case big_int_e:
947 if (Yap_gmp_cmp_big_big(t1, t2) < 0) {
948 return t1;
949 }
950 return t2;
951 case double_e:
952 if (Yap_gmp_cmp_big_float(t1, FloatOfTerm(t2)) < 0) {
953 return t1;
954 }
955 return t2;
956 default:
957 RERROR();
958 }
959#endif
960 default:
961 RERROR();
962 }
963 RERROR();
964}
965
966/*
967 maximum: max(x,y)
968*/
969static Term
970p_max(Term t1, Term t2)
971{
972 switch (ETypeOfTerm(t1)) {
973 case long_int_e:
974 switch (ETypeOfTerm(t2)) {
975 case long_int_e:
976 {
977 Int i1 = IntegerOfTerm(t1);
978 Int i2 = IntegerOfTerm(t2);
979 return((i1 > i2 ? t1 : t2));
980 }
981 case double_e:
982 {
983 /* integer, double */
984 Int i = IntegerOfTerm(t1);
985 Float fl = FloatOfTerm(t2);
986 if (i >= fl) {
987 return t1;
988 }
989 return t2;
990 }
991 case big_int_e:
992#ifdef USE_GMP
993 if (Yap_gmp_cmp_int_big(IntegerOfTerm(t1), t2) > 0) {
994 return t1;
995 }
996 return t2;
997#endif
998 default:
999 RERROR();
1000 }
1001 break;
1002 case double_e:
1003 switch (ETypeOfTerm(t2)) {
1004 case long_int_e:
1005 /* float / integer */
1006 {
1007 Int i = IntegerOfTerm(t2);
1008 Float fl = FloatOfTerm(t1);
1009 if (i >= fl) {
1010 return t2;
1011 }
1012 return t1;
1013 }
1014 case double_e:
1015 {
1016 Float fl1 = FloatOfTerm(t1);
1017 Float fl2 = FloatOfTerm(t2);
1018 if (fl1 >= fl2) {
1019 return t1;
1020 }
1021 return t2;
1022 }
1023 case big_int_e:
1024#ifdef USE_GMP
1025 if (Yap_gmp_cmp_float_big(FloatOfTerm(t1), t2) > 0) {
1026 return t1;
1027 }
1028 return t2;
1029#endif
1030 default:
1031 RERROR();
1032 }
1033 break;
1034 case big_int_e:
1035#ifdef USE_GMP
1036 switch (ETypeOfTerm(t2)) {
1037 case long_int_e:
1038 if (Yap_gmp_cmp_big_int(t1, IntegerOfTerm(t2)) > 0) {
1039 return t1;
1040 }
1041 return t2;
1042 case big_int_e:
1043 if (Yap_gmp_cmp_big_big(t1, t2) > 0) {
1044 return t1;
1045 }
1046 return t2;
1047 case double_e:
1048 if (Yap_gmp_cmp_big_float(t1, FloatOfTerm(t2)) > 0) {
1049 return t1;
1050 }
1051 return t2;
1052 default:
1053 RERROR();
1054 }
1055#endif
1056 default:
1057 RERROR();
1058 }
1059 RERROR();
1060}
1061
1062static Term
1063eval2(Int fi, Term t1, Term t2 USES_REGS) {
1064 arith2_op f = fi;
1065 switch (f) {
1066 case op_plus:
1067 return p_plus(t1, t2 PASS_REGS);
1068 case op_minus:
1069 return p_minus(t1, t2 PASS_REGS);
1070 case op_times:
1071 return p_times(t1, t2 PASS_REGS);
1072 case op_div:
1073 return p_div(t1, t2 PASS_REGS);
1074 case op_idiv:
1075 return p_div2(t1, t2 PASS_REGS);
1076 case op_and:
1077 return p_and(t1, t2 PASS_REGS);
1078 case op_or:
1079 return p_or(t1, t2 PASS_REGS);
1080 case op_sll:
1081 return p_sll(t1, t2 PASS_REGS);
1082 case op_slr:
1083 return p_slr(t1, t2 PASS_REGS);
1084 case op_mod:
1085 return p_mod(t1, t2 PASS_REGS);
1086 case op_rem:
1087 return p_rem(t1, t2 PASS_REGS);
1088 case op_fdiv:
1089 return p_fdiv(t1, t2 PASS_REGS);
1090 case op_xor:
1091 return p_xor(t1, t2 PASS_REGS);
1092 case op_atan2:
1093 return p_atan2(t1, t2 PASS_REGS);
1094 case op_power:
1095 return p_exp(t1, t2 PASS_REGS);
1096 case op_power2:
1097 return p_power(t1, t2 PASS_REGS);
1098 case op_gcd:
1099 return p_gcd(t1, t2 PASS_REGS);
1100 case op_min:
1101 return p_min(t1, t2);
1102 case op_max:
1103 return p_max(t1, t2);
1104 case op_rdiv:
1105 return p_rdiv(t1, t2 PASS_REGS);
1106 }
1107 RERROR();
1108}
1109
1110Term Yap_eval_binary(Int f, Term t1, Term t2)
1111{
1112 CACHE_REGS
1113 return eval2(f,t1,t2 PASS_REGS);
1114}
1115
1116static InitBinEntry InitBinTab[] = {
1117 {"+", op_plus},
1118 {"-", op_minus},
1119 {"*", op_times},
1120 {"/", op_fdiv},
1121 {"mod", op_mod},
1122 {"rem", op_rem},
1123 {"//", op_div},
1124 {"div", op_idiv},
1125 {"<<", op_sll},
1126 {">>", op_slr},
1127 {"/\\", op_and},
1128 {"\\/", op_or},
1129 {"#", op_xor},
1130 {"><", op_xor},
1131 {"xor", op_xor},
1132 {"atan", op_atan2},
1133 {"atan2", op_atan2},
1134 /* C-Prolog exponentiation */
1135 {"^", op_power},
1136 /* ISO-Prolog exponentiation */
1137 {"**", op_power2},
1138 /* Quintus exponentiation */
1139 {"exp", op_power2},
1140 {"gcd", op_gcd},
1141 {"min", op_min},
1142 {"max", op_max},
1143 {"rdiv", op_rdiv}
1144};
1145
1146static Int
1147p_binary_is( USES_REGS1 )
1148{ /* X is Y */
1149 Term t = Deref(ARG2);
1150 Term t1, t2;
1151 yap_error_number err;
1152
1153 if (IsVarTerm(t)) {
1154 Yap_ArithError(INSTANTIATION_ERROR,t, "VAR(X , Y)");
1155 return(FALSE);
1156 }
1157 Yap_ClearExs();
1158 t1 = Yap_Eval(Deref(ARG3));
1159 if ((err = Yap_FoundArithError())) {
1160 Atom name;
1161 if (IsIntTerm(t)) {
1162 Int i = IntOfTerm(t);
1163 name = Yap_NameOfBinaryOp(i);
1164 } else {
1165 name = AtomOfTerm(Deref(ARG2));
1166 }
1167 Yap_EvalError(err,ARG3,"X is ~s/2: error in first argument ", RepAtom(name)->StrOfAE);
1168 return FALSE;
1169 }
1170 t2 = Yap_Eval(Deref(ARG4));
1171 if ((err=Yap_FoundArithError())) {
1172 Atom name;
1173 if (IsIntTerm(t)) {
1174 Int i = IntOfTerm(t);
1175 name = Yap_NameOfBinaryOp(i);
1176 } else {
1177 name = AtomOfTerm(Deref(ARG2));
1178 }
1179 Yap_EvalError(err,ARG3,"X is ~s/2: error in first argument ", RepAtom(name)->StrOfAE);
1180 return FALSE;
1181 }
1182 if (IsIntTerm(t)) {
1183 Int i = IntOfTerm(t);
1184 Term tout = eval2(i, t1, t2 PASS_REGS);
1185 if ((err = Yap_FoundArithError()) != YAP_NO_ERROR) {
1186 Term ts[2], terr;
1187 Atom name = Yap_NameOfBinaryOp( i );
1188 Functor f = Yap_MkFunctor( name, 2 );
1189 ts[0] = t1;
1190 ts[1] = t2;
1191 terr = Yap_MkApplTerm( f, 2, ts );
1192 Yap_EvalError(err, terr ,"error in %s/2 ", RepAtom(name)->StrOfAE);
1193 return FALSE;
1194 }
1195 return Yap_unify_constant(ARG1,tout);
1196 }
1197 if (IsAtomTerm(t)) {
1198 Atom name = AtomOfTerm(t);
1199 ExpEntry *p;
1200 Term out;
1201
1202 if (EndOfPAEntr(p = RepExpProp(Yap_GetExpProp(name, 2)))) {
1203 Yap_EvalError(TYPE_ERROR_EVALUABLE, takeIndicator(t),
1204 "functor %s/2 for arithmetic expression",
1205 RepAtom(name)->StrOfAE);
1206 P = FAILCODE;
1207 return(FALSE);
1208 }
1209 out= eval2(p->FOfEE, t1, t2 PASS_REGS);
1210 if ((err = Yap_FoundArithError()) != YAP_NO_ERROR) {
1211 Term ts[2], terr;
1212 Functor f = Yap_MkFunctor( name, 2 );
1213 ts[0] = t1;
1214 ts[1] = t2;
1215 terr = Yap_MkApplTerm( f, 2, ts );
1216 Yap_EvalError(err, terr ,"error in ~s/2 ", RepAtom(name)->StrOfAE);
1217 return FALSE;
1218 }
1219 return Yap_unify_constant(ARG1,out);
1220 }
1221 return FALSE;
1222}
1223
1224
1225
1226static Int
1227do_arith23(arith2_op op USES_REGS)
1228{ /* X is Y */
1229 Term t = Deref(ARG1);
1230 Int out;
1231 Term t1, t2;
1232 yap_error_number err;
1233
1234 Yap_ClearExs();
1235 if (IsVarTerm(t)) {
1236 Yap_EvalError(INSTANTIATION_ERROR,t, "X is Y");
1237 return(FALSE);
1238 }
1239 t1 = Yap_Eval(t);
1240 if (t1 == 0L)
1241 return FALSE;
1242 t2 = Yap_Eval(Deref(ARG2));
1243 if (t2 == 0L)
1244 return FALSE;
1245 out= eval2(op, t1, t2 PASS_REGS);
1246 if ((err=Yap_FoundArithError())) {
1247 Term ts[2], t;
1248 Functor f = Yap_MkFunctor( Yap_NameOfBinaryOp(op), 2 );
1249 ts[0] = t1;
1250 ts[1] = t2;
1251 t = Yap_MkApplTerm( f, 2, ts );
1252 Yap_EvalError(err, t ,"error in ~s(Y,Z) ",Yap_NameOfBinaryOp(op));
1253 return FALSE;
1254 }
1255 return Yap_unify_constant(ARG3,out);
1256}
1257
1258static Int
1259export_p_plus( USES_REGS1 )
1260{ /* X is Y */
1261 return do_arith23(op_plus PASS_REGS);
1262}
1263
1264static Int
1265export_p_minus( USES_REGS1 )
1266{ /* X is Y */
1267 return do_arith23(op_minus PASS_REGS);
1268}
1269
1270static Int
1271export_p_times( USES_REGS1 )
1272{ /* X is Y */
1273 return do_arith23(op_times PASS_REGS);
1274}
1275
1276static Int
1277export_p_div( USES_REGS1 )
1278{ /* X is Y */
1279 return do_arith23(op_div PASS_REGS);
1280}
1281
1282static Int
1283export_p_and( USES_REGS1 )
1284{ /* X is Y */
1285 return do_arith23(op_and PASS_REGS);
1286}
1287
1288static Int
1289export_p_or( USES_REGS1 )
1290{ /* X is Y */
1291 return do_arith23(op_or PASS_REGS);
1292}
1293
1294static Int
1295export_p_slr( USES_REGS1 )
1296{ /* X is Y */
1297 return do_arith23(op_slr PASS_REGS);
1298}
1299
1300static Int
1301export_p_sll( USES_REGS1 )
1302{ /* X is Y */
1303 return do_arith23(op_sll PASS_REGS);
1304}
1305
1306static Int
1307p_binary_op_as_integer( USES_REGS1 )
1308{ /* X is Y */
1309 Term t = Deref(ARG1);
1310
1311 if (IsVarTerm(t)) {
1312 Yap_EvalError(INSTANTIATION_ERROR,t, "X is Y");
1313 return(FALSE);
1314 }
1315 if (IsIntTerm(t)) {
1316 return Yap_unify_constant(ARG2,t);
1317 }
1318 if (IsAtomTerm(t)) {
1319 Atom name = AtomOfTerm(t);
1320 ExpEntry *p;
1321
1322 if (EndOfPAEntr(p = RepExpProp(Yap_GetExpProp(name, 2)))) {
1323 return Yap_unify(ARG1,ARG2);
1324 }
1325 return Yap_unify_constant(ARG2,MkIntTerm(p->FOfEE));
1326 }
1327 return(FALSE);
1328}
1329
1330Atom
1331Yap_NameOfBinaryOp(int i)
1332{
1333 return Yap_LookupAtom(InitBinTab[i].OpName);
1334}
1335
1336
1337void
1338Yap_InitBinaryExps(void)
1339{
1340 unsigned int i;
1341 ExpEntry *p;
1342
1343 for (i = 0; i < sizeof(InitBinTab)/sizeof(InitBinEntry); ++i) {
1344 AtomEntry *ae = RepAtom(Yap_LookupAtom(InitBinTab[i].OpName));
1345 if (ae == NULL) {
1346 Yap_EvalError(RESOURCE_ERROR_HEAP,TermNil,"at InitBinaryExps");
1347 return;
1348 }
1349 WRITE_LOCK(ae->ARWLock);
1350 if (Yap_GetExpPropHavingLock(ae, 2)) {
1351 WRITE_UNLOCK(ae->ARWLock);
1352 break;
1353 }
1354 p = (ExpEntry *) Yap_AllocAtomSpace(sizeof(ExpEntry));
1355 p->KindOfPE = ExpProperty;
1356 p->ArityOfEE = 2;
1357 p->ENoOfEE = 2;
1358 p->FOfEE = InitBinTab[i].f;
1359 AddPropToAtom(ae, (PropEntry *)p);
1360 WRITE_UNLOCK(ae->ARWLock);
1361 }
1362 Yap_InitCPred("is", 4, p_binary_is, TestPredFlag | SafePredFlag);
1363 Yap_InitCPred("$binary_op_as_integer", 2, p_binary_op_as_integer, TestPredFlag|SafePredFlag);
1364 Yap_InitAsmPred("$plus", 3, _plus, export_p_plus, SafePredFlag);
1365 Yap_InitAsmPred("$minus", 3, _minus, export_p_minus, SafePredFlag);
1366 Yap_InitAsmPred("$times", 3, _times, export_p_times, SafePredFlag);
1367 Yap_InitAsmPred("$div", 3, _div, export_p_div, SafePredFlag);
1368 Yap_InitAsmPred("$and", 3, _and, export_p_and, SafePredFlag);
1369 Yap_InitAsmPred("$or", 3, _or, export_p_or, SafePredFlag);
1370 Yap_InitAsmPred("$sll", 3, _sll, export_p_sll, SafePredFlag);
1371 Yap_InitAsmPred("$slr", 3, _slr, export_p_slr, SafePredFlag);
1372}
1373
1374/* This routine is called from Restore to make sure we have the same arithmetic operators */
1375int
1376Yap_ReInitBinaryExps(void)
1377{
1378 return(TRUE);
1379}
1380
Main definitions.
arith2_op
binary operators
Definition: YapEval.h:319