53static char SccsId[] =
"%W% %G%";
67static Int compare(Term, Term);
68static Int p_compare(USES_REGS1);
69static Int p_acomp(USES_REGS1);
70static Int a_eq(Term, Term);
71static Int a_dif(Term, Term);
72static Int a_gt(Term, Term);
73static Int a_ge(Term, Term);
74static Int a_lt(Term, Term);
75static Int a_le(Term, Term);
76static Int a_noteq(Term, Term);
77static Int a_gen_lt(Term, Term);
78static Int a_gen_le(Term, Term);
79static Int a_gen_gt(Term, Term);
80static Int a_gen_ge(Term, Term);
82#define rfloat(X) (X > 0.0 ? 1 : (X == 0.0 ? 0 : -1))
84static int cmp_atoms(
Atom a1,
Atom a2) {
85 return strcmp(RepAtom(a1)->StrOfAE, RepAtom(a2)->StrOfAE);
88static Int compare_complex(
register CELL *pt0,
register CELL *pt0_end,
91 register CELL **to_visit = (CELL **)HR;
95 while (pt0 < pt0_end) {
103 out = Signed(d0) - Signed(d1);
110 }
else if (IsVarTerm(d1)) {
116 else if (IsAtomTerm(d0)) {
118 out = cmp_atoms(AtomOfTerm(d0), AtomOfTerm(d1));
119 else if (IsPrimitiveTerm(d1))
125 }
else if (IsIntTerm(d0)) {
127 out = IntOfTerm(d0) - IntOfTerm(d1);
128 else if (IsFloatTerm(d1)) {
130 }
else if (IsLongIntTerm(d1)) {
131 out = IntOfTerm(d0) - LongIntOfTerm(d1);
133 }
else if (IsBigIntTerm(d1)) {
134 out = Yap_gmp_tcmp_int_big(IntOfTerm(d0), d1);
140 }
else if (IsFloatTerm(d0)) {
141 if (IsFloatTerm(d1)) {
142 out = rfloat(FloatOfTerm(d0) - FloatOfTerm(d1));
143 }
else if (IsRefTerm(d1)) {
150 }
else if (IsStringTerm(d0)) {
151 if (IsStringTerm(d1)) {
152 out = strcmp((
char *)StringOfTerm(d0), (
char *)StringOfTerm(d1));
153 }
else if (IsIntTerm(d1))
155 else if (IsFloatTerm(d1)) {
157 }
else if (IsLongIntTerm(d1)) {
160 }
else if (IsBigIntTerm(d1)) {
163 }
else if (IsRefTerm(d1)) {
170 }
else if (IsLongIntTerm(d0)) {
172 out = LongIntOfTerm(d0) - IntOfTerm(d1);
173 else if (IsFloatTerm(d1)) {
175 }
else if (IsLongIntTerm(d1)) {
176 out = LongIntOfTerm(d0) - LongIntOfTerm(d1);
178 }
else if (IsBigIntTerm(d1)) {
179 out = Yap_gmp_tcmp_int_big(LongIntOfTerm(d0), d1);
181 }
else if (IsRefTerm(d1)) {
190 else if (IsBigIntTerm(d0)) {
192 out = Yap_gmp_tcmp_big_int(d0, IntOfTerm(d1));
193 }
else if (IsFloatTerm(d1)) {
195 }
else if (IsLongIntTerm(d1)) {
196 out = Yap_gmp_tcmp_big_int(d0, LongIntOfTerm(d1));
197 }
else if (IsBigIntTerm(d1)) {
198 out = Yap_gmp_tcmp_big_big(d0, d1);
199 }
else if (IsRefTerm(d1))
205 }
else if (IsPairTerm(d0)) {
206 if (!IsPairTerm(d1)) {
207 if (IsApplTerm(d1)) {
209 if (IsExtensionFunctor(f))
211 else if (!(out = 2 - ArityOfFunctor(f)))
212 out = strcmp(
".", (
char *)RepAtom(NameOfFunctor(f))->StrOfAE);
219 to_visit[1] = pt0_end;
221 to_visit[3] = (CELL *)*pt0;
228 to_visit[1] = pt0_end;
233 pt0 = RepPair(d0) - 1;
234 pt0_end = RepPair(d0) + 1;
235 pt1 = RepPair(d1) - 1;
237 }
else if (IsRefTerm(d0)) {
239 out = Unsigned(RefOfTerm(d1)) - Unsigned(RefOfTerm(d0));
243 }
else if (IsApplTerm(d0)) {
245 register CELL *ap2, *ap3;
246 if (!IsApplTerm(d1)) {
255 if (IsExtensionFunctor(f)) {
260 if (IsExtensionFunctor(f2)) {
266 if (!(out = ArityOfFunctor(f) - ArityOfFunctor(f2)))
267 out = cmp_atoms(NameOfFunctor(f), NameOfFunctor(f2));
272 to_visit[1] = pt0_end;
274 to_visit[3] = (CELL *)*pt0;
281 to_visit[1] = pt0_end;
286 d0 = ArityOfFunctor(f);
296 if (to_visit > (CELL **)HR) {
300 pt0_end = to_visit[1];
302 *pt0 = (CELL)to_visit[3];
306 pt0_end = to_visit[1];
314 while (to_visit > (CELL **)HR) {
317 pt0_end = to_visit[1];
319 *pt0 = (CELL)to_visit[3];
325inline static Int compare(Term t1, Term t2)
332 return Signed(t1) - Signed(t2);
334 }
else if (IsVarTerm(t2)) {
338 if (IsAtomOrIntTerm(t1)) {
339 if (IsAtomTerm(t1)) {
341 return cmp_atoms(AtomOfTerm(t1), AtomOfTerm(t2));
342 if (IsPrimitiveTerm(t2))
344 if (IsStringTerm(t2))
349 return IntOfTerm(t1) - IntOfTerm(t2);
351 if (IsApplTerm(t2)) {
352 Functor fun2 = FunctorOfTerm(t2);
353 switch ((CELL)fun2) {
357 return IntOfTerm(t1) - LongIntOfTerm(t2);
360 return Yap_gmp_tcmp_int_big(IntOfTerm(t1), t2);
370 }
else if (IsPairTerm(t1)) {
371 if (IsApplTerm(t2)) {
373 if (IsExtensionFunctor(f))
377 return strcmp(
".", RepAtom(NameOfFunctor(f))->StrOfAE);
379 return compare_complex(RepPair(t1) - 1, RepPair(t1) + 1, RepAppl(t2));
383 if (IsPairTerm(t2)) {
385 compare_complex(RepPair(t1) - 1, RepPair(t1) + 1, RepPair(t2) - 1));
390 Functor fun1 = FunctorOfTerm(t1);
392 if (IsExtensionFunctor(fun1)) {
394 switch ((CELL)fun1) {
397 return (rfloat(FloatOfTerm(t1) - FloatOfTerm(t2)));
404 return LongIntOfTerm(t1) - IntOfTerm(t2);
405 if (IsFloatTerm(t2)) {
408 if (IsLongIntTerm(t2))
409 return LongIntOfTerm(t1) - LongIntOfTerm(t2);
411 if (IsBigIntTerm(t2)) {
412 return Yap_gmp_tcmp_int_big(LongIntOfTerm(t1), t2);
422 return Yap_gmp_tcmp_big_int(t1, IntOfTerm(t2));
423 if (IsFloatTerm(t2)) {
426 if (IsLongIntTerm(t2))
427 return Yap_gmp_tcmp_big_int(t1, LongIntOfTerm(t2));
428 if (IsBigIntTerm(t2)) {
429 return Yap_gmp_tcmp_big_big(t1, t2);
437 if (IsApplTerm(t2)) {
438 Functor fun2 = FunctorOfTerm(t2);
439 switch ((CELL)fun2) {
451 return strcmp((
char *)StringOfTerm(t1), (
char *)StringOfTerm(t2));
459 return Unsigned(RefOfTerm(t2)) - Unsigned(RefOfTerm(t1));
463 if (!IsApplTerm(t2)) {
464 if (IsPairTerm(t2)) {
468 if (!(out = ArityOfFunctor(f)) - 2)
469 out = strcmp((
char *)RepAtom(NameOfFunctor(f))->StrOfAE,
".");
474 Functor fun2 = FunctorOfTerm(t2);
477 if (IsExtensionFunctor(fun2)) {
480 r = ArityOfFunctor(fun1) - ArityOfFunctor(fun2);
483 r = cmp_atoms(NameOfFunctor(fun1), NameOfFunctor(fun2));
487 return (compare_complex(RepAppl(t1), RepAppl(t1) + ArityOfFunctor(fun1),
493Int Yap_compare_terms(Term d0, Term d1) {
494 return compare(Deref(d0), Deref(d1));
511Int p_compare(USES_REGS1) {
512 Int r = compare(Deref(ARG2), Deref(ARG3));
514 Term t = Deref(ARG1);
523 Atom a = AtomOfTerm(t);
526 if (a != AtomLT && a != AtomGT && a != AtomEq)
527 Yap_Error(DOMAIN_ERROR_ORDER, ARG1, NULL);
529 Yap_Error(TYPE_ERROR_ATOM, ARG1, NULL);
534 return Yap_unify_constant(ARG1, MkAtomTerm(p));
541static Int a_noteq(Term t1, Term t2) {
return (compare(t1, t2) != 0); }
543static Int a_gen_lt(Term t1, Term t2) {
return (compare(t1, t2) < 0); }
551static Int a_gen_le(Term t1, Term t2) {
return (compare(t1, t2) <= 0); }
558static Int a_gen_gt(Term t1, Term t2) {
return compare(t1, t2) > 0; }
564static Int a_gen_ge(Term t1, Term t2) {
return compare(t1, t2) >= 0; }
580inline static Int int_cmp(Int dif) {
return dif; }
582inline static Int flt_cmp(Float dif) {
590static Int a_cmp(Term t1, Term t2 USES_REGS) {
592 Yap_ArithError(INSTANTIATION_ERROR, t1,
593 "while doing arithmetic comparison");
596 Yap_ArithError(INSTANTIATION_ERROR, t2,
597 "while doing arithmetic comparison");
599 if (IsFloatTerm(t1) && IsFloatTerm(t2)) {
600 return flt_cmp(FloatOfTerm(t1) - FloatOfTerm(t2));
602 if (IsIntegerTerm(t1) && IsIntegerTerm(t2)) {
603 return int_cmp(IntegerOfTerm(t1) - IntegerOfTerm(t2));
609 if (IsIntegerTerm(t1)) {
610 Int i1 = IntegerOfTerm(t1);
613 if (IsIntegerTerm(t2)) {
614 Int i2 = IntegerOfTerm(t2);
615 return int_cmp(i1 - i2);
616 }
else if (IsFloatTerm(t2)) {
617 Float f2 = FloatOfTerm(t2);
620 Yap_ArithError(EVALUATION_ERROR_UNDEFINED, t2,
621 "trying to evaluate nan");
624 return flt_cmp(i1 - f2);
626 }
else if (IsBigIntTerm(t2)) {
627 return Yap_gmp_cmp_int_big(i1, t2);
632 }
else if (IsFloatTerm(t1)) {
633 Float f1 = FloatOfTerm(t1);
636 Yap_ArithError(EVALUATION_ERROR_UNDEFINED, t1,
637 "trying to evaluate nan");
646 if (IsIntegerTerm(t2)) {
647 Int i2 = IntegerOfTerm(t2);
648 return flt_cmp(f1 - i2);
649 }
else if (IsFloatTerm(t2)) {
650 Float f2 = FloatOfTerm(t2);
653 Yap_ArithError(EVALUATION_ERROR_UNDEFINED, t2,
654 "trying to evaluate nan");
657 return flt_cmp(f1 - f2);
659 }
else if (IsBigIntTerm(t2)) {
660 return Yap_gmp_cmp_float_big(f1, t2);
666 }
else if (IsBigIntTerm(t1)) {
670 if (IsIntegerTerm(t2)) {
671 return Yap_gmp_cmp_big_int(t1, IntegerOfTerm(t2));
672 }
else if (IsFloatTerm(t2)) {
673 Float f2 = FloatOfTerm(t2);
676 Yap_ArithError(EVALUATION_ERROR_UNDEFINED, t2,
677 "trying to evaluate nan");
680 return Yap_gmp_cmp_big_float(t1, f2);
681 }
else if (IsBigIntTerm(t2)) {
682 return Yap_gmp_cmp_big_big(t1, t2);
693Int Yap_acmp(Term t1, Term t2 USES_REGS) {
694 Int out = a_cmp(t1, t2 PASS_REGS);
698static Int p_acomp(USES_REGS1) {
699 Term t1 = Deref(ARG1);
700 Term t2 = Deref(ARG2);
703 out = a_cmp(t1, t2 PASS_REGS);
713static Int a_eq(Term t1, Term t2) {
721 Yap_Error(INSTANTIATION_ERROR, t1,
"=:=/2");
725 Yap_Error(INSTANTIATION_ERROR, t2,
"=:=/2");
728 if (IsFloatTerm(t1)) {
730 return (FloatOfTerm(t1) == FloatOfTerm(t2));
731 else if (IsIntegerTerm(t2)) {
732 return (FloatOfTerm(t1) == IntegerOfTerm(t2));
735 if (IsIntegerTerm(t1)) {
736 if (IsIntegerTerm(t2)) {
737 return (IntegerOfTerm(t1) == IntegerOfTerm(t2));
738 }
else if (IsFloatTerm(t2)) {
739 return (FloatOfTerm(t2) == IntegerOfTerm(t1));
742 out = a_cmp(t1, t2 PASS_REGS);
753static Int a_dif(Term t1, Term t2) {
755 Int out = a_cmp(Deref(t1), Deref(t2) PASS_REGS);
766static Int a_gt(Term t1, Term t2) {
768 Int out = a_cmp(Deref(t1), Deref(t2) PASS_REGS);
779static Int a_ge(Term t1, Term t2) {
781 Int out = a_cmp(Deref(t1), Deref(t2) PASS_REGS);
792static Int a_lt(Term t1, Term t2) {
794 Int out = a_cmp(Deref(t1), Deref(t2) PASS_REGS);
807static Int a_le(Term t1, Term t2) {
809 Int out = a_cmp(Deref(t1), Deref(t2) PASS_REGS);
817void Yap_InitCmpPreds(
void) {
818 Yap_InitCmpPred(
"=:=", 2, a_eq, SafePredFlag | BinaryPredFlag);
819 Yap_InitCmpPred(
"=\\=", 2, a_dif, SafePredFlag | BinaryPredFlag);
820 Yap_InitCmpPred(
">", 2, a_gt, SafePredFlag | BinaryPredFlag);
821 Yap_InitCmpPred(
"=<", 2, a_le, SafePredFlag | BinaryPredFlag);
822 Yap_InitCmpPred(
"<", 2, a_lt, SafePredFlag | BinaryPredFlag);
823 Yap_InitCmpPred(
">=", 2, a_ge, SafePredFlag | BinaryPredFlag);
824 Yap_InitCPred(
"$a_compare", 3, p_acomp, TestPredFlag | SafePredFlag);
825 Yap_InitCmpPred(
"\\==", 2, a_noteq, BinaryPredFlag | SafePredFlag);
826 Yap_InitCmpPred(
"@<", 2, a_gen_lt, BinaryPredFlag | SafePredFlag);
827 Yap_InitCmpPred(
"@=<", 2, a_gen_le, BinaryPredFlag | SafePredFlag);
828 Yap_InitCmpPred(
"@>", 2, a_gen_gt, BinaryPredFlag | SafePredFlag);
829 Yap_InitCmpPred(
"@>=", 2, a_gen_ge, BinaryPredFlag | SafePredFlag);
830 Yap_InitCPred(
"compare", 3, p_compare, TestPredFlag | SafePredFlag);